Source code of file oscpmwin_v0.4.1.642/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, Dialogs, attention, IdGlobal,
0071: Classes, imageman, 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.');
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: 1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.');
0535: 1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.');
0536: 1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).');
0537: 1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.');
0538: 1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).');
0539: 1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).');
0540: 1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).');
0541: 1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.');
0542: 1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).');
0543: 1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).');
0544: 1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).');
0545: ELSE
0546: FNopm_FullRemoteError := _('Unknown error.');
0547: END;
0548: END;
0549:
0550:
0551:
0552: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0553: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0554: FUNCTION FNopm_WebDB_Query (CommandURL, SQLString : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0555: VAR
0556: PostData : TIdMultiPartFormDataStream;
0557: CommandStamp : STRING;
0558: ErrPos : LONGINT;
0559: RetryCount : LONGINT;
0560: LapseTime : DOUBLE;
0561: ResultCode : LONGINT;
0562: BEGIN
0563: PRopm_WriteLog ('Executing query: ' + SQLString);
0564: ResultCode := opmC_WebScriptDefaultCode;
0565: RecSetArray.RowCount := 0;
0566: RecSetArray.ColCount := 0;
0567: RecSetArray.DataRows := 0;
0568: RecSetArray.DataCols := 0;
0569: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0570: opmG_HTTPClient_TransactLog := '';
0571: RetryCount := 0;
0572: IF (SQLString <> '') THEN
0573: BEGIN
0574: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0575: opmG_HTTPClient.DisconnectSocket;
0576: CommandStamp := DATETIMETOSTR (NOW);
0577: PostData := TIdMultiPartFormDataStream.Create;
0578: PostData.AddFormField ('Un', FNopm_MD5 (CommandStamp + opmG_DBUsername));
0579: PostData.AddFormField ('Pw', FNopm_MD5 (CommandStamp + opmG_DBPassword));
0580: PostData.AddFormField ('Op', 'dbquery');
0581: PostData.AddFormField ('Qy', FNopm_Base64_Encode (SQLString));
0582: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0583: PostData.AddFormField ('TS', CommandStamp);
0584: TRY
0585: IF (FNopm_ConnectionState = TRUE) THEN
0586: BEGIN
0587: Application.ProcessMessages;
0588: REPEAT
0589: PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0590: TRY
0591: PRopm_WriteLog ('Go!');
0592: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0593: PRopm_WriteLog ('Done!');
0594: EXCEPT
0595: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0596: ON E : Exception DO
0597: BEGIN
0598: opmG_HTTPClient_TransactLog := '';
0599: PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message);
0600: END;
0601: END;
0602: IF (opmG_HTTPClient_TransactLog <> '') THEN
0603: BEGIN
0604: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0605: BEGIN
0606: ResultCode := FNopm_Unserial_DBQuery (opmG_HTTPClient_TransactLog, RecSetArray);
0607: END
0608: ELSE
0609: BEGIN
0610: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0611: IF (ErrPos > 0) THEN
0612: BEGIN
0613: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0614: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0615: IF (ErrPos > 0) THEN ResultCode := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0616: END
0617: ELSE ResultCode := opmC_WebScriptUnknownCode;
0618: END;
0619: END
0620: ELSE
0621: BEGIN
0622: ResultCode := opmC_WebScriptDefaultCode;
0623: END;
0624: INC (RetryCount);
0625: IF (ResultCode = opmC_WebScriptDefaultCode) THEN
0626: BEGIN
0627: LapseTime := GetTickCount;
0628: REPEAT
0629: Application.ProcessMessages;
0630: UNTIL ((GetTickCount - LapseTime) > opmG_HTTPConnWait);
0631: END;
0632: UNTIL ((RetryCount > opmG_HTTPConnRetries) OR (ResultCode = 0));
0633: END
0634: ELSE
0635: BEGIN
0636: PRopm_WriteLog ('Connection was down. Nothing done.');
0637: END;
0638: FINALLY
0639: PostData.Free;
0640: END;
0641: END
0642: ELSE
0643: BEGIN
0644: PRopm_WriteLog ('Query was empty. Nothing done.');
0645: END;
0646: FNopm_WebDB_Query := ResultCode;
0647: END;
0648:
0649:
0650:
0651: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0652: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0653: PROCEDURE PRopm_Close_WebDBQuery;
0654: BEGIN
0655: opmG_DBQuery_Recordset.RowCount := 0;
0656: opmG_DBQuery_Recordset.ColCount := 0;
0657: opmG_DBQuery_Recordset.DataRows := 0;
0658: opmG_DBQuery_Recordset.DataCols := 0;
0659: SetLength (opmG_DBQuery_Recordset.Data, opmG_DBQuery_Recordset.RowCount, opmG_DBQuery_Recordset.ColCount);
0660: opmG_HTTPClient_TransactLog := '';
0661: END;
0662:
0663:
0664:
0665: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0666: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0667: FUNCTION FNopm_Unserial_DBQuery (VAR RecSetStr : STRING; VAR RecSetArray : opmR_DBQuery_Recordset) : LONGINT;
0668: VAR
0669: LineCount : LONGINT;
0670: RecCount, FieldCount : LONGINT;
0671: MaxFieldCount : LONGINT;
0672: TmpStr, TmpStr2 : STRING;
0673: DataList : TStringList;
0674: BEGIN
0675: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0676: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0677:
0678: PENDIENTE CODIGO DE VERIFICACION DE LIMITES MAXIMOS DE REGISTROS Y CAMPOS
0679: Y VERIFICACION DE INTEGRIDAD.
0680:
0681: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0682: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0683: FNopm_Unserial_DBQuery := opmC_WebScriptDefaultCode;
0684: TRY
0685: DataList := TStringList.Create;
0686: DataList.Text := RecSetStr;
0687: IF (DataList.Count > 2) THEN
0688: BEGIN
0689: DataList.Delete (0);
0690: DataList.Delete (DataList.Count - 1);
0691: TmpStr := TRIM (DataList.Text);
0692: DataList.Text := '';
0693: Application.ProcessMessages;
0694: TmpStr2 := FNopm_Base64_Decode (TmpStr);
0695: Application.ProcessMessages;
0696: TmpStr := '';
0697: Application.ProcessMessages;
0698: DataList.Text := FNopm_Inflate (TmpStr2);
0699: Application.ProcessMessages;
0700: TmpStr2 := '';
0701: RecCount := 0;
0702: FieldCount := 0;
0703: MaxFieldCount := 0;
0704: FOR LineCount := 0 TO (DataList.Count - 1) DO
0705: BEGIN
0706: IF (DataList.Strings[LineCount] = opmC_DBTag_RecBegin) THEN
0707: BEGIN
0708: INC (RecCount);
0709: IF (RecCount > RecSetArray.RowCount) THEN
0710: BEGIN
0711: RecSetArray.RowCount := RecCount + 100;
0712: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0713: END;
0714: FieldCount := 0;
0715: END;
0716: IF (COPY (DataList.Strings[LineCount], 1, 2) = opmC_DBTag_DataField) THEN
0717: BEGIN
0718: INC (FieldCount);
0719: IF (FieldCount > MaxFieldCount) THEN
0720: BEGIN
0721: MaxFieldCount := FieldCount;
0722: RecSetArray.ColCount := MaxFieldCount;
0723: SetLength (RecSetArray.Data, RecSetArray.RowCount, RecSetArray.ColCount);
0724: END;
0725: TmpStr := COPY (DataList.Strings[LineCount], 5, LENGTH (DataList.Strings[LineCount]) - 5);
0726: RecSetArray.Data[(RecCount - 1), (FieldCount - 1)] := FNopm_Base64_Decode (TmpStr);
0727: END;
0728: END;
0729: RecSetArray.DataRows := RecCount;
0730: RecSetArray.DataCols := MaxFieldCount;
0731: FNopm_Unserial_DBQuery := 0;
0732: END
0733: ELSE
0734: BEGIN
0735: FNopm_Unserial_DBQuery := 0;
0736: END;
0737: FINALLY
0738: FreeAndNIL (DataList);
0739: END;
0740: END;
0741:
0742:
0743:
0744: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0745: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0746: INITIALIZATION
0747:
0748: ExistNetLink := FNopm_NetExist;
0749: opmG_WeAreConnected := FALSE;
0750:
0751: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0752: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0753: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0754: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0755: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0756:
0757: opmG_HTTPClient := TIdHTTP.Create (Application);
0758: opmG_HTTPClient.MaxLineAction := maException;
0759: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0760: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0761: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0762: opmG_HTTPClient.AllowCookies := False;
0763: opmG_HTTPClient.HandleRedirects := True;
0764: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0765: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0766: opmG_HTTPClient.Request.ContentLength := 0;
0767: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0768: opmG_HTTPClient.Request.ContentRangeStart := 0;
0769: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0770: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0771: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0772: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0773:
0774:
0775: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0776:
0777:
0778:
0779:
0780: end.
