Source code of file oscpmwin_v0.4.1.683/network.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003-2006 by Mario A. Valdez-Ramirez.
0003:
0004: You can contact Mario A. Valdez-Ramirez
0005: by email at mario@mariovaldez.org or paper mail at
0006: Olmos 809, San Nicolas, NL. 66495, Mexico.
0007:
0008: This program is free software; you can redistribute it and/or modify
0009: it under the terms of the GNU General Public License as published by
0010: the Free Software Foundation; either version 2 of the License, or (at
0011: your option) any later version.
0012:
0013: This program is distributed in the hope that it will be useful, but
0014: WITHOUT ANY WARRANTY; without even the implied warranty of
0015: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0016: General Public License for more details.
0017:
0018: You should have received a copy of the GNU General Public License
0019: along with this program; if not, write to the Free Software
0020: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0021: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0022: unit network;
0023:
0024: interface
0025:
0026: USES IdComponent, IdHTTP, StdCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, IdSSLOpenSSL, oscpmdata;
0027:
0028: TYPE
0029: Topm_EventHandler = CLASS
0030: PROCEDURE PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0031: PROCEDURE PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0032: PROCEDURE PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0033: END;
0034:
0035:
0036: FUNCTION FNopm_NetExist : BOOLEAN;
0037: FUNCTION FNopm_OpenDBConnection (DBUser, DBPass : STRING) : STRING;
0038: FUNCTION FNopm_CloseDBConnection : STRING;
0039: FUNCTION FNopm_ConnectionState : BOOLEAN;
0040: PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0041: PROCEDURE PRopm_WriteLog (LogString: STRING);
0042: PROCEDURE PRopm_ResetLog;
0043: PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0044: PROCEDURE PRopm_Disconnect_HTTPClient;
0045: FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0046: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING; VAR RenFileName : STRING) : LONGINT;
0047: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0048: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0049: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0050: FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0051: FUNCTION FNopm_WebDB_Query (CommandURL, SQLString : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0052: PROCEDURE PRopm_Close_WebDBQuery;
0053: FUNCTION FNopm_Unserial_DBQuery (VAR RecSetStr : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0054:
0055:
0056: VAR
0057: ExistNetLink : BOOLEAN;
0058: opmG_Network_EventHandler : Topm_EventHandler;
0059: opmG_HTTPClient: TIdHTTP;
0060: opmG_SSLHandler: TIdSSLIOHandlerSocket;
0061: opmG_HTTP_ProgressBar : TProgressBar;
0062: opmG_HTTP_ProgressLabel : TLabel;
0063: opmG_INDY_AntiFreeze : TIdAntiFreeze;
0064: opmG_HTTPClient_TransactLog : STRING;
0065: opmG_WeAreConnected : BOOLEAN;
0066:
0067:
0068: IMPLEMENTATION
0069:
0070: USES Windows, SysUtils, gnugettext, Forms, dataman, WinInet, IdGlobal,
0071: Classes, IdMultipartFormData;
0072:
0073:
0074: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0075: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0076: FUNCTION FNopm_NetExist : BOOLEAN;
0077: BEGIN
0078: IF ((GetSystemMetrics (SM_NETWORK) AND $01) > 0) THEN
0079: FNopm_NetExist := TRUE
0080: ELSE
0081: FNopm_NetExist := FALSE;
0082: END;
0083:
0084:
0085:
0086: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0087: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0088: FUNCTION FNopm_OpenDBConnection (DBUser, DBPass : STRING) : STRING;
0089: BEGIN
0090: opmG_WeAreConnected := TRUE;
0091: FNopm_OpenDBConnection := '';
0092: END;
0093:
0094:
0095: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0096: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0097: FUNCTION FNopm_CloseDBConnection : STRING;
0098: BEGIN
0099: opmG_WeAreConnected := FALSE;
0100: FNopm_CloseDBConnection := '';
0101: END;
0102:
0103:
0104:
0105: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0106: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0107: FUNCTION FNopm_ConnectionState : BOOLEAN;
0108: BEGIN
0109: FNopm_ConnectionState := opmG_WeAreConnected;
0110: END;
0111:
0112:
0113:
0114:
0115: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0116: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0117: PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0118: VAR
0119: ProxyInfo : PInternetProxyInfo;
0120: DataLen : CARDINAL;
0121: DataString : STRING;
0122: BEGIN
0123: DataString := '';
0124: ProxyHost := '';
0125: ProxyPort := 0;
0126: DataLen := 4096;
0127: GetMem (ProxyInfo, DataLen);
0128: TRY
0129: IF (InternetQueryOption (NIL, INTERNET_OPTION_PROXY, ProxyInfo, DataLen)) THEN
0130: IF (ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY) THEN
0131: BEGIN
0132: DataString := ProxyInfo^.lpszProxy;
0133: END;
0134: FINALLY
0135: FREEMEM (ProxyInfo);
0136: END;
0137: IF (DataString <> '') THEN
0138: BEGIN
0139: IF (ANSIPOS ('=', DataString) > 0) THEN
0140: BEGIN
0141: IF (ANSIPOS ('http=', DataString) > 0) THEN
0142: BEGIN
0143: DELETE (DataString, 1, ANSIPOS ('http=', DataString) + LENGTH ('http=') - 1);
0144: ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0145: DELETE (DataString, 1, ANSIPOS (':', DataString));
0146: ProxyPort := FNopm_StrToInt (DataString);
0147: END
0148: ELSE
0149: BEGIN
0150: ProxyHost := '';
0151: ProxyPort := 0;
0152: END;
0153: END
0154: ELSE
0155: BEGIN
0156: ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0157: DELETE (DataString, 1, ANSIPOS (':', DataString));
0158: ProxyPort := FNopm_StrToInt (DataString);
0159: END;
0160: END;
0161: END;
0162:
0163:
0164:
0165:
0166: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0167: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0168: PROCEDURE PRopm_WriteLog (LogString: STRING);
0169: VAR
0170: LogDirname: STRING;
0171: LogFile: TEXTFILE;
0172: BEGIN
0173: IF (opmG_DBDebugLog > 0) THEN
0174: BEGIN
0175: LogDirname := ExtractFilePath (Application.Exename);
0176: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0177: TRY
0178: IF FILEEXISTS (LogDirname + opmC_DebugFile) THEN APPEND (LogFile) ELSE REWRITE(Logfile);
0179: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW), '|', LogString);
0180: CLOSEFILE (LogFile)
0181: EXCEPT
0182: END;
0183: END;
0184: END;
0185:
0186:
0187:
0188: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0189: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0190: PROCEDURE PRopm_ResetLog;
0191: VAR
0192: LogDirname: STRING;
0193: LogFile: TEXTFILE;
0194: BEGIN
0195: LogDirname := ExtractFilePath (Application.Exename);
0196: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0197: TRY
0198: REWRITE(Logfile);
0199: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW));
0200: WRITELN (LogFile, opmC_DebugFileSeparator);
0201: WRITELN (LogFile, '');
0202: CLOSEFILE (LogFile)
0203: EXCEPT
0204: END;
0205: END;
0206:
0207:
0208:
0209: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0210: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0211: PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0212: BEGIN
0213: opmG_HTTP_ProgressBar := ProgressBar;
0214: opmG_HTTP_ProgressLabel := ProgressLabel;
0215: IF (UseProxy AND (opmG_WBProxyHost <> '') AND (opmG_WBProxyPort > 0)) THEN
0216: BEGIN
0217: opmG_HTTPClient.ProxyParams.ProxyServer := opmG_WBProxyHost;
0218: opmG_HTTPClient.ProxyParams.ProxyPort := opmG_WBProxyPort;
0219: END
0220: ELSE
0221: BEGIN
0222: opmG_HTTPClient.ProxyParams.ProxyServer := '';
0223: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0224: END;
0225: opmG_HTTPClient.ReadTimeout := opmC_Def_HTTPWaitFactor * opmG_HTTPConnWait;
0226: opmG_HTTPClient.ConnectTimeout := opmG_HTTPConnWait;
0227: opmG_HTTPClient.Request.UserAgent := opmG_FullUserAgent;
0228: IF (opmG_WBNoCacheImg > 0) THEN opmG_HTTPClient.Request.CacheControl := 'min-fresh=1,max-age=1,no-cache' ELSE opmG_HTTPClient.Request.CacheControl := '';
0229: END;
0230:
0231:
0232:
0233: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0234: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0235: PROCEDURE PRopm_Disconnect_HTTPClient;
0236: BEGIN
0237: opmG_HTTPClient.DisconnectSocket;
0238: END;
0239:
0240:
0241: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0242: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0243: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0244: BEGIN
0245: IF ((AWorkCountMax > 0) AND (opmG_HTTP_ProgressBar <> NIL)) THEN
0246: BEGIN
0247: opmG_HTTP_ProgressBar.Enabled := TRUE;
0248: opmG_HTTP_ProgressBar.Min := 0;
0249: opmG_HTTP_ProgressBar.Max := AWorkCountMax;
0250: opmG_HTTP_ProgressBar.Position := 0;
0251: END;
0252: Application.ProcessMessages;
0253: END;
0254:
0255: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0256: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0257: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0258: BEGIN
0259: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0260: BEGIN
0261: opmG_HTTP_ProgressLabel.Caption := INTTOSTR (AWorkCount) + _(' bytes');
0262: opmG_HTTP_ProgressBar.Position := AWorkCount;
0263: END;
0264: Application.ProcessMessages;
0265: END;
0266:
0267:
0268: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0269: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0270: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0271: BEGIN
0272: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0273: BEGIN
0274: opmG_HTTP_ProgressBar.Enabled := FALSE;
0275: opmG_HTTP_ProgressBar.Min := 0;
0276: opmG_HTTP_ProgressBar.Max := 100;
0277: opmG_HTTP_ProgressBar.Position := 0;
0278: opmG_HTTP_ProgressLabel.Caption := '';
0279: END;
0280: Application.ProcessMessages;
0281: END;
0282:
0283:
0284:
0285: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0286: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0287: FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0288: VAR
0289: FileStream : TMemoryStream;
0290: BEGIN
0291: FNopm_Download_File := FALSE;
0292: IF ((FileURL <> '') AND (FileFileName <> '')) THEN
0293: BEGIN
0294: SysUtils.DELETEFILE (FileFileName);
0295: FileURL := opmG_HTTPClient.URL.URLEncode (FileURL);
0296: opmG_HTTPClient.DisconnectSocket;
0297: FileStream := TMemoryStream.Create;
0298: TRY
0299: opmG_HTTPClient.Get (FileURL, FileStream);
0300: FileStream.SaveToFile (FileFileName);
0301: FNopm_Download_File := TRUE;
0302: EXCEPT
0303: ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;
0304: ELSE
0305: END;
0306: FileStream.Free;
0307: END;
0308: END;
0309:
0310:
0311: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0312: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0313: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING;
0314: VAR RenFileName : STRING) : LONGINT;
0315: VAR
0316: PostData : TIdMultiPartFormDataStream;
0317: UploadStamp : STRING;
0318: ErrPos : LONGINT;
0319: BEGIN
0320: FNopm_Upload_File := opmC_WebScriptDefaultCode;
0321: RenFileName := '';
0322: opmG_HTTPClient_TransactLog := '';
0323: IF ((UploadURL <> '') AND (FileFile <> '')) THEN
0324: BEGIN
0325: UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL);
0326: opmG_HTTPClient.DisconnectSocket;
0327: UploadStamp := DATETIMETOSTR (NOW);
0328: PostData := TIdMultiPartFormDataStream.Create;
0329: PostData.AddFormField ('Un', FNopm_MD5 (UploadStamp + opmG_DBUsername));
0330: PostData.AddFormField ('Pw', FNopm_MD5 (UploadStamp + opmG_DBPassword));
0331: PostData.AddFormField ('Op', 'upload');
0332: PostData.AddFormField ('Fn', FileFileName);
0333: PostData.AddFormField ('SD', FileSubdir);
0334: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0335: PostData.AddFormField ('TS', UploadStamp);
0336: PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0337: PostData.Position := 0;
0338: TRY
0339: TRY
0340: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0341: EXCEPT
0342: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0343: opmG_HTTPClient_TransactLog := '';
0344: END;
0345: FINALLY
0346: PostData.Free;
0347: END;
0348: RenFilename := opmG_HTTPClient_TransactLog;
0349: IF (opmG_HTTPClient_TransactLog <> '') THEN
0350: BEGIN
0351: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0352: BEGIN
0353: RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1);
0354: FNopm_Upload_File := 0
0355: END
0356: ELSE
0357: BEGIN
0358: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0359: IF (ErrPos > 0) THEN
0360: BEGIN
0361: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0362: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0363: IF (ErrPos > 0) THEN FNopm_Upload_File := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0364: END
0365: ELSE FNopm_Upload_File := opmC_WebScriptUnknownCode;
0366: END;
0367: END
0368: ELSE FNopm_Upload_File := opmC_WebScriptDefaultCode;
0369: END;
0370: END;
0371:
0372:
0373: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0374: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0375: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0376: VAR
0377: PostData : TIdMultiPartFormDataStream;
0378: CommandStamp : STRING;
0379: ErrPos : LONGINT;
0380: BEGIN
0381: FNopm_Send_Command := opmC_WebScriptDefaultCode;
0382: OpResult := '';
0383: opmG_HTTPClient_TransactLog := '';
0384: IF (OperationStr <> '') THEN
0385: BEGIN
0386: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0387: opmG_HTTPClient.DisconnectSocket;
0388: CommandStamp := DATETIMETOSTR (NOW);
0389: PostData := TIdMultiPartFormDataStream.Create;
0390: PostData.AddFormField ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername));
0391: PostData.AddFormField ('Pw', FNopm_MD5 (CommandStamp + opmG_DBPassword));
0392: PostData.AddFormField ('Op', OperationStr);
0393: PostData.AddFormField ('Fn', OpParams);
0394: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0395: PostData.AddFormField ('TS', CommandStamp);
0396: TRY
0397: TRY
0398: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0399: EXCEPT
0400: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0401: opmG_HTTPClient_TransactLog := '';
0402: END;
0403: FINALLY
0404: PostData.Free;
0405: END;
0406: OpResult := opmG_HTTPClient_TransactLog;
0407: IF (opmG_HTTPClient_TransactLog <> '') THEN
0408: BEGIN
0409: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0410: FNopm_Send_Command := 0
0411: ELSE
0412: BEGIN
0413: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0414: IF (ErrPos > 0) THEN
0415: BEGIN
0416: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0417: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0418: IF (ErrPos > 0) THEN FNopm_Send_Command := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0419: END
0420: ELSE FNopm_Send_Command := opmC_WebScriptUnknownCode;
0421: END;
0422: END
0423: ELSE FNopm_Send_Command := opmC_WebScriptDefaultCode;
0424: END;
0425: END;
0426:
0427:
0428: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0429: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0430: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0431: VAR
0432: PostData : TIdMultiPartFormDataStream;
0433: ErrPos : LONGINT;
0434: BEGIN
0435: FNopm_Send_SimpleCommand := opmC_WebDefaultCode;
0436: OpResult := '';
0437: opmG_HTTPClient_TransactLog := '';
0438: IF (OperationStr <> '') THEN
0439: BEGIN
0440: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0441: opmG_HTTPClient.DisconnectSocket;
0442: PostData := TIdMultiPartFormDataStream.Create;
0443: PostData.AddFormField ('Op', OperationStr);
0444: PostData.AddFormField ('Fn', OpParams);
0445: TRY
0446: TRY
0447: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0448: EXCEPT
0449: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0450: opmG_HTTPClient_TransactLog := '';
0451: END;
0452: FINALLY
0453: PostData.Free;
0454: END;
0455: OpResult := opmG_HTTPClient_TransactLog;
0456: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0457: FNopm_Send_SimpleCommand := 0
0458: ELSE
0459: BEGIN
0460: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0461: IF (ErrPos > 0) THEN
0462: BEGIN
0463: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0464: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0465: IF (ErrPos > 0) THEN FNopm_Send_SimpleCommand := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0466: END
0467: ELSE FNopm_Send_SimpleCommand := opmC_WebScriptUnknownCode;
0468: END;
0469: END;
0470: END;
0471:
0472:
0473: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0474: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0475: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0476: VAR
0477: PostData : TIdMultiPartFormDataStream;
0478: CommandStamp : STRING;
0479: FileStream : TMemoryStream;
0480: SugFileName : STRING;
0481: BEGIN
0482: FNopm_Receive_File := '';
0483: opmG_HTTPClient_TransactLog := '';
0484: SugFileName := '';
0485: SysUtils.DELETEFILE (RetFileName);
0486: IF (OperationStr <> '') THEN
0487: BEGIN
0488: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0489: opmG_HTTPClient.DisconnectSocket;
0490: CommandStamp := DATETIMETOSTR (NOW);
0491: PostData := TIdMultiPartFormDataStream.Create;
0492: PostData.AddFormField ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername));
0493: PostData.AddFormField ('Pw', FNopm_MD5 (CommandStamp + opmG_DBPassword));
0494: PostData.AddFormField ('Op', OperationStr);
0495: PostData.AddFormField ('Fn', RetFileName);
0496: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0497: PostData.AddFormField ('TS', CommandStamp);
0498: FileStream := TMemoryStream.Create;
0499: TRY
0500: TRY
0501: opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0502: IF (FileStream.Size > 10) THEN
0503: BEGIN
0504: FileStream.SaveToFile (RetFileName);
0505: SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0506: SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0507: FNopm_Receive_File := SugFileName;
0508: END
0509: ELSE FNopm_Receive_File := '';
0510: EXCEPT
0511: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0512: FNopm_Receive_File := '';
0513: END;
0514: FINALLY
0515: PostData.Free;
0516: FileStream.Free;
0517: END;
0518: END;
0519: END;
0520:
0521:
0522: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0523: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0524: FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0525: BEGIN
0526: CASE ErrorCode OF
0527: 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.');
0528: opmC_WebScriptUnknownCode : FNopm_FullRemoteError := 'ERROR 200: ' + _('General script error.') + #13#10 + _('The script failed and could not even report the error.');
0529: 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.');
0530: 1000 : FNopm_FullRemoteError := 'ERROR 1000: ' + _('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.' + #13#10 + 'Required version: ' + opmC_WebScriptVersion);
0531: 1010 : FNopm_FullRemoteError := 'ERROR 1010: ' + _('The server image directory cannot be found.');
0532: 1020 : FNopm_FullRemoteError := 'ERROR 1020: ' + _('The password is not correct.');
0533: 1021 : FNopm_FullRemoteError := 'ERROR 1021: ' + _('There has been an error while trying to get the server password.');
0534: 1024 : FNopm_FullRemoteError := 'ERROR 1024: ' + _('The server has blocked any connection from this IP address after too many login failures.');
0535: 1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.');
0536: 1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.');
0537: 1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).');
0538: 1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.');
0539: 1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).');
0540: 1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).');
0541: 1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).');
0542: 1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.');
0543: 1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).');
0544: 1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).');
0545: 1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).');
0546: ELSE
0547: FNopm_FullRemoteError := _('Unknown error.');
0548: END;
0549: END;
0550:
0551:
0552:
0553: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0554: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0555: FUNCTION FNopm_WebDB_Query (CommandURL, SQLString : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0556: VAR
0557: PostData : TIdMultiPartFormDataStream;
0558: CommandStamp : STRING;
0559: ErrPos : LONGINT;
0560: RetryCount : LONGINT;
0561: LapseTime : DOUBLE;
0562: ResultCode : LONGINT;
0563: BEGIN
0564: PRopm_WriteLog ('Executing query: ' + SQLString);
0565: ResultCode := opmC_WebScriptDefaultCode;
0566: RecSetArray.RowCount := 0;
0567: RecSetArray.ColCount := 0;
0568: RecSetArray.DataRows := 0;
0569: RecSetArray.DataCols := 0;
0570: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0571: opmG_HTTPClient_TransactLog := '';
0572: RetryCount := 0;
0573: IF (SQLString <> '') THEN
0574: BEGIN
0575: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0576: opmG_HTTPClient.DisconnectSocket;
0577: CommandStamp := DATETIMETOSTR (NOW);
0578: PostData := TIdMultiPartFormDataStream.Create;
0579: PostData.AddFormField ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername));
0580: PostData.AddFormField ('Pw', FNopm_MD5 (CommandStamp + opmG_DBPassword));
0581: PostData.AddFormField ('Op', 'dbquery');
0582: PostData.AddFormField ('Qy', FNopm_Base64_Encode (SQLString));
0583: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0584: PostData.AddFormField ('TS', CommandStamp);
0585: IF (opmG_HTTPCompress > 0) THEN PostData.AddFormField ('Gz', '1') ELSE PostData.AddFormField ('Gz', '0');
0586: TRY
0587: IF (FNopm_ConnectionState = TRUE) THEN
0588: BEGIN
0589: Application.ProcessMessages;
0590: REPEAT
0591: PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0592: TRY
0593: PRopm_WriteLog ('Go!');
0594: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0595: PRopm_WriteLog ('Done!');
0596: EXCEPT
0597: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0598: ON E : Exception DO
0599: BEGIN
0600: opmG_HTTPClient_TransactLog := '';
0601: PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message);
0602: END;
0603: END;
0604: IF (opmG_HTTPClient_TransactLog <> '') THEN
0605: BEGIN
0606: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0607: BEGIN
0608: ResultCode := FNopm_Unserial_DBQuery (opmG_HTTPClient_TransactLog, RecSetArray);
0609: PRopm_WriteLog ('Decoded records: ' + INTTOSTR (RecSetArray.DataRows) + 'x' + INTTOSTR (RecSetArray.DataCols) + ' Size: ' + INTTOSTR (RecSetArray.DataSize) + ' Original size: ' + INTTOSTR (RecSetArray.OrigSize));
0610: END
0611: ELSE
0612: BEGIN
0613: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0614: IF (ErrPos > 0) THEN
0615: BEGIN
0616: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0617: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0618: IF (ErrPos > 0) THEN ResultCode := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0619: END
0620: ELSE ResultCode := opmC_WebScriptUnknownCode;
0621: END;
0622: END
0623: ELSE
0624: BEGIN
0625: ResultCode := opmC_WebScriptDefaultCode;
0626: END;
0627: INC (RetryCount);
0628: IF (ResultCode = opmC_WebScriptDefaultCode) THEN
0629: BEGIN
0630: LapseTime := GetTickCount;
0631: REPEAT
0632: Application.ProcessMessages;
0633: UNTIL ((GetTickCount - LapseTime) > opmG_HTTPConnWait);
0634: END;
0635: UNTIL ((RetryCount > opmG_HTTPConnRetries) OR (ResultCode = 0));
0636: END
0637: ELSE
0638: BEGIN
0639: PRopm_WriteLog ('Connection was down. Nothing done.');
0640: END;
0641: FINALLY
0642: PostData.Free;
0643: END;
0644: END
0645: ELSE
0646: BEGIN
0647: PRopm_WriteLog ('Query was empty. Nothing done.');
0648: END;
0649: FNopm_WebDB_Query := ResultCode;
0650: END;
0651:
0652:
0653:
0654: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0655: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0656: PROCEDURE PRopm_Close_WebDBQuery;
0657: BEGIN
0658: opmG_DBQuery_Recordset.RowCount := 0;
0659: opmG_DBQuery_Recordset.ColCount := 0;
0660: opmG_DBQuery_Recordset.DataRows := 0;
0661: opmG_DBQuery_Recordset.DataCols := 0;
0662: SetLength (opmG_DBQuery_Recordset.Data, opmG_DBQuery_Recordset.RowCount, opmG_DBQuery_Recordset.ColCount);
0663: opmG_HTTPClient_TransactLog := '';
0664: END;
0665:
0666:
0667:
0668: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0669: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0670: FUNCTION FNopm_Unserial_DBQuery (VAR RecSetStr : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0671: VAR
0672: LineCount : LONGINT;
0673: RecCount, FieldCount : LONGINT;
0674: MaxFieldCount : LONGINT;
0675: TmpStr, TmpStr2 : STRING;
0676: DataList : TStringList;
0677: BEGIN
0678: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0679: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0680:
0681: PENDIENTE CODIGO DE VERIFICACION DE LIMITES MAXIMOS DE REGISTROS Y CAMPOS
0682: Y VERIFICACION DE INTEGRIDAD.
0683:
0684: PENDIENTE REVISAR INICIALIZACION DE RECSETARRAY.
0685:
0686: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0687: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0688: FNopm_Unserial_DBQuery := opmC_WebScriptDefaultCode;
0689: RecSetArray.RowCount := 0;
0690: RecSetArray.ColCount := 0;
0691: RecSetArray.DataRows := 0;
0692: RecSetArray.DataCols := 0;
0693: RecSetArray.DataSize := 0;
0694: RecSetArray.OrigSize := 0;
0695: TRY
0696: DataList := TStringList.Create;
0697: DataList.Text := RecSetStr;
0698: IF (DataList.Count > 2) THEN
0699: BEGIN
0700: DataList.Delete (0);
0701: DataList.Delete (DataList.Count - 1);
0702: IF (opmG_HTTPCompress > 0) THEN
0703: BEGIN
0704: TmpStr := TRIM (DataList.Text);
0705: DataList.Text := '';
0706: Application.ProcessMessages;
0707: TmpStr2 := FNopm_Base64_Decode (TmpStr);
0708: Application.ProcessMessages;
0709: TmpStr := '';
0710: Application.ProcessMessages;
0711: DataList.Text := FNopm_Inflate (TmpStr2);
0712: Application.ProcessMessages;
0713: TmpStr2 := '';
0714: END;
0715: RecCount := 0;
0716: FieldCount := 0;
0717: MaxFieldCount := 0;
0718: FOR LineCount := 0 TO (DataList.Count - 1) DO
0719: BEGIN
0720: IF (DataList.Strings[LineCount] = opmC_DBTag_RecBegin) THEN
0721: BEGIN
0722: INC (RecCount);
0723: IF (RecCount > RecSetArray.RowCount) THEN
0724: BEGIN
0725: RecSetArray.RowCount := RecCount + 100;
0726: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0727: END;
0728: FieldCount := 0;
0729: END;
0730: IF (COPY (DataList.Strings[LineCount], 1, 2) = opmC_DBTag_DataField) THEN
0731: BEGIN
0732: INC (FieldCount);
0733: IF (FieldCount > MaxFieldCount) THEN
0734: BEGIN
0735: MaxFieldCount := FieldCount;
0736: RecSetArray.ColCount := MaxFieldCount;
0737: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0738: END;
0739: TmpStr := COPY (DataList.Strings[LineCount], 5, LENGTH (DataList.Strings[LineCount]) - 5);
0740: RecSetArray.Data[(RecCount - 1), (FieldCount - 1)] := FNopm_Base64_Decode (TmpStr);
0741: INC (RecSetArray.DataSize, LENGTH (RecSetArray.Data[(RecCount - 1), (FieldCount - 1)]));
0742: INC (RecSetArray.OrigSize, LENGTH (TmpStr));
0743: END;
0744: END;
0745: RecSetArray.DataRows := RecCount;
0746: RecSetArray.DataCols := MaxFieldCount;
0747: FNopm_Unserial_DBQuery := 0;
0748: END
0749: ELSE
0750: BEGIN
0751: FNopm_Unserial_DBQuery := 0;
0752: END;
0753: FINALLY
0754: FreeAndNIL (DataList);
0755: END;
0756: END;
0757:
0758:
0759:
0760: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0761: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0762: INITIALIZATION
0763:
0764: ExistNetLink := FNopm_NetExist;
0765: opmG_WeAreConnected := FALSE;
0766:
0767: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0768: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0769: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0770: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0771: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0772:
0773: opmG_HTTPClient := TIdHTTP.Create (Application);
0774: opmG_HTTPClient.MaxLineAction := maException;
0775: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0776: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0777: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0778: opmG_HTTPClient.AllowCookies := False;
0779: opmG_HTTPClient.HandleRedirects := True;
0780: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0781: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0782: opmG_HTTPClient.Request.ContentLength := 0;
0783: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0784: opmG_HTTPClient.Request.ContentRangeStart := 0;
0785: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0786: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0787: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0788: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0789:
0790:
0791: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0792:
0793:
0794:
0795:
0796: end.
