Source code of file oscpmwin_v0.1.2.189/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) : BOOLEAN;
0053: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0054: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0055: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0056:
0057:
0058: VAR
0059: ExistNetLink : BOOLEAN;
0060: opmG_DBConnection : TZConnection;
0061: SSHTunnelHandle : CARDINAL;
0062: opmG_Network_EventHandler : Topm_EventHandler;
0063: opmG_DBQuery : TZQuery;
0064: opmG_HTTPClient: TIdHTTP;
0065: opmG_SSLHandler: TIdSSLIOHandlerSocket;
0066: opmG_HTTP_ProgressBar : TProgressBar;
0067: opmG_HTTP_ProgressLabel : TLabel;
0068: opmG_INDY_AntiFreeze : TIdAntiFreeze;
0069: opmG_HTTPClient_TransactLog : STRING;
0070:
0071:
0072: IMPLEMENTATION
0073:
0074: USES Windows, SysUtils, gnugettext, ZDbcIntfs, Forms, dataman, oscpmdata, WinInet, Dialogs, attention, IdGlobal,
0075: Classes, imageman, IdMultipartFormData;
0076:
0077:
0078: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0079: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0080: FUNCTION FNopm_NetExist : BOOLEAN;
0081: BEGIN
0082: IF ((GetSystemMetrics (SM_NETWORK) AND $01) > 0) THEN
0083: FNopm_NetExist := TRUE
0084: ELSE
0085: FNopm_NetExist := FALSE;
0086: END;
0087:
0088:
0089:
0090: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0091: Open a connection to the database server.
0092: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0093: FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD;
0094: DBProt, DBBase, DBUser, DBPass : STRING;
0095: DBCompress : INTEGER) : STRING;
0096: VAR
0097: LapseTime : DOUBLE;
0098: ConnTries : LONGINT;
0099: BEGIN
0100: FNopm_OpenDBConnection := 'ERROR';
0101: IF ((DBHost <> '') AND
0102: (DBPort > 0) AND
0103: (DBProt <> '') AND
0104: (DBBase <> '') AND
0105: (DBUser <> '') AND
0106: (opmG_DBConnection.Connected = FALSE)) THEN
0107: BEGIN
0108: opmG_DBConnection.HostName := DBHost;
0109: opmG_DBConnection.Port := DBPort;
0110: opmG_DBConnection.Protocol := DBProt;
0111: opmG_DBConnection.Database := DBBase;
0112: opmG_DBConnection.User := DBUser;
0113: opmG_DBConnection.Password := DBPass;
0114: IF (DBCompress > 0) THEN
0115: opmG_DBConnection.Properties.Text := 'compress=yes'
0116: ELSE
0117: opmG_DBConnection.Properties.Text := '';
0118: FOR ConnTries := 1 TO opmG_DBConnRetries DO
0119: BEGIN
0120: TRY
0121: opmG_DBConnection.Connect;
0122: EXCEPT
0123: ON E : Exception DO
0124: BEGIN
0125: FNopm_OpenDBConnection := _('Error while connecting to database') + ' (' + DBBase + ' @ ' + DBHost + ').'#13#10 + E.Message;
0126: END;
0127: END;
0128: LapseTime := GetTickCount;
0129: REPEAT
0130: Application.ProcessMessages;
0131: UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait);
0132: IF (opmG_DBConnection.Connected = TRUE) THEN
0133: BEGIN
0134: FNopm_OpenDBConnection := '';
0135: BREAK;
0136: END;
0137: END;
0138: END
0139: ELSE
0140: BEGIN
0141: FNopm_OpenDBConnection := _('Invalid database connection parameters or database already connected.');
0142: END;
0143: END;
0144:
0145:
0146: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0147: Closes the connection to the database server.
0148: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0149: FUNCTION FNopm_CloseDBConnection : STRING;
0150: BEGIN
0151: IF (opmG_DBConnection.Connected) THEN
0152: BEGIN
0153: opmG_DBConnection.Disconnect;
0154: FNopm_CloseDBConnection := '';
0155: END
0156: ELSE
0157: BEGIN
0158: FNopm_CloseDBConnection := _('The database is not connected');
0159: END;
0160: END;
0161:
0162:
0163:
0164: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0165: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0166: FUNCTION FNopm_ConnectionState : BOOLEAN;
0167: BEGIN
0168: FNopm_ConnectionState := opmG_DBConnection.Connected;
0169: END;
0170:
0171:
0172:
0173: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0174: Send a SQL query to the database server, returning the number
0175: of returned records (if any). If query is a SELECT, the Query
0176: is keep Active so other routines can read its records.
0177: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0178: FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT;
0179: VAR
0180: RetryCount : LONGINT;
0181: ResultStatus : LONGINT;
0182: StatusString : STRING;
0183: LapseTime : DOUBLE;
0184: BEGIN
0185: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Executing query of type ' + INTTOSTR (SQLQueryType) + ': ' + SQLQueryString);
0186: RetryCount := 0;
0187: IF (SQLQueryString <> '') THEN
0188: BEGIN
0189: ResultStatus := -1;
0190: StatusString := '';
0191: IF (FNopm_ConnectionState) THEN
0192: BEGIN
0193: Application.ProcessMessages;
0194: //Screen.Cursor := opmC_Wait_Mouse;
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 := opmC_UserAgent + ' (' + opmG_PlatformVersion + '; ' + opmG_DBProtocol + ')';
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: FileURL := opmG_HTTPClient.URL.URLEncode (FileURL);
0491: opmG_HTTPClient.DisconnectSocket;
0492: FileStream := TMemoryStream.Create;
0493: TRY
0494: opmG_HTTPClient.Get (FileURL, FileStream);
0495: FileStream.SaveToFile (FileFileName);
0496: FNopm_Download_File := TRUE;
0497: EXCEPT
0498: ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;
0499: ELSE
0500: END;
0501: FileStream.Free;
0502: END;
0503: END;
0504:
0505:
0506: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0507: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0508: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING;
0509: VAR RenFileName : STRING) : BOOLEAN;
0510: VAR
0511: PostData : TIdMultiPartFormDataStream;
0512: UploadStamp : STRING;
0513: BEGIN
0514: FNopm_Upload_File := FALSE;
0515: RenFileName := '';
0516: opmG_HTTPClient_TransactLog := '';
0517: IF ((UploadURL <> '') AND (FileFile <> '')) THEN
0518: BEGIN
0519: UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL);
0520: opmG_HTTPClient.DisconnectSocket;
0521: UploadStamp := DATETIMETOSTR (NOW);
0522: PostData := TIdMultiPartFormDataStream.Create;
0523: PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword));
0524: PostData.AddFormField ('Op', 'upload');
0525: PostData.AddFormField ('Fn', FileFileName);
0526: PostData.AddFormField ('SD', FileSubdir);
0527: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0528: PostData.AddFormField ('TS', UploadStamp);
0529: PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0530: PostData.Position := 0;
0531: TRY
0532: TRY
0533: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0534: EXCEPT
0535: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0536: opmG_HTTPClient_TransactLog := '';
0537: END;
0538: FINALLY
0539: PostData.Free;
0540: END;
0541: IF (POS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0542: BEGIN
0543: RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1);
0544: FNopm_Upload_File := TRUE;
0545: END
0546: ELSE
0547: BEGIN
0548: IF (ANSIPOS (opmC_WebScriptBadVerCode, opmG_HTTPClient_TransactLog) > 0) THEN
0549: FNopm_Message (_('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.'), mtError, [mbOk], opmG_UISilent);
0550: END;
0551: END;
0552: END;
0553:
0554:
0555: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0556: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0557: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0558: VAR
0559: PostData : TIdMultiPartFormDataStream;
0560: CommandStamp : STRING;
0561: BEGIN
0562: FNopm_Send_Command := FALSE;
0563: OpResult := '';
0564: opmG_HTTPClient_TransactLog := '';
0565: IF (OperationStr <> '') THEN
0566: BEGIN
0567: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0568: opmG_HTTPClient.DisconnectSocket;
0569: CommandStamp := DATETIMETOSTR (NOW);
0570: PostData := TIdMultiPartFormDataStream.Create;
0571: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0572: PostData.AddFormField ('Op', OperationStr);
0573: PostData.AddFormField ('Fn', OpParams);
0574: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0575: PostData.AddFormField ('TS', CommandStamp);
0576: TRY
0577: TRY
0578: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0579: EXCEPT
0580: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0581: opmG_HTTPClient_TransactLog := '';
0582: END;
0583: FINALLY
0584: PostData.Free;
0585: END;
0586: IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0587: BEGIN
0588: OpResult := opmG_HTTPClient_TransactLog;
0589: FNopm_Send_Command := TRUE;
0590: END
0591: ELSE
0592: BEGIN
0593: IF (ANSIPOS (opmC_WebScriptBadVerCode, opmG_HTTPClient_TransactLog) > 0) THEN
0594: FNopm_Message (_('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.'), mtError, [mbOk], opmG_UISilent);
0595: END;
0596: END;
0597: END;
0598:
0599:
0600: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0601: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0602: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0603: VAR
0604: PostData : TIdMultiPartFormDataStream;
0605: BEGIN
0606: FNopm_Send_SimpleCommand := FALSE;
0607: OpResult := '';
0608: IF (OperationStr <> '') THEN
0609: BEGIN
0610: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0611: opmG_HTTPClient.DisconnectSocket;
0612: PostData := TIdMultiPartFormDataStream.Create;
0613: PostData.AddFormField ('Op', OperationStr);
0614: PostData.AddFormField ('Fn', OpParams);
0615: TRY
0616: TRY
0617: OpResult := opmG_HTTPClient.Post (CommandURL, PostData);
0618: EXCEPT
0619: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0620: OpResult := '';
0621: END;
0622: FINALLY
0623: PostData.Free;
0624: END;
0625: IF (ANSIPOS (opmC_WebScriptOKCode, OpResult) > 0) THEN
0626: BEGIN
0627: FNopm_Send_SimpleCommand := TRUE;
0628: END;
0629: END;
0630: END;
0631:
0632:
0633: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0634: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0635: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0636: VAR
0637: PostData : TIdMultiPartFormDataStream;
0638: CommandStamp : STRING;
0639: FileStream : TMemoryStream;
0640: SugFileName : STRING;
0641: BEGIN
0642: FNopm_Receive_File := '';
0643: opmG_HTTPClient_TransactLog := '';
0644: SugFileName := '';
0645: IF (OperationStr <> '') THEN
0646: BEGIN
0647: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0648: opmG_HTTPClient.DisconnectSocket;
0649: CommandStamp := DATETIMETOSTR (NOW);
0650: PostData := TIdMultiPartFormDataStream.Create;
0651: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0652: PostData.AddFormField ('Op', OperationStr);
0653: PostData.AddFormField ('Fn', RetFileName);
0654: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0655: PostData.AddFormField ('TS', CommandStamp);
0656: FileStream := TMemoryStream.Create;
0657: TRY
0658: TRY
0659: opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0660: IF (FileStream.Size > 10) THEN
0661: BEGIN
0662: FileStream.SaveToFile (RetFileName);
0663: SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0664: SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0665: FNopm_Receive_File := SugFileName;
0666: END
0667: ELSE FNopm_Receive_File := '';
0668: EXCEPT
0669: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0670: FNopm_Receive_File := '';
0671: END;
0672: FINALLY
0673: PostData.Free;
0674: FileStream.Free;
0675: END;
0676: END;
0677: END;
0678:
0679:
0680:
0681:
0682: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0683: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0684: INITIALIZATION
0685:
0686: ExistNetLink := FNopm_NetExist;
0687: opmG_DBConnection := TZConnection.Create (Application);
0688: opmG_DBConnection.AutoCommit := TRUE;
0689: opmG_DBConnection.ReadOnly := TRUE;
0690: opmG_DBConnection.TransactIsolationLevel := tiNone;
0691: opmG_DBQuery := TZQuery.Create (Application);
0692: opmG_DBQuery.RequestLive := FALSE;
0693: opmG_DBQuery.CachedUpdates := FALSE;
0694: opmG_DBQuery.ParamCheck := FALSE;
0695: opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted];
0696: opmG_DBQuery.UpdateMode := umUpdateChanged;
0697: opmG_DBQuery.WhereMode := wmWhereKeyOnly;
0698: opmG_DBQuery.Options := [doCalcDefaults];
0699: opmG_DBQuery.Connection := opmG_DBConnection;
0700:
0701:
0702: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0703: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0704: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0705: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0706: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0707:
0708: opmG_HTTPClient := TIdHTTP.Create (Application);
0709: opmG_HTTPClient.MaxLineAction := maException;
0710: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0711: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0712: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0713: opmG_HTTPClient.AllowCookies := False;
0714: opmG_HTTPClient.HandleRedirects := True;
0715: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0716: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0717: opmG_HTTPClient.Request.ContentLength := 0;
0718: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0719: opmG_HTTPClient.Request.ContentRangeStart := 0;
0720: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0721: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0722: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0723: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0724:
0725:
0726: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0727:
0728:
0729: SSHTunnelHandle := 0;
0730:
0731: FINALIZATION
0732:
0733: {opmG_DBConnection.Free;}
0734:
0735: end.
