{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% osCommerce Product Manager for Windows (oscpmwin). Copyright ©2003-2006 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 IdComponent, IdHTTP, StdCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, IdSSLOpenSSL, oscpmdata; 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 (DBUser, DBPass : STRING) : STRING; FUNCTION FNopm_CloseDBConnection : STRING; FUNCTION FNopm_ConnectionState : 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; FUNCTION FNopm_WebDB_Query (CommandURL, SQLString : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT; PROCEDURE PRopm_Close_WebDBQuery; FUNCTION FNopm_Unserial_DBQuery (VAR RecSetStr : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT; VAR ExistNetLink : BOOLEAN; opmG_Network_EventHandler : Topm_EventHandler; opmG_HTTPClient: TIdHTTP; opmG_SSLHandler: TIdSSLIOHandlerSocket; opmG_HTTP_ProgressBar : TProgressBar; opmG_HTTP_ProgressLabel : TLabel; opmG_INDY_AntiFreeze : TIdAntiFreeze; opmG_HTTPClient_TransactLog : STRING; opmG_WeAreConnected : BOOLEAN; IMPLEMENTATION USES Windows, SysUtils, gnugettext, Forms, dataman, 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; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_OpenDBConnection (DBUser, DBPass : STRING) : STRING; BEGIN opmG_WeAreConnected := TRUE; FNopm_OpenDBConnection := ''; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CloseDBConnection : STRING; BEGIN opmG_WeAreConnected := FALSE; FNopm_CloseDBConnection := ''; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ConnectionState : BOOLEAN; BEGIN FNopm_ConnectionState := opmG_WeAreConnected; 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 IF (opmG_DBDebugLog > 0) THEN 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; 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 ('Un', FNopm_MD5 (UploadStamp + opmG_DBUsername)); PostData.AddFormField ('Pw', FNopm_MD5 (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 ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername)); PostData.AddFormField ('Pw', FNopm_MD5 (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 ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername)); PostData.AddFormField ('Pw', FNopm_MD5 (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; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_WebDB_Query (CommandURL, SQLString : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT; VAR PostData : TIdMultiPartFormDataStream; CommandStamp : STRING; ErrPos : LONGINT; RetryCount : LONGINT; LapseTime : DOUBLE; ResultCode : LONGINT; BEGIN PRopm_WriteLog ('Executing query: ' + SQLString); ResultCode := opmC_WebScriptDefaultCode; RecSetArray.RowCount := 0; RecSetArray.ColCount := 0; RecSetArray.DataRows := 0; RecSetArray.DataCols := 0; SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount); opmG_HTTPClient_TransactLog := ''; RetryCount := 0; IF (SQLString <> '') THEN BEGIN CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL); opmG_HTTPClient.DisconnectSocket; CommandStamp := DATETIMETOSTR (NOW); PostData := TIdMultiPartFormDataStream.Create; PostData.AddFormField ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername)); PostData.AddFormField ('Pw', FNopm_MD5 (CommandStamp + opmG_DBPassword)); PostData.AddFormField ('Op', 'dbquery'); PostData.AddFormField ('Qy', FNopm_Base64_Encode (SQLString)); PostData.AddFormField ('Vn', opmC_WebScriptVersion); PostData.AddFormField ('TS', CommandStamp); TRY IF (FNopm_ConnectionState = TRUE) THEN BEGIN Application.ProcessMessages; REPEAT PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...'); TRY PRopm_WriteLog ('Go!'); opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData); PRopm_WriteLog ('Done!'); EXCEPT {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;} ON E : Exception DO BEGIN opmG_HTTPClient_TransactLog := ''; PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message); END; END; IF (opmG_HTTPClient_TransactLog <> '') THEN BEGIN IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN BEGIN ResultCode := FNopm_Unserial_DBQuery (opmG_HTTPClient_TransactLog, RecSetArray); 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 ResultCode := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1))); END ELSE ResultCode := opmC_WebScriptUnknownCode; END; END ELSE BEGIN ResultCode := opmC_WebScriptDefaultCode; END; INC (RetryCount); IF (ResultCode = opmC_WebScriptDefaultCode) THEN BEGIN LapseTime := GetTickCount; REPEAT Application.ProcessMessages; UNTIL ((GetTickCount - LapseTime) > opmG_HTTPConnWait); END; UNTIL ((RetryCount > opmG_HTTPConnRetries) OR (ResultCode = 0)); END ELSE BEGIN PRopm_WriteLog ('Connection was down. Nothing done.'); END; FINALLY PostData.Free; END; END ELSE BEGIN PRopm_WriteLog ('Query was empty. Nothing done.'); END; FNopm_WebDB_Query := ResultCode; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_Close_WebDBQuery; BEGIN opmG_DBQuery_Recordset.RowCount := 0; opmG_DBQuery_Recordset.ColCount := 0; opmG_DBQuery_Recordset.DataRows := 0; opmG_DBQuery_Recordset.DataCols := 0; SetLength (opmG_DBQuery_Recordset.Data, opmG_DBQuery_Recordset.RowCount, opmG_DBQuery_Recordset.ColCount); opmG_HTTPClient_TransactLog := ''; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_Unserial_DBQuery (VAR RecSetStr : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT; VAR LineCount : LONGINT; RecCount, FieldCount : LONGINT; MaxFieldCount : LONGINT; TmpStr, TmpStr2 : STRING; DataList : TStringList; BEGIN {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PENDIENTE CODIGO DE VERIFICACION DE LIMITES MAXIMOS DE REGISTROS Y CAMPOS Y VERIFICACION DE INTEGRIDAD. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FNopm_Unserial_DBQuery := opmC_WebScriptDefaultCode; TRY DataList := TStringList.Create; DataList.Text := RecSetStr; IF (DataList.Count > 2) THEN BEGIN DataList.Delete (0); DataList.Delete (DataList.Count - 1); TmpStr := TRIM (DataList.Text); DataList.Text := ''; Application.ProcessMessages; TmpStr2 := FNopm_Base64_Decode (TmpStr); Application.ProcessMessages; TmpStr := ''; Application.ProcessMessages; DataList.Text := FNopm_Inflate (TmpStr2); Application.ProcessMessages; TmpStr2 := ''; RecCount := 0; FieldCount := 0; MaxFieldCount := 0; FOR LineCount := 0 TO (DataList.Count - 1) DO BEGIN IF (DataList.Strings[LineCount] = opmC_DBTag_RecBegin) THEN BEGIN INC (RecCount); IF (RecCount > RecSetArray.RowCount) THEN BEGIN RecSetArray.RowCount := RecCount + 100; SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount); END; FieldCount := 0; END; IF (COPY (DataList.Strings[LineCount], 1, 2) = opmC_DBTag_DataField) THEN BEGIN INC (FieldCount); IF (FieldCount > MaxFieldCount) THEN BEGIN MaxFieldCount := FieldCount; RecSetArray.ColCount := MaxFieldCount; SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount); END; TmpStr := COPY (DataList.Strings[LineCount], 5, LENGTH (DataList.Strings[LineCount]) - 5); RecSetArray.Data[(RecCount - 1), (FieldCount - 1)] := FNopm_Base64_Decode (TmpStr); END; END; RecSetArray.DataRows := RecCount; RecSetArray.DataCols := MaxFieldCount; FNopm_Unserial_DBQuery := 0; END ELSE BEGIN FNopm_Unserial_DBQuery := 0; END; FINALLY FreeAndNIL (DataList); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} INITIALIZATION ExistNetLink := FNopm_NetExist; opmG_WeAreConnected := FALSE; 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); end.