{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% osCommerce Product Manager for Windows (oscpmwin). Copyright ©2003,2004,2005 by Mario A. Valdez-Ramirez. You can contact Mario A. Valdez-Ramirez by email at mario@mariovaldez.org or paper mail at Olmos 809, San Nicolas, NL. 66495, Mexico. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} unit network; interface USES ZConnection, ZAbstractRODataset, ZAbstractDataset, ZDataset, ZDbcCache, IdComponent, IdHTTP, StdCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, IdSSLOpenSSL; TYPE Topm_EventHandler = CLASS PROCEDURE PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER); PROCEDURE PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER); PROCEDURE PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode); END; FUNCTION FNopm_NetExist : BOOLEAN; FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD; DBProt, DBBase, DBUser, DBPass : STRING; DBCompress : INTEGER) : STRING; FUNCTION FNopm_CloseDBConnection : STRING; FUNCTION FNopm_ConnectionState : BOOLEAN; FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT; FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING; FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN; PROCEDURE PRopm_CloseSSHTunnel; FUNCTION FNopm_CheckStallTunnel : BOOLEAN; PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT); PROCEDURE PRopm_WriteLog (LogString: STRING); PROCEDURE PRopm_ResetLog; PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN); PROCEDURE PRopm_Disconnect_HTTPClient; FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN; FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING; VAR RenFileName : STRING) : LONGINT; FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT; FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT; FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING; FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING; VAR ExistNetLink : BOOLEAN; opmG_DBConnection : TZConnection; SSHTunnelHandle : CARDINAL; opmG_Network_EventHandler : Topm_EventHandler; opmG_DBQuery : TZQuery; opmG_HTTPClient: TIdHTTP; opmG_SSLHandler: TIdSSLIOHandlerSocket; opmG_HTTP_ProgressBar : TProgressBar; opmG_HTTP_ProgressLabel : TLabel; opmG_INDY_AntiFreeze : TIdAntiFreeze; opmG_HTTPClient_TransactLog : STRING; IMPLEMENTATION USES Windows, SysUtils, gnugettext, ZDbcIntfs, Forms, dataman, oscpmdata, WinInet, Dialogs, attention, IdGlobal, Classes, imageman, IdMultipartFormData; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_NetExist : BOOLEAN; BEGIN IF ((GetSystemMetrics (SM_NETWORK) AND $01) > 0) THEN FNopm_NetExist := TRUE ELSE FNopm_NetExist := FALSE; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Open a connection to the database server. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD; DBProt, DBBase, DBUser, DBPass : STRING; DBCompress : INTEGER) : STRING; VAR LapseTime : DOUBLE; ConnTries : LONGINT; BEGIN FNopm_OpenDBConnection := 'ERROR'; IF ((DBHost <> '') AND (DBPort > 0) AND (DBProt <> '') AND (DBBase <> '') AND (DBUser <> '') AND (opmG_DBConnection.Connected = FALSE)) THEN BEGIN opmG_DBConnection.HostName := DBHost; opmG_DBConnection.Port := DBPort; opmG_DBConnection.Protocol := DBProt; opmG_DBConnection.Database := DBBase; opmG_DBConnection.User := DBUser; opmG_DBConnection.Password := DBPass; IF (DBCompress > 0) THEN opmG_DBConnection.Properties.Text := 'compress=yes' ELSE opmG_DBConnection.Properties.Text := ''; FOR ConnTries := 1 TO opmG_DBConnRetries DO BEGIN TRY opmG_DBConnection.Connect; EXCEPT ON E : Exception DO BEGIN FNopm_OpenDBConnection := _('Error while connecting to database') + ' (' + DBBase + ' @ ' + DBHost + ').'#13#10 + E.Message; END; END; LapseTime := GetTickCount; REPEAT Application.ProcessMessages; UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait); IF (opmG_DBConnection.Connected = TRUE) THEN BEGIN FNopm_OpenDBConnection := ''; BREAK; END; END; END ELSE BEGIN FNopm_OpenDBConnection := _('Invalid database connection parameters or database already connected.'); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Closes the connection to the database server. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CloseDBConnection : STRING; BEGIN IF (opmG_DBConnection.Connected) THEN BEGIN opmG_DBConnection.Disconnect; FNopm_CloseDBConnection := ''; END ELSE BEGIN FNopm_CloseDBConnection := _('The database is not connected'); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ConnectionState : BOOLEAN; BEGIN FNopm_ConnectionState := opmG_DBConnection.Connected; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Send a SQL query to the database server, returning the number of returned records (if any). If query is a SELECT, the Query is keep Active so other routines can read its records. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT; VAR RetryCount : LONGINT; ResultStatus : LONGINT; StatusString : STRING; LapseTime : DOUBLE; BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Executing query of type ' + INTTOSTR (SQLQueryType) + ': ' + SQLQueryString); RetryCount := 0; IF (SQLQueryString <> '') THEN BEGIN ResultStatus := -1; StatusString := ''; IF (FNopm_ConnectionState) THEN BEGIN Application.ProcessMessages; REPEAT IF (SQLQueryType = opmC_SQLSelect) THEN BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...'); TRY {opmG_DBQuery.Active := FALSE;} opmG_DBQuery.Close; opmG_DBQuery.SQL.Clear; opmG_DBQuery.SQL.Add (SQLQueryString); IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!'); {opmG_DBQuery.Active := TRUE;} opmG_DBQuery.Open; IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!'); ResultStatus := opmG_DBQuery.RecordCount; EXCEPT ON E : Exception DO BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR! : ' + E.Message); StatusString := E.Message; END; END; END ELSE IF ((SQLQueryType = opmC_SQLUpdate) OR (SQLQueryType = opmC_SQLInsert) OR (SQLQueryType = opmC_SQLDelete)) THEN BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...'); TRY opmG_DBQuery.Active := FALSE; opmG_DBQuery.SQL.Clear; opmG_DBQuery.SQL.Add (SQLQueryString); IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!'); opmG_DBQuery.ExecSQL; opmG_DBQuery.Active := FALSE; IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!'); ResultStatus := 0; EXCEPT ON E : Exception DO BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message); StatusString := E.Message; END; END; END; INC (RetryCount); IF (ResultStatus < 0) THEN BEGIN LapseTime := GetTickCount; REPEAT Application.ProcessMessages; UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait); END; UNTIL (RetryCount > 3) OR (ResultStatus >= 0); IF (ResultStatus < 0) THEN FNopm_Message (_('An error ocurred while processing the database query.') + #13#10 + StatusString, mtError, [mbOk], opmG_UISilent); END ELSE BEGIN IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Connection was down. Nothing done.'); END; END ELSE BEGIN ResultStatus := 0; IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Query was empty. Nothing done.'); END; FNopm_ExecQuery := ResultStatus; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN; VAR CallParams : STRING; BEGIN CallParams := FNopm_BuildTunnelCall (SSHLHost, SSHRHost, SSHLPort, SSHRPort, SSHUser, SSHPass, (opmC_Def_SSHCompress > 0)); IF (VisibleWindow > 0) THEN BEGIN SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe, CallParams, ExtractFilePath (Application.Exename), FALSE, TRUE, opmG_SSHConnWait); END ELSE SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe, CallParams, ExtractFilePath (Application.Exename), FALSE, FALSE, opmG_SSHConnWait); FNopm_OpenSSHTunnel := (SSHTunnelHandle > 0); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING; VAR PlinkParams : STRING; BEGIN PLinkParams := '-ssh -' + INTTOSTR (opmC_Def_SSHProtocol); IF (Compress = TRUE) THEN PLinkParams := PLinkParams + ' -C'; PLinkParams := PLinkParams + ' -l ' + SSHUser + ' -pw ' + SSHPass; PLinkParams := PLinkParams + ' -L ' + INTTOSTR (SSHLPort) + ':' + SSHLHost + ':' + INTTOSTR (SSHRPort); PLinkParams := PLinkParams + ' ' + SSHRHost + ''; FNopm_BuildTunnelCall := PLinkParams; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_CloseSSHTunnel; BEGIN PRopm_StopExternalApp (SSHTunnelHandle); SSHTunnelHandle := 0; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CheckStallTunnel : BOOLEAN; BEGIN FNopm_CheckStallTunnel := (FNopm_IsAppRunning (opmC_Def_SSHExe) = TRUE); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT); VAR ProxyInfo : PInternetProxyInfo; DataLen : CARDINAL; DataString : STRING; BEGIN DataString := ''; ProxyHost := ''; ProxyPort := 0; DataLen := 4096; GetMem (ProxyInfo, DataLen); TRY IF (InternetQueryOption (NIL, INTERNET_OPTION_PROXY, ProxyInfo, DataLen)) THEN IF (ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY) THEN BEGIN DataString := ProxyInfo^.lpszProxy; END; FINALLY FREEMEM (ProxyInfo); END; IF (DataString <> '') THEN BEGIN IF (ANSIPOS ('=', DataString) > 0) THEN BEGIN IF (ANSIPOS ('http=', DataString) > 0) THEN BEGIN DELETE (DataString, 1, ANSIPOS ('http=', DataString) + LENGTH ('http=') - 1); ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1); DELETE (DataString, 1, ANSIPOS (':', DataString)); ProxyPort := FNopm_StrToInt (DataString); END ELSE BEGIN ProxyHost := ''; ProxyPort := 0; END; END ELSE BEGIN ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1); DELETE (DataString, 1, ANSIPOS (':', DataString)); ProxyPort := FNopm_StrToInt (DataString); END; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_WriteLog (LogString: STRING); VAR LogDirname: STRING; LogFile: TEXTFILE; BEGIN LogDirname := ExtractFilePath (Application.Exename); ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile); TRY IF FILEEXISTS (LogDirname + opmC_DebugFile) THEN APPEND (LogFile) ELSE REWRITE(Logfile); WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW), '|', LogString); CLOSEFILE (LogFile) EXCEPT END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_ResetLog; VAR LogDirname: STRING; LogFile: TEXTFILE; BEGIN LogDirname := ExtractFilePath (Application.Exename); ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile); TRY REWRITE(Logfile); WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW)); WRITELN (LogFile, opmC_DebugFileSeparator); WRITELN (LogFile, ''); CLOSEFILE (LogFile) EXCEPT END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN); BEGIN opmG_HTTP_ProgressBar := ProgressBar; opmG_HTTP_ProgressLabel := ProgressLabel; IF (UseProxy AND (opmG_WBProxyHost <> '') AND (opmG_WBProxyPort > 0)) THEN BEGIN opmG_HTTPClient.ProxyParams.ProxyServer := opmG_WBProxyHost; opmG_HTTPClient.ProxyParams.ProxyPort := opmG_WBProxyPort; END ELSE BEGIN opmG_HTTPClient.ProxyParams.ProxyServer := ''; opmG_HTTPClient.ProxyParams.ProxyPort := 0; END; opmG_HTTPClient.ReadTimeout := opmC_Def_HTTPWaitFactor * opmG_HTTPConnWait; opmG_HTTPClient.ConnectTimeout := opmG_HTTPConnWait; opmG_HTTPClient.Request.UserAgent := opmG_FullUserAgent; IF (opmG_WBNoCacheImg > 0) THEN opmG_HTTPClient.Request.CacheControl := 'min-fresh=1,max-age=1,no-cache' ELSE opmG_HTTPClient.Request.CacheControl := ''; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_Disconnect_HTTPClient; BEGIN opmG_HTTPClient.DisconnectSocket; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER); BEGIN IF ((AWorkCountMax > 0) AND (opmG_HTTP_ProgressBar <> NIL)) THEN BEGIN opmG_HTTP_ProgressBar.Enabled := TRUE; opmG_HTTP_ProgressBar.Min := 0; opmG_HTTP_ProgressBar.Max := AWorkCountMax; opmG_HTTP_ProgressBar.Position := 0; END; Application.ProcessMessages; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE Topm_EventHandler.PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER); BEGIN IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN BEGIN opmG_HTTP_ProgressLabel.Caption := INTTOSTR (AWorkCount) + _(' bytes'); opmG_HTTP_ProgressBar.Position := AWorkCount; END; Application.ProcessMessages; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode); BEGIN IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN BEGIN opmG_HTTP_ProgressBar.Enabled := FALSE; opmG_HTTP_ProgressBar.Min := 0; opmG_HTTP_ProgressBar.Max := 100; opmG_HTTP_ProgressBar.Position := 0; opmG_HTTP_ProgressLabel.Caption := ''; END; Application.ProcessMessages; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN; VAR FileStream : TMemoryStream; BEGIN FNopm_Download_File := FALSE; IF ((FileURL <> '') AND (FileFileName <> '')) THEN BEGIN SysUtils.DELETEFILE (FileFileName); FileURL := opmG_HTTPClient.URL.URLEncode (FileURL); opmG_HTTPClient.DisconnectSocket; FileStream := TMemoryStream.Create; TRY opmG_HTTPClient.Get (FileURL, FileStream); FileStream.SaveToFile (FileFileName); FNopm_Download_File := TRUE; EXCEPT ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE; ELSE END; FileStream.Free; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING; VAR RenFileName : STRING) : LONGINT; VAR PostData : TIdMultiPartFormDataStream; UploadStamp : STRING; ErrPos : LONGINT; BEGIN FNopm_Upload_File := opmC_WebScriptDefaultCode; RenFileName := ''; opmG_HTTPClient_TransactLog := ''; IF ((UploadURL <> '') AND (FileFile <> '')) THEN BEGIN UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL); opmG_HTTPClient.DisconnectSocket; UploadStamp := DATETIMETOSTR (NOW); PostData := TIdMultiPartFormDataStream.Create; PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword)); PostData.AddFormField ('Op', 'upload'); PostData.AddFormField ('Fn', FileFileName); PostData.AddFormField ('SD', FileSubdir); PostData.AddFormField ('Vn', opmC_WebScriptVersion); PostData.AddFormField ('TS', UploadStamp); PostData.AddFile ('Fl', FileFile, 'application/octet-stream'); PostData.Position := 0; TRY TRY opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData); EXCEPT {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;} opmG_HTTPClient_TransactLog := ''; END; FINALLY PostData.Free; END; RenFilename := opmG_HTTPClient_TransactLog; IF (opmG_HTTPClient_TransactLog <> '') THEN BEGIN IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN BEGIN RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1); FNopm_Upload_File := 0 END ELSE BEGIN ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN BEGIN DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode)); ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN FNopm_Upload_File := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1))); END ELSE FNopm_Upload_File := opmC_WebScriptUnknownCode; END; END ELSE FNopm_Upload_File := opmC_WebScriptDefaultCode; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT; VAR PostData : TIdMultiPartFormDataStream; CommandStamp : STRING; ErrPos : LONGINT; BEGIN FNopm_Send_Command := opmC_WebScriptDefaultCode; OpResult := ''; opmG_HTTPClient_TransactLog := ''; IF (OperationStr <> '') THEN BEGIN CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL); opmG_HTTPClient.DisconnectSocket; CommandStamp := DATETIMETOSTR (NOW); PostData := TIdMultiPartFormDataStream.Create; PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword)); PostData.AddFormField ('Op', OperationStr); PostData.AddFormField ('Fn', OpParams); PostData.AddFormField ('Vn', opmC_WebScriptVersion); PostData.AddFormField ('TS', CommandStamp); TRY TRY opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData); EXCEPT {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;} opmG_HTTPClient_TransactLog := ''; END; FINALLY PostData.Free; END; OpResult := opmG_HTTPClient_TransactLog; IF (opmG_HTTPClient_TransactLog <> '') THEN BEGIN IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN FNopm_Send_Command := 0 ELSE BEGIN ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN BEGIN DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode)); ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN FNopm_Send_Command := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1))); END ELSE FNopm_Send_Command := opmC_WebScriptUnknownCode; END; END ELSE FNopm_Send_Command := opmC_WebScriptDefaultCode; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT; VAR PostData : TIdMultiPartFormDataStream; ErrPos : LONGINT; BEGIN FNopm_Send_SimpleCommand := opmC_WebDefaultCode; OpResult := ''; opmG_HTTPClient_TransactLog := ''; IF (OperationStr <> '') THEN BEGIN CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL); opmG_HTTPClient.DisconnectSocket; PostData := TIdMultiPartFormDataStream.Create; PostData.AddFormField ('Op', OperationStr); PostData.AddFormField ('Fn', OpParams); TRY TRY opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData); EXCEPT {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;} opmG_HTTPClient_TransactLog := ''; END; FINALLY PostData.Free; END; OpResult := opmG_HTTPClient_TransactLog; IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN FNopm_Send_SimpleCommand := 0 ELSE BEGIN ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN BEGIN DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode)); ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog); IF (ErrPos > 0) THEN FNopm_Send_SimpleCommand := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1))); END ELSE FNopm_Send_SimpleCommand := opmC_WebScriptUnknownCode; END; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING; VAR PostData : TIdMultiPartFormDataStream; CommandStamp : STRING; FileStream : TMemoryStream; SugFileName : STRING; BEGIN FNopm_Receive_File := ''; opmG_HTTPClient_TransactLog := ''; SugFileName := ''; SysUtils.DELETEFILE (RetFileName); IF (OperationStr <> '') THEN BEGIN CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL); opmG_HTTPClient.DisconnectSocket; CommandStamp := DATETIMETOSTR (NOW); PostData := TIdMultiPartFormDataStream.Create; PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword)); PostData.AddFormField ('Op', OperationStr); PostData.AddFormField ('Fn', RetFileName); PostData.AddFormField ('Vn', opmC_WebScriptVersion); PostData.AddFormField ('TS', CommandStamp); FileStream := TMemoryStream.Create; TRY TRY opmG_HTTPClient.Post (CommandURL, PostData, FileStream); IF (FileStream.Size > 10) THEN BEGIN FileStream.SaveToFile (RetFileName); SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition']; SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50)); FNopm_Receive_File := SugFileName; END ELSE FNopm_Receive_File := ''; EXCEPT {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;} FNopm_Receive_File := ''; END; FINALLY PostData.Free; FileStream.Free; END; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING; BEGIN CASE ErrorCode OF opmC_WebScriptDefaultCode : FNopm_FullRemoteError := 'ERROR 100: ' + _('There was an error while trying to connect to the server-side script.') + #13#10 + _('Please check it is installed and check your proxy settings.'); opmC_WebScriptUnknownCode : FNopm_FullRemoteError := 'ERROR 200: ' + _('General script error.') + #13#10 + _('The script failed and could not even report the error.'); opmC_WebDefaultCode : FNopm_FullRemoteError := 'ERROR 50: ' + _('There was an error while trying to connect to the web file.') + #13#10 + _('This could be a temporary failure in the web server. Please, try later.') + #13#10 + _('But also could be a misconfiguration; please check your proxy settings.'); 1000 : FNopm_FullRemoteError := 'ERROR 1000: ' + _('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.'); 1010 : FNopm_FullRemoteError := 'ERROR 1010: ' + _('The server image directory cannot be found.'); 1020 : FNopm_FullRemoteError := 'ERROR 1020: ' + _('The password is not correct.'); 1021 : FNopm_FullRemoteError := 'ERROR 1021: ' + _('There has been an error while trying to get the server password.'); 1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.'); 1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.'); 1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).'); 1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.'); 1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).'); 1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).'); 1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).'); 1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.'); 1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).'); 1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).'); 1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).'); ELSE FNopm_FullRemoteError := _('Unknown error.'); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} INITIALIZATION ExistNetLink := FNopm_NetExist; opmG_DBConnection := TZConnection.Create (Application); opmG_DBConnection.AutoCommit := TRUE; opmG_DBConnection.ReadOnly := TRUE; opmG_DBConnection.TransactIsolationLevel := tiNone; opmG_DBQuery := TZQuery.Create (Application); opmG_DBQuery.RequestLive := FALSE; opmG_DBQuery.CachedUpdates := FALSE; opmG_DBQuery.ParamCheck := FALSE; opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted]; opmG_DBQuery.UpdateMode := umUpdateChanged; opmG_DBQuery.WhereMode := wmWhereKeyOnly; opmG_DBQuery.Options := [doCalcDefaults]; opmG_DBQuery.Connection := opmG_DBConnection; opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application); opmG_SSLHandler.SSLOptions.Method := sslvSSLv2; opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned; opmG_SSLHandler.SSLOptions.VerifyMode := []; opmG_SSLHandler.SSLOptions.VerifyDepth := 0; opmG_HTTPClient := TIdHTTP.Create (Application); opmG_HTTPClient.MaxLineAction := maException; opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work; opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin; opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd; opmG_HTTPClient.AllowCookies := False; opmG_HTTPClient.HandleRedirects := True; opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE; opmG_HTTPClient.ProxyParams.ProxyPort := 0; opmG_HTTPClient.Request.ContentLength := 0; opmG_HTTPClient.Request.ContentRangeEnd := 0; opmG_HTTPClient.Request.ContentRangeStart := 0; opmG_HTTPClient.Request.Accept := 'text/html, */*'; opmG_HTTPClient.Request.BasicAuthentication := FALSE; opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams]; opmG_HTTPClient.IOHandler := opmG_SSLHandler; opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application); SSHTunnelHandle := 0; FINALIZATION {opmG_DBConnection.Free;} end.