Source code of file oscpmwin_v0.1.2.436/network.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003,2004,2005 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 ZConnection, ZAbstractRODataset, ZAbstractDataset, ZDataset, ZDbcCache, IdComponent, IdHTTP, StdCtrls, ComCtrls,
0027: IdAntiFreezeBase, IdAntiFreeze, IdSSLOpenSSL;
0028:
0029: TYPE
0030: Topm_EventHandler = CLASS
0031: PROCEDURE PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0032: PROCEDURE PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0033: PROCEDURE PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0034: END;
0035:
0036:
0037: FUNCTION FNopm_NetExist : BOOLEAN;
0038: FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD; DBProt, DBBase, DBUser, DBPass : STRING; DBCompress : INTEGER) : STRING;
0039: FUNCTION FNopm_CloseDBConnection : STRING;
0040: FUNCTION FNopm_ConnectionState : BOOLEAN;
0041: FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT;
0042: FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING;
0043: FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN;
0044: PROCEDURE PRopm_CloseSSHTunnel;
0045: FUNCTION FNopm_CheckStallTunnel : BOOLEAN;
0046: PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0047: PROCEDURE PRopm_WriteLog (LogString: STRING);
0048: PROCEDURE PRopm_ResetLog;
0049: PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0050: PROCEDURE PRopm_Disconnect_HTTPClient;
0051: FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0052: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING; VAR RenFileName : STRING) : LONGINT;
0053: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0054: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0055: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0056: FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0057:
0058:
0059: VAR
0060: ExistNetLink : BOOLEAN;
0061: opmG_DBConnection : TZConnection;
0062: SSHTunnelHandle : CARDINAL;
0063: opmG_Network_EventHandler : Topm_EventHandler;
0064: opmG_DBQuery : TZQuery;
0065: opmG_HTTPClient: TIdHTTP;
0066: opmG_SSLHandler: TIdSSLIOHandlerSocket;
0067: opmG_HTTP_ProgressBar : TProgressBar;
0068: opmG_HTTP_ProgressLabel : TLabel;
0069: opmG_INDY_AntiFreeze : TIdAntiFreeze;
0070: opmG_HTTPClient_TransactLog : STRING;
0071:
0072:
0073: IMPLEMENTATION
0074:
0075: USES Windows, SysUtils, gnugettext, ZDbcIntfs, Forms, dataman, oscpmdata, WinInet, Dialogs, attention, IdGlobal,
0076: Classes, imageman, IdMultipartFormData;
0077:
0078:
0079: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0080: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0081: FUNCTION FNopm_NetExist : BOOLEAN;
0082: BEGIN
0083: IF ((GetSystemMetrics (SM_NETWORK) AND $01) > 0) THEN
0084: FNopm_NetExist := TRUE
0085: ELSE
0086: FNopm_NetExist := FALSE;
0087: END;
0088:
0089:
0090:
0091: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0092: Open a connection to the database server.
0093: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0094: FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD;
0095: DBProt, DBBase, DBUser, DBPass : STRING;
0096: DBCompress : INTEGER) : STRING;
0097: VAR
0098: LapseTime : DOUBLE;
0099: ConnTries : LONGINT;
0100: BEGIN
0101: FNopm_OpenDBConnection := 'ERROR';
0102: IF ((DBHost <> '') AND
0103: (DBPort > 0) AND
0104: (DBProt <> '') AND
0105: (DBBase <> '') AND
0106: (DBUser <> '') AND
0107: (opmG_DBConnection.Connected = FALSE)) THEN
0108: BEGIN
0109: opmG_DBConnection.HostName := DBHost;
0110: opmG_DBConnection.Port := DBPort;
0111: opmG_DBConnection.Protocol := DBProt;
0112: opmG_DBConnection.Database := DBBase;
0113: opmG_DBConnection.User := DBUser;
0114: opmG_DBConnection.Password := DBPass;
0115: IF (DBCompress > 0) THEN
0116: opmG_DBConnection.Properties.Text := 'compress=yes'
0117: ELSE
0118: opmG_DBConnection.Properties.Text := '';
0119: FOR ConnTries := 1 TO opmG_DBConnRetries DO
0120: BEGIN
0121: TRY
0122: opmG_DBConnection.Connect;
0123: EXCEPT
0124: ON E : Exception DO
0125: BEGIN
0126: FNopm_OpenDBConnection := _('Error while connecting to database') + ' (' + DBBase + ' @ ' + DBHost + ').'#13#10 + E.Message;
0127: END;
0128: END;
0129: LapseTime := GetTickCount;
0130: REPEAT
0131: Application.ProcessMessages;
0132: UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait);
0133: IF (opmG_DBConnection.Connected = TRUE) THEN
0134: BEGIN
0135: FNopm_OpenDBConnection := '';
0136: BREAK;
0137: END;
0138: END;
0139: END
0140: ELSE
0141: BEGIN
0142: FNopm_OpenDBConnection := _('Invalid database connection parameters or database already connected.');
0143: END;
0144: END;
0145:
0146:
0147: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0148: Closes the connection to the database server.
0149: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0150: FUNCTION FNopm_CloseDBConnection : STRING;
0151: BEGIN
0152: IF (opmG_DBConnection.Connected) THEN
0153: BEGIN
0154: opmG_DBConnection.Disconnect;
0155: FNopm_CloseDBConnection := '';
0156: END
0157: ELSE
0158: BEGIN
0159: FNopm_CloseDBConnection := _('The database is not connected');
0160: END;
0161: END;
0162:
0163:
0164:
0165: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0166: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0167: FUNCTION FNopm_ConnectionState : BOOLEAN;
0168: BEGIN
0169: FNopm_ConnectionState := opmG_DBConnection.Connected;
0170: END;
0171:
0172:
0173:
0174: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0175: Send a SQL query to the database server, returning the number
0176: of returned records (if any). If query is a SELECT, the Query
0177: is keep Active so other routines can read its records.
0178: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0179: FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT;
0180: VAR
0181: RetryCount : LONGINT;
0182: ResultStatus : LONGINT;
0183: StatusString : STRING;
0184: LapseTime : DOUBLE;
0185: BEGIN
0186: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Executing query of type ' + INTTOSTR (SQLQueryType) + ': ' + SQLQueryString);
0187: RetryCount := 0;
0188: IF (SQLQueryString <> '') THEN
0189: BEGIN
0190: ResultStatus := -1;
0191: StatusString := '';
0192: IF (FNopm_ConnectionState) THEN
0193: BEGIN
0194: Application.ProcessMessages;
0195: REPEAT
0196: IF (SQLQueryType = opmC_SQLSelect) THEN
0197: BEGIN
0198: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0199: TRY
0200: {opmG_DBQuery.Active := FALSE;}
0201: opmG_DBQuery.Close;
0202: opmG_DBQuery.SQL.Clear;
0203: opmG_DBQuery.SQL.Add (SQLQueryString);
0204: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!');
0205: {opmG_DBQuery.Active := TRUE;}
0206: opmG_DBQuery.Open;
0207: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!');
0208: ResultStatus := opmG_DBQuery.RecordCount;
0209: EXCEPT
0210: ON E : Exception DO
0211: BEGIN
0212: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR! : ' + E.Message);
0213: StatusString := E.Message;
0214: END;
0215: END;
0216: END
0217: ELSE IF ((SQLQueryType = opmC_SQLUpdate) OR (SQLQueryType = opmC_SQLInsert) OR (SQLQueryType = opmC_SQLDelete)) THEN
0218: BEGIN
0219: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0220: TRY
0221: opmG_DBQuery.Active := FALSE;
0222: opmG_DBQuery.SQL.Clear;
0223: opmG_DBQuery.SQL.Add (SQLQueryString);
0224: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!');
0225: opmG_DBQuery.ExecSQL;
0226: opmG_DBQuery.Active := FALSE;
0227: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!');
0228: ResultStatus := 0;
0229: EXCEPT
0230: ON E : Exception DO
0231: BEGIN
0232: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message);
0233: StatusString := E.Message;
0234: END;
0235: END;
0236: END;
0237: INC (RetryCount);
0238: IF (ResultStatus < 0) THEN
0239: BEGIN
0240: LapseTime := GetTickCount;
0241: REPEAT
0242: Application.ProcessMessages;
0243: UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait);
0244: END;
0245: UNTIL (RetryCount > 3) OR (ResultStatus >= 0);
0246: IF (ResultStatus < 0) THEN FNopm_Message (_('An error ocurred while processing the database query.') + #13#10 + StatusString, mtError, [mbOk], opmG_UISilent);
0247: END
0248: ELSE
0249: BEGIN
0250: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Connection was down. Nothing done.');
0251: END;
0252: END
0253: ELSE
0254: BEGIN
0255: ResultStatus := 0;
0256: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Query was empty. Nothing done.');
0257: END;
0258: FNopm_ExecQuery := ResultStatus;
0259: END;
0260:
0261:
0262:
0263: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0264: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0265: FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN;
0266: VAR
0267: CallParams : STRING;
0268: BEGIN
0269: CallParams := FNopm_BuildTunnelCall (SSHLHost, SSHRHost, SSHLPort, SSHRPort, SSHUser, SSHPass, (opmC_Def_SSHCompress > 0));
0270: IF (VisibleWindow > 0) THEN
0271: BEGIN
0272: SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0273: CallParams, ExtractFilePath (Application.Exename), FALSE, TRUE, opmG_SSHConnWait);
0274: END
0275: ELSE
0276: SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0277: CallParams, ExtractFilePath (Application.Exename), FALSE, FALSE, opmG_SSHConnWait);
0278: FNopm_OpenSSHTunnel := (SSHTunnelHandle > 0);
0279: END;
0280:
0281:
0282: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0283: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0284: FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING;
0285: VAR
0286: PlinkParams : STRING;
0287: BEGIN
0288: PLinkParams := '-ssh -' + INTTOSTR (opmC_Def_SSHProtocol);
0289: IF (Compress = TRUE) THEN PLinkParams := PLinkParams + ' -C';
0290: PLinkParams := PLinkParams + ' -l ' + SSHUser + ' -pw ' + SSHPass;
0291: PLinkParams := PLinkParams + ' -L ' + INTTOSTR (SSHLPort) + ':' + SSHLHost + ':' + INTTOSTR (SSHRPort);
0292: PLinkParams := PLinkParams + ' ' + SSHRHost + '';
0293: FNopm_BuildTunnelCall := PLinkParams;
0294: END;
0295:
0296:
0297: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0298: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0299: PROCEDURE PRopm_CloseSSHTunnel;
0300: BEGIN
0301: PRopm_StopExternalApp (SSHTunnelHandle);
0302: SSHTunnelHandle := 0;
0303: END;
0304:
0305:
0306: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0307: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0308: FUNCTION FNopm_CheckStallTunnel : BOOLEAN;
0309: BEGIN
0310: FNopm_CheckStallTunnel := (FNopm_IsAppRunning (opmC_Def_SSHExe) = TRUE);
0311: END;
0312:
0313:
0314: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0315: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0316: PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0317: VAR
0318: ProxyInfo : PInternetProxyInfo;
0319: DataLen : CARDINAL;
0320: DataString : STRING;
0321: BEGIN
0322: DataString := '';
0323: ProxyHost := '';
0324: ProxyPort := 0;
0325: DataLen := 4096;
0326: GetMem (ProxyInfo, DataLen);
0327: TRY
0328: IF (InternetQueryOption (NIL, INTERNET_OPTION_PROXY, ProxyInfo, DataLen)) THEN
0329: IF (ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY) THEN
0330: BEGIN
0331: DataString := ProxyInfo^.lpszProxy;
0332: END;
0333: FINALLY
0334: FREEMEM (ProxyInfo);
0335: END;
0336: IF (DataString <> '') THEN
0337: BEGIN
0338: IF (ANSIPOS ('=', DataString) > 0) THEN
0339: BEGIN
0340: IF (ANSIPOS ('http=', DataString) > 0) THEN
0341: BEGIN
0342: DELETE (DataString, 1, ANSIPOS ('http=', DataString) + LENGTH ('http=') - 1);
0343: ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0344: DELETE (DataString, 1, ANSIPOS (':', DataString));
0345: ProxyPort := FNopm_StrToInt (DataString);
0346: END
0347: ELSE
0348: BEGIN
0349: ProxyHost := '';
0350: ProxyPort := 0;
0351: END;
0352: END
0353: ELSE
0354: BEGIN
0355: ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0356: DELETE (DataString, 1, ANSIPOS (':', DataString));
0357: ProxyPort := FNopm_StrToInt (DataString);
0358: END;
0359: END;
0360: END;
0361:
0362:
0363:
0364:
0365: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0366: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0367: PROCEDURE PRopm_WriteLog (LogString: STRING);
0368: VAR
0369: LogDirname: STRING;
0370: LogFile: TEXTFILE;
0371: BEGIN
0372: LogDirname := ExtractFilePath (Application.Exename);
0373: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0374: TRY
0375: IF FILEEXISTS (LogDirname + opmC_DebugFile) THEN APPEND (LogFile) ELSE REWRITE(Logfile);
0376: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW), '|', LogString);
0377: CLOSEFILE (LogFile)
0378: EXCEPT
0379: END;
0380: END;
0381:
0382:
0383:
0384: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0385: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0386: PROCEDURE PRopm_ResetLog;
0387: VAR
0388: LogDirname: STRING;
0389: LogFile: TEXTFILE;
0390: BEGIN
0391: LogDirname := ExtractFilePath (Application.Exename);
0392: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0393: TRY
0394: REWRITE(Logfile);
0395: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW));
0396: WRITELN (LogFile, opmC_DebugFileSeparator);
0397: WRITELN (LogFile, '');
0398: CLOSEFILE (LogFile)
0399: EXCEPT
0400: END;
0401: END;
0402:
0403:
0404:
0405: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0406: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0407: PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0408: BEGIN
0409: opmG_HTTP_ProgressBar := ProgressBar;
0410: opmG_HTTP_ProgressLabel := ProgressLabel;
0411: IF (UseProxy AND (opmG_WBProxyHost <> '') AND (opmG_WBProxyPort > 0)) THEN
0412: BEGIN
0413: opmG_HTTPClient.ProxyParams.ProxyServer := opmG_WBProxyHost;
0414: opmG_HTTPClient.ProxyParams.ProxyPort := opmG_WBProxyPort;
0415: END
0416: ELSE
0417: BEGIN
0418: opmG_HTTPClient.ProxyParams.ProxyServer := '';
0419: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0420: END;
0421: opmG_HTTPClient.ReadTimeout := opmC_Def_HTTPWaitFactor * opmG_HTTPConnWait;
0422: opmG_HTTPClient.ConnectTimeout := opmG_HTTPConnWait;
0423: opmG_HTTPClient.Request.UserAgent := opmG_FullUserAgent;
0424: IF (opmG_WBNoCacheImg > 0) THEN opmG_HTTPClient.Request.CacheControl := 'min-fresh=1,max-age=1,no-cache' ELSE opmG_HTTPClient.Request.CacheControl := '';
0425: END;
0426:
0427:
0428:
0429: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0430: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0431: PROCEDURE PRopm_Disconnect_HTTPClient;
0432: BEGIN
0433: opmG_HTTPClient.DisconnectSocket;
0434: END;
0435:
0436:
0437: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0438: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0439: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0440: BEGIN
0441: IF ((AWorkCountMax > 0) AND (opmG_HTTP_ProgressBar <> NIL)) THEN
0442: BEGIN
0443: opmG_HTTP_ProgressBar.Enabled := TRUE;
0444: opmG_HTTP_ProgressBar.Min := 0;
0445: opmG_HTTP_ProgressBar.Max := AWorkCountMax;
0446: opmG_HTTP_ProgressBar.Position := 0;
0447: END;
0448: Application.ProcessMessages;
0449: END;
0450:
0451: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0452: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0453: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0454: BEGIN
0455: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0456: BEGIN
0457: opmG_HTTP_ProgressLabel.Caption := INTTOSTR (AWorkCount) + _(' bytes');
0458: opmG_HTTP_ProgressBar.Position := AWorkCount;
0459: END;
0460: Application.ProcessMessages;
0461: END;
0462:
0463:
0464: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0465: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0466: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0467: BEGIN
0468: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0469: BEGIN
0470: opmG_HTTP_ProgressBar.Enabled := FALSE;
0471: opmG_HTTP_ProgressBar.Min := 0;
0472: opmG_HTTP_ProgressBar.Max := 100;
0473: opmG_HTTP_ProgressBar.Position := 0;
0474: opmG_HTTP_ProgressLabel.Caption := '';
0475: END;
0476: Application.ProcessMessages;
0477: END;
0478:
0479:
0480:
0481: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0482: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0483: FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0484: VAR
0485: FileStream : TMemoryStream;
0486: BEGIN
0487: FNopm_Download_File := FALSE;
0488: IF ((FileURL <> '') AND (FileFileName <> '')) THEN
0489: BEGIN
0490: SysUtils.DELETEFILE (FileFileName);
0491: FileURL := opmG_HTTPClient.URL.URLEncode (FileURL);
0492: opmG_HTTPClient.DisconnectSocket;
0493: FileStream := TMemoryStream.Create;
0494: TRY
0495: opmG_HTTPClient.Get (FileURL, FileStream);
0496: FileStream.SaveToFile (FileFileName);
0497: FNopm_Download_File := TRUE;
0498: EXCEPT
0499: ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;
0500: ELSE
0501: END;
0502: FileStream.Free;
0503: END;
0504: END;
0505:
0506:
0507: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0508: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0509: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING;
0510: VAR RenFileName : STRING) : LONGINT;
0511: VAR
0512: PostData : TIdMultiPartFormDataStream;
0513: UploadStamp : STRING;
0514: ErrPos : LONGINT;
0515: BEGIN
0516: FNopm_Upload_File := opmC_WebScriptDefaultCode;
0517: RenFileName := '';
0518: opmG_HTTPClient_TransactLog := '';
0519: IF ((UploadURL <> '') AND (FileFile <> '')) THEN
0520: BEGIN
0521: UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL);
0522: opmG_HTTPClient.DisconnectSocket;
0523: UploadStamp := DATETIMETOSTR (NOW);
0524: PostData := TIdMultiPartFormDataStream.Create;
0525: PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword));
0526: PostData.AddFormField ('Op', 'upload');
0527: PostData.AddFormField ('Fn', FileFileName);
0528: PostData.AddFormField ('SD', FileSubdir);
0529: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0530: PostData.AddFormField ('TS', UploadStamp);
0531: PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0532: PostData.Position := 0;
0533: TRY
0534: TRY
0535: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0536: EXCEPT
0537: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0538: opmG_HTTPClient_TransactLog := '';
0539: END;
0540: FINALLY
0541: PostData.Free;
0542: END;
0543: RenFilename := opmG_HTTPClient_TransactLog;
0544: IF (opmG_HTTPClient_TransactLog <> '') THEN
0545: BEGIN
0546: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0547: BEGIN
0548: RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1);
0549: FNopm_Upload_File := 0
0550: END
0551: ELSE
0552: BEGIN
0553: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0554: IF (ErrPos > 0) THEN
0555: BEGIN
0556: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0557: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0558: IF (ErrPos > 0) THEN FNopm_Upload_File := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0559: END
0560: ELSE FNopm_Upload_File := opmC_WebScriptUnknownCode;
0561: END;
0562: END
0563: ELSE FNopm_Upload_File := opmC_WebScriptDefaultCode;
0564: END;
0565: END;
0566:
0567:
0568: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0569: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0570: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0571: VAR
0572: PostData : TIdMultiPartFormDataStream;
0573: CommandStamp : STRING;
0574: ErrPos : LONGINT;
0575: BEGIN
0576: FNopm_Send_Command := opmC_WebScriptDefaultCode;
0577: OpResult := '';
0578: opmG_HTTPClient_TransactLog := '';
0579: IF (OperationStr <> '') THEN
0580: BEGIN
0581: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0582: opmG_HTTPClient.DisconnectSocket;
0583: CommandStamp := DATETIMETOSTR (NOW);
0584: PostData := TIdMultiPartFormDataStream.Create;
0585: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0586: PostData.AddFormField ('Op', OperationStr);
0587: PostData.AddFormField ('Fn', OpParams);
0588: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0589: PostData.AddFormField ('TS', CommandStamp);
0590: TRY
0591: TRY
0592: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0593: EXCEPT
0594: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0595: opmG_HTTPClient_TransactLog := '';
0596: END;
0597: FINALLY
0598: PostData.Free;
0599: END;
0600: OpResult := opmG_HTTPClient_TransactLog;
0601: IF (opmG_HTTPClient_TransactLog <> '') THEN
0602: BEGIN
0603: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0604: FNopm_Send_Command := 0
0605: ELSE
0606: BEGIN
0607: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0608: IF (ErrPos > 0) THEN
0609: BEGIN
0610: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0611: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0612: IF (ErrPos > 0) THEN FNopm_Send_Command := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0613: END
0614: ELSE FNopm_Send_Command := opmC_WebScriptUnknownCode;
0615: END;
0616: END
0617: ELSE FNopm_Send_Command := opmC_WebScriptDefaultCode;
0618: END;
0619: END;
0620:
0621:
0622: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0623: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0624: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0625: VAR
0626: PostData : TIdMultiPartFormDataStream;
0627: ErrPos : LONGINT;
0628: BEGIN
0629: FNopm_Send_SimpleCommand := opmC_WebDefaultCode;
0630: OpResult := '';
0631: opmG_HTTPClient_TransactLog := '';
0632: IF (OperationStr <> '') THEN
0633: BEGIN
0634: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0635: opmG_HTTPClient.DisconnectSocket;
0636: PostData := TIdMultiPartFormDataStream.Create;
0637: PostData.AddFormField ('Op', OperationStr);
0638: PostData.AddFormField ('Fn', OpParams);
0639: TRY
0640: TRY
0641: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0642: EXCEPT
0643: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0644: opmG_HTTPClient_TransactLog := '';
0645: END;
0646: FINALLY
0647: PostData.Free;
0648: END;
0649: OpResult := opmG_HTTPClient_TransactLog;
0650: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0651: FNopm_Send_SimpleCommand := 0
0652: ELSE
0653: BEGIN
0654: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0655: IF (ErrPos > 0) THEN
0656: BEGIN
0657: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0658: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0659: IF (ErrPos > 0) THEN FNopm_Send_SimpleCommand := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0660: END
0661: ELSE FNopm_Send_SimpleCommand := opmC_WebScriptUnknownCode;
0662: END;
0663: END;
0664: END;
0665:
0666:
0667: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0668: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0669: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0670: VAR
0671: PostData : TIdMultiPartFormDataStream;
0672: CommandStamp : STRING;
0673: FileStream : TMemoryStream;
0674: SugFileName : STRING;
0675: BEGIN
0676: FNopm_Receive_File := '';
0677: opmG_HTTPClient_TransactLog := '';
0678: SugFileName := '';
0679: SysUtils.DELETEFILE (RetFileName);
0680: IF (OperationStr <> '') THEN
0681: BEGIN
0682: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0683: opmG_HTTPClient.DisconnectSocket;
0684: CommandStamp := DATETIMETOSTR (NOW);
0685: PostData := TIdMultiPartFormDataStream.Create;
0686: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0687: PostData.AddFormField ('Op', OperationStr);
0688: PostData.AddFormField ('Fn', RetFileName);
0689: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0690: PostData.AddFormField ('TS', CommandStamp);
0691: FileStream := TMemoryStream.Create;
0692: TRY
0693: TRY
0694: opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0695: IF (FileStream.Size > 10) THEN
0696: BEGIN
0697: FileStream.SaveToFile (RetFileName);
0698: SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0699: SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0700: FNopm_Receive_File := SugFileName;
0701: END
0702: ELSE FNopm_Receive_File := '';
0703: EXCEPT
0704: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0705: FNopm_Receive_File := '';
0706: END;
0707: FINALLY
0708: PostData.Free;
0709: FileStream.Free;
0710: END;
0711: END;
0712: END;
0713:
0714:
0715: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0716: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0717: FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0718: BEGIN
0719: CASE ErrorCode OF
0720: 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.');
0721: opmC_WebScriptUnknownCode : FNopm_FullRemoteError := 'ERROR 200: ' + _('General script error.') + #13#10 + _('The script failed and could not even report the error.');
0722: 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.');
0723: 1000 : FNopm_FullRemoteError := 'ERROR 1000: ' + _('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.');
0724: 1010 : FNopm_FullRemoteError := 'ERROR 1010: ' + _('The server image directory cannot be found.');
0725: 1020 : FNopm_FullRemoteError := 'ERROR 1020: ' + _('The password is not correct.');
0726: 1021 : FNopm_FullRemoteError := 'ERROR 1021: ' + _('There has been an error while trying to get the server password.');
0727: 1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.');
0728: 1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.');
0729: 1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).');
0730: 1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.');
0731: 1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).');
0732: 1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).');
0733: 1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).');
0734: 1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.');
0735: 1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).');
0736: 1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).');
0737: 1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).');
0738: ELSE
0739: FNopm_FullRemoteError := _('Unknown error.');
0740: END;
0741: END;
0742:
0743:
0744:
0745: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0746: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0747: INITIALIZATION
0748:
0749: ExistNetLink := FNopm_NetExist;
0750: opmG_DBConnection := TZConnection.Create (Application);
0751: opmG_DBConnection.AutoCommit := TRUE;
0752: opmG_DBConnection.ReadOnly := TRUE;
0753: opmG_DBConnection.TransactIsolationLevel := tiNone;
0754: opmG_DBQuery := TZQuery.Create (Application);
0755: opmG_DBQuery.RequestLive := FALSE;
0756: opmG_DBQuery.CachedUpdates := FALSE;
0757: opmG_DBQuery.ParamCheck := FALSE;
0758: opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted];
0759: opmG_DBQuery.UpdateMode := umUpdateChanged;
0760: opmG_DBQuery.WhereMode := wmWhereKeyOnly;
0761: opmG_DBQuery.Options := [doCalcDefaults];
0762: opmG_DBQuery.Connection := opmG_DBConnection;
0763:
0764:
0765: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0766: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0767: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0768: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0769: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0770:
0771: opmG_HTTPClient := TIdHTTP.Create (Application);
0772: opmG_HTTPClient.MaxLineAction := maException;
0773: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0774: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0775: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0776: opmG_HTTPClient.AllowCookies := False;
0777: opmG_HTTPClient.HandleRedirects := True;
0778: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0779: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0780: opmG_HTTPClient.Request.ContentLength := 0;
0781: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0782: opmG_HTTPClient.Request.ContentRangeStart := 0;
0783: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0784: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0785: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0786: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0787:
0788:
0789: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0790:
0791:
0792: SSHTunnelHandle := 0;
0793:
0794: FINALIZATION
0795:
0796: {opmG_DBConnection.Free;}
0797:
0798: end.
