Source code of file oscpmwin_v0.1.2.484/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 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 ('Un', opm_FNMD5 (UploadStamp + opmG_DBUsername));
0526: PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword));
0527: PostData.AddFormField ('Op', 'upload');
0528: PostData.AddFormField ('Fn', FileFileName);
0529: PostData.AddFormField ('SD', FileSubdir);
0530: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0531: PostData.AddFormField ('TS', UploadStamp);
0532: PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0533: PostData.Position := 0;
0534: TRY
0535: TRY
0536: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0537: EXCEPT
0538: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0539: opmG_HTTPClient_TransactLog := '';
0540: END;
0541: FINALLY
0542: PostData.Free;
0543: END;
0544: RenFilename := opmG_HTTPClient_TransactLog;
0545: IF (opmG_HTTPClient_TransactLog <> '') THEN
0546: BEGIN
0547: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0548: BEGIN
0549: RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1);
0550: FNopm_Upload_File := 0
0551: END
0552: ELSE
0553: BEGIN
0554: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0555: IF (ErrPos > 0) THEN
0556: BEGIN
0557: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0558: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0559: IF (ErrPos > 0) THEN FNopm_Upload_File := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0560: END
0561: ELSE FNopm_Upload_File := opmC_WebScriptUnknownCode;
0562: END;
0563: END
0564: ELSE FNopm_Upload_File := opmC_WebScriptDefaultCode;
0565: END;
0566: END;
0567:
0568:
0569: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0570: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0571: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0572: VAR
0573: PostData : TIdMultiPartFormDataStream;
0574: CommandStamp : STRING;
0575: ErrPos : LONGINT;
0576: BEGIN
0577: FNopm_Send_Command := opmC_WebScriptDefaultCode;
0578: OpResult := '';
0579: opmG_HTTPClient_TransactLog := '';
0580: IF (OperationStr <> '') THEN
0581: BEGIN
0582: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0583: opmG_HTTPClient.DisconnectSocket;
0584: CommandStamp := DATETIMETOSTR (NOW);
0585: PostData := TIdMultiPartFormDataStream.Create;
0586: PostData.AddFormField ('Un', opm_FNMD5 (CommandStamp + opmG_DBUsername));
0587: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0588: PostData.AddFormField ('Op', OperationStr);
0589: PostData.AddFormField ('Fn', OpParams);
0590: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0591: PostData.AddFormField ('TS', CommandStamp);
0592: TRY
0593: TRY
0594: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0595: EXCEPT
0596: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0597: opmG_HTTPClient_TransactLog := '';
0598: END;
0599: FINALLY
0600: PostData.Free;
0601: END;
0602: OpResult := opmG_HTTPClient_TransactLog;
0603: IF (opmG_HTTPClient_TransactLog <> '') THEN
0604: BEGIN
0605: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0606: FNopm_Send_Command := 0
0607: ELSE
0608: BEGIN
0609: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0610: IF (ErrPos > 0) THEN
0611: BEGIN
0612: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0613: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0614: IF (ErrPos > 0) THEN FNopm_Send_Command := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0615: END
0616: ELSE FNopm_Send_Command := opmC_WebScriptUnknownCode;
0617: END;
0618: END
0619: ELSE FNopm_Send_Command := opmC_WebScriptDefaultCode;
0620: END;
0621: END;
0622:
0623:
0624: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0625: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0626: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0627: VAR
0628: PostData : TIdMultiPartFormDataStream;
0629: ErrPos : LONGINT;
0630: BEGIN
0631: FNopm_Send_SimpleCommand := opmC_WebDefaultCode;
0632: OpResult := '';
0633: opmG_HTTPClient_TransactLog := '';
0634: IF (OperationStr <> '') THEN
0635: BEGIN
0636: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0637: opmG_HTTPClient.DisconnectSocket;
0638: PostData := TIdMultiPartFormDataStream.Create;
0639: PostData.AddFormField ('Op', OperationStr);
0640: PostData.AddFormField ('Fn', OpParams);
0641: TRY
0642: TRY
0643: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0644: EXCEPT
0645: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0646: opmG_HTTPClient_TransactLog := '';
0647: END;
0648: FINALLY
0649: PostData.Free;
0650: END;
0651: OpResult := opmG_HTTPClient_TransactLog;
0652: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0653: FNopm_Send_SimpleCommand := 0
0654: ELSE
0655: BEGIN
0656: ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0657: IF (ErrPos > 0) THEN
0658: BEGIN
0659: DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0660: ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0661: IF (ErrPos > 0) THEN FNopm_Send_SimpleCommand := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0662: END
0663: ELSE FNopm_Send_SimpleCommand := opmC_WebScriptUnknownCode;
0664: END;
0665: END;
0666: END;
0667:
0668:
0669: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0670: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0671: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0672: VAR
0673: PostData : TIdMultiPartFormDataStream;
0674: CommandStamp : STRING;
0675: FileStream : TMemoryStream;
0676: SugFileName : STRING;
0677: BEGIN
0678: FNopm_Receive_File := '';
0679: opmG_HTTPClient_TransactLog := '';
0680: SugFileName := '';
0681: SysUtils.DELETEFILE (RetFileName);
0682: IF (OperationStr <> '') THEN
0683: BEGIN
0684: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0685: opmG_HTTPClient.DisconnectSocket;
0686: CommandStamp := DATETIMETOSTR (NOW);
0687: PostData := TIdMultiPartFormDataStream.Create;
0688: PostData.AddFormField ('Un', opm_FNMD5 (CommandStamp + opmG_DBUsername));
0689: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0690: PostData.AddFormField ('Op', OperationStr);
0691: PostData.AddFormField ('Fn', RetFileName);
0692: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0693: PostData.AddFormField ('TS', CommandStamp);
0694: FileStream := TMemoryStream.Create;
0695: TRY
0696: TRY
0697: opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0698: IF (FileStream.Size > 10) THEN
0699: BEGIN
0700: FileStream.SaveToFile (RetFileName);
0701: SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0702: SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0703: FNopm_Receive_File := SugFileName;
0704: END
0705: ELSE FNopm_Receive_File := '';
0706: EXCEPT
0707: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0708: FNopm_Receive_File := '';
0709: END;
0710: FINALLY
0711: PostData.Free;
0712: FileStream.Free;
0713: END;
0714: END;
0715: END;
0716:
0717:
0718: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0719: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0720: FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0721: BEGIN
0722: CASE ErrorCode OF
0723: 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.');
0724: opmC_WebScriptUnknownCode : FNopm_FullRemoteError := 'ERROR 200: ' + _('General script error.') + #13#10 + _('The script failed and could not even report the error.');
0725: 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.');
0726: 1000 : FNopm_FullRemoteError := 'ERROR 1000: ' + _('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.');
0727: 1010 : FNopm_FullRemoteError := 'ERROR 1010: ' + _('The server image directory cannot be found.');
0728: 1020 : FNopm_FullRemoteError := 'ERROR 1020: ' + _('The password is not correct.');
0729: 1021 : FNopm_FullRemoteError := 'ERROR 1021: ' + _('There has been an error while trying to get the server password.');
0730: 1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.');
0731: 1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.');
0732: 1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).');
0733: 1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.');
0734: 1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).');
0735: 1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).');
0736: 1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).');
0737: 1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.');
0738: 1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).');
0739: 1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).');
0740: 1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).');
0741: ELSE
0742: FNopm_FullRemoteError := _('Unknown error.');
0743: END;
0744: END;
0745:
0746:
0747:
0748: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0749: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0750: INITIALIZATION
0751:
0752: ExistNetLink := FNopm_NetExist;
0753: opmG_DBConnection := TZConnection.Create (Application);
0754: opmG_DBConnection.AutoCommit := TRUE;
0755: opmG_DBConnection.ReadOnly := TRUE;
0756: opmG_DBConnection.TransactIsolationLevel := tiNone;
0757: opmG_DBQuery := TZQuery.Create (Application);
0758: opmG_DBQuery.RequestLive := FALSE;
0759: opmG_DBQuery.CachedUpdates := FALSE;
0760: opmG_DBQuery.ParamCheck := FALSE;
0761: opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted];
0762: opmG_DBQuery.UpdateMode := umUpdateChanged;
0763: opmG_DBQuery.WhereMode := wmWhereKeyOnly;
0764: opmG_DBQuery.Options := [doCalcDefaults];
0765: opmG_DBQuery.Connection := opmG_DBConnection;
0766:
0767:
0768: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0769: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0770: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0771: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0772: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0773:
0774: opmG_HTTPClient := TIdHTTP.Create (Application);
0775: opmG_HTTPClient.MaxLineAction := maException;
0776: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0777: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0778: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0779: opmG_HTTPClient.AllowCookies := False;
0780: opmG_HTTPClient.HandleRedirects := True;
0781: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0782: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0783: opmG_HTTPClient.Request.ContentLength := 0;
0784: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0785: opmG_HTTPClient.Request.ContentRangeStart := 0;
0786: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0787: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0788: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0789: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0790:
0791:
0792: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0793:
0794:
0795: SSHTunnelHandle := 0;
0796:
0797:
0798: end.
