Source code of file oscpmwin_v0.1.1.652/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 : REAL;
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 : REAL;
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: Screen.Cursor := opmC_Normal_Mouse;
0247: IF (ResultStatus < 0) THEN FNopm_Message (_('An error ocurred while processing the database query.') + #13#10 + StatusString, mtError, [mbOk], opmG_UISilent);
0248: END
0249: ELSE
0250: BEGIN
0251: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Connection was down. Nothing done.');
0252: END;
0253: END
0254: ELSE
0255: BEGIN
0256: ResultStatus := 0;
0257: IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Query was empty. Nothing done.');
0258: END;
0259: FNopm_ExecQuery := ResultStatus;
0260: END;
0261:
0262:
0263:
0264: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0265: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0266: FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN;
0267: VAR
0268: CallParams : STRING;
0269: BEGIN
0270: CallParams := FNopm_BuildTunnelCall (SSHLHost, SSHRHost, SSHLPort, SSHRPort, SSHUser, SSHPass, (opmC_Def_SSHCompress > 0));
0271: IF (VisibleWindow > 0) THEN
0272: BEGIN
0273: SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0274: CallParams, ExtractFilePath (Application.Exename), FALSE, TRUE, opmG_SSHConnWait);
0275: END
0276: ELSE
0277: SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0278: CallParams, ExtractFilePath (Application.Exename), FALSE, FALSE, opmG_SSHConnWait);
0279: FNopm_OpenSSHTunnel := (SSHTunnelHandle > 0);
0280: END;
0281:
0282:
0283: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0284: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0285: FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING;
0286: VAR
0287: PlinkParams : STRING;
0288: BEGIN
0289: PLinkParams := '-ssh -' + INTTOSTR (opmC_Def_SSHProtocol);
0290: IF (Compress = TRUE) THEN PLinkParams := PLinkParams + ' -C';
0291: PLinkParams := PLinkParams + ' -l ' + SSHUser + ' -pw ' + SSHPass;
0292: PLinkParams := PLinkParams + ' -L ' + INTTOSTR (SSHLPort) + ':' + SSHLHost + ':' + INTTOSTR (SSHRPort);
0293: PLinkParams := PLinkParams + ' ' + SSHRHost + '';
0294: FNopm_BuildTunnelCall := PLinkParams;
0295: END;
0296:
0297:
0298: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0299: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0300: PROCEDURE PRopm_CloseSSHTunnel;
0301: BEGIN
0302: PRopm_StopExternalApp (SSHTunnelHandle);
0303: SSHTunnelHandle := 0;
0304: END;
0305:
0306:
0307: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0308: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0309: FUNCTION FNopm_CheckStallTunnel : BOOLEAN;
0310: BEGIN
0311: FNopm_CheckStallTunnel := (FNopm_IsAppRunning (opmC_Def_SSHExe) = TRUE);
0312: END;
0313:
0314:
0315: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0316: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0317: PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0318: VAR
0319: ProxyInfo : PInternetProxyInfo;
0320: DataLen : CARDINAL;
0321: DataString : STRING;
0322: BEGIN
0323: DataString := '';
0324: ProxyHost := '';
0325: ProxyPort := 0;
0326: DataLen := 4096;
0327: GetMem (ProxyInfo, DataLen);
0328: TRY
0329: IF (InternetQueryOption (NIL, INTERNET_OPTION_PROXY, ProxyInfo, DataLen)) THEN
0330: IF (ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY) THEN
0331: BEGIN
0332: DataString := ProxyInfo^.lpszProxy;
0333: END;
0334: FINALLY
0335: FREEMEM (ProxyInfo);
0336: END;
0337: IF (DataString <> '') THEN
0338: BEGIN
0339: IF (POS ('=', DataString) > 0) THEN
0340: BEGIN
0341: IF (POS ('http=', DataString) > 0) THEN
0342: BEGIN
0343: DELETE (DataString, 1, POS ('http=', DataString) + LENGTH ('http=') - 1);
0344: ProxyHost := COPY (DataString, 1, POS (':', DataString) - 1);
0345: DELETE (DataString, 1, POS (':', DataString));
0346: ProxyPort := FNopm_StrToInt (DataString);
0347: END
0348: ELSE
0349: BEGIN
0350: ProxyHost := '';
0351: ProxyPort := 0;
0352: END;
0353: END
0354: ELSE
0355: BEGIN
0356: ProxyHost := COPY (DataString, 1, POS (':', DataString) - 1);
0357: DELETE (DataString, 1, POS (':', DataString));
0358: ProxyPort := FNopm_StrToInt (DataString);
0359: END;
0360: END;
0361: END;
0362:
0363:
0364:
0365:
0366: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0367: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0368: PROCEDURE PRopm_WriteLog (LogString: STRING);
0369: VAR
0370: LogDirname: STRING;
0371: LogFile: TEXTFILE;
0372: BEGIN
0373: LogDirname := ExtractFilePath (Application.Exename);
0374: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0375: TRY
0376: IF FILEEXISTS (LogDirname + opmC_DebugFile) THEN APPEND (LogFile) ELSE REWRITE(Logfile);
0377: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW), '|', LogString);
0378: CLOSEFILE (LogFile)
0379: EXCEPT
0380: END;
0381: END;
0382:
0383:
0384:
0385: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0386: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0387: PROCEDURE PRopm_ResetLog;
0388: VAR
0389: LogDirname: STRING;
0390: LogFile: TEXTFILE;
0391: BEGIN
0392: LogDirname := ExtractFilePath (Application.Exename);
0393: ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0394: TRY
0395: REWRITE(Logfile);
0396: WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW));
0397: WRITELN (LogFile, opmC_DebugFileSeparator);
0398: WRITELN (LogFile, '');
0399: CLOSEFILE (LogFile)
0400: EXCEPT
0401: END;
0402: END;
0403:
0404:
0405:
0406: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0407: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0408: PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0409: BEGIN
0410: opmG_HTTP_ProgressBar := ProgressBar;
0411: opmG_HTTP_ProgressLabel := ProgressLabel;
0412: IF (UseProxy AND (opmG_WBProxyHost <> '') AND (opmG_WBProxyPort > 0)) THEN
0413: BEGIN
0414: opmG_HTTPClient.ProxyParams.ProxyServer := opmG_WBProxyHost;
0415: opmG_HTTPClient.ProxyParams.ProxyPort := opmG_WBProxyPort;
0416: END
0417: ELSE
0418: BEGIN
0419: opmG_HTTPClient.ProxyParams.ProxyServer := '';
0420: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0421: END;
0422: opmG_HTTPClient.Request.UserAgent := opmC_UserAgent + ' (' + opmG_PlatformVersion + '; ' + opmG_DBProtocol + ')';
0423: IF (opmG_WBNoCacheImg > 0) THEN opmG_HTTPClient.Request.CacheControl := 'min-fresh=1,max-age=1,no-cache' ELSE opmG_HTTPClient.Request.CacheControl := '';
0424: END;
0425:
0426:
0427:
0428: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0429: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0430: PROCEDURE PRopm_Disconnect_HTTPClient;
0431: BEGIN
0432: opmG_HTTPClient.DisconnectSocket;
0433: END;
0434:
0435:
0436: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0437: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0438: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0439: BEGIN
0440: IF ((AWorkCountMax > 0) AND (opmG_HTTP_ProgressBar <> NIL)) THEN
0441: BEGIN
0442: opmG_HTTP_ProgressBar.Enabled := TRUE;
0443: opmG_HTTP_ProgressBar.Min := 0;
0444: opmG_HTTP_ProgressBar.Max := AWorkCountMax;
0445: opmG_HTTP_ProgressBar.Position := 0;
0446: END;
0447: END;
0448:
0449: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0450: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0451: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0452: BEGIN
0453: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0454: BEGIN
0455: opmG_HTTP_ProgressLabel.Caption := INTTOSTR (AWorkCount) + _(' bytes');
0456: opmG_HTTP_ProgressBar.Position := AWorkCount;
0457: END;
0458: END;
0459:
0460:
0461: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0462: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0463: PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0464: BEGIN
0465: IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0466: BEGIN
0467: opmG_HTTP_ProgressBar.Enabled := FALSE;
0468: opmG_HTTP_ProgressBar.Min := 0;
0469: opmG_HTTP_ProgressBar.Max := 100;
0470: opmG_HTTP_ProgressBar.Position := 0;
0471: opmG_HTTP_ProgressLabel.Caption := '';
0472: END;
0473: END;
0474:
0475:
0476:
0477: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0478: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0479: FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0480: VAR
0481: FileStream : TMemoryStream;
0482: BEGIN
0483: FNopm_Download_File := FALSE;
0484: IF ((FileURL <> '') AND (FileFileName <> '')) THEN
0485: BEGIN
0486: FileURL := opmG_HTTPClient.URL.URLEncode (FileURL);
0487: opmG_HTTPClient.DisconnectSocket;
0488: FileStream := TMemoryStream.Create;
0489: TRY
0490: opmG_HTTPClient.Get (FileURL, FileStream);
0491: FileStream.SaveToFile (FileFileName);
0492: FNopm_Download_File := TRUE;
0493: EXCEPT
0494: ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;
0495: ELSE
0496: END;
0497: FileStream.Free;
0498: END;
0499: END;
0500:
0501:
0502: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0503: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0504: FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING;
0505: VAR RenFileName : STRING) : BOOLEAN;
0506: VAR
0507: PostData : TIdMultiPartFormDataStream;
0508: UploadStamp : STRING;
0509: BEGIN
0510: FNopm_Upload_File := FALSE;
0511: RenFileName := '';
0512: opmG_HTTPClient_TransactLog := '';
0513: IF ((UploadURL <> '') AND (FileFile <> '')) THEN
0514: BEGIN
0515: UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL);
0516: opmG_HTTPClient.DisconnectSocket;
0517: UploadStamp := DATETIMETOSTR (NOW);
0518: PostData := TIdMultiPartFormDataStream.Create;
0519: PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword));
0520: PostData.AddFormField ('Op', 'upload');
0521: PostData.AddFormField ('Fn', FileFileName);
0522: PostData.AddFormField ('SD', FileSubdir);
0523: IF (opmG_WBSmartRename > 0) THEN PostData.AddFormField ('SR', INTTOSTR (opmG_WBSmartRename));
0524: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0525: PostData.AddFormField ('TS', UploadStamp);
0526: PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0527: PostData.Position := 0;
0528: TRY
0529: TRY
0530: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0531: EXCEPT
0532: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0533: opmG_HTTPClient_TransactLog := '';
0534: END;
0535: FINALLY
0536: PostData.Free;
0537: END;
0538: IF (POS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0539: BEGIN
0540: RenFileName := COPY (opmG_HTTPClient_TransactLog, POS ('[', opmG_HTTPClient_TransactLog) + 1, POS (']', opmG_HTTPClient_TransactLog) - POS ('[', opmG_HTTPClient_TransactLog) - 1);
0541: FNopm_Upload_File := TRUE;
0542: END
0543: ELSE
0544: BEGIN
0545: IF (POS (opmC_WebScriptBadVerCode, opmG_HTTPClient_TransactLog) > 0) THEN
0546: FNopm_Message (_('The version of the server-side script oscpm1_upload.php is wrong. Please install the file provided with this application.'), mtError, [mbOk], opmG_UISilent);
0547: END;
0548: END;
0549: END;
0550:
0551:
0552: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0553: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0554: FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0555: VAR
0556: PostData : TIdMultiPartFormDataStream;
0557: CommandStamp : STRING;
0558: BEGIN
0559: FNopm_Send_Command := FALSE;
0560: OpResult := '';
0561: opmG_HTTPClient_TransactLog := '';
0562: IF (OperationStr <> '') THEN
0563: BEGIN
0564: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0565: opmG_HTTPClient.DisconnectSocket;
0566: CommandStamp := DATETIMETOSTR (NOW);
0567: PostData := TIdMultiPartFormDataStream.Create;
0568: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0569: PostData.AddFormField ('Op', OperationStr);
0570: PostData.AddFormField ('Fn', OpParams);
0571: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0572: PostData.AddFormField ('TS', CommandStamp);
0573: TRY
0574: TRY
0575: opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0576: EXCEPT
0577: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0578: opmG_HTTPClient_TransactLog := '';
0579: END;
0580: FINALLY
0581: PostData.Free;
0582: END;
0583: IF (POS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0584: BEGIN
0585: OpResult := opmG_HTTPClient_TransactLog;
0586: FNopm_Send_Command := TRUE;
0587: END
0588: ELSE
0589: BEGIN
0590: IF (POS (opmC_WebScriptBadVerCode, opmG_HTTPClient_TransactLog) > 0) THEN
0591: FNopm_Message (_('The version of the server-side script oscpm1_upload.php is wrong. Please install the file provided with this application.'), mtError, [mbOk], opmG_UISilent);
0592: END;
0593: END;
0594: END;
0595:
0596:
0597: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0598: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0599: FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : BOOLEAN;
0600: VAR
0601: PostData : TIdMultiPartFormDataStream;
0602: BEGIN
0603: FNopm_Send_SimpleCommand := FALSE;
0604: OpResult := '';
0605: IF (OperationStr <> '') THEN
0606: BEGIN
0607: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0608: opmG_HTTPClient.DisconnectSocket;
0609: PostData := TIdMultiPartFormDataStream.Create;
0610: PostData.AddFormField ('Op', OperationStr);
0611: PostData.AddFormField ('Fn', OpParams);
0612: TRY
0613: TRY
0614: OpResult := opmG_HTTPClient.Post (CommandURL, PostData);
0615: EXCEPT
0616: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0617: OpResult := '';
0618: END;
0619: FINALLY
0620: PostData.Free;
0621: END;
0622: IF (POS (opmC_WebScriptOKCode, OpResult) > 0) THEN
0623: BEGIN
0624: FNopm_Send_SimpleCommand := TRUE;
0625: END;
0626: END;
0627: END;
0628:
0629:
0630: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0631: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0632: FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0633: VAR
0634: PostData : TIdMultiPartFormDataStream;
0635: CommandStamp : STRING;
0636: FileStream : TMemoryStream;
0637: SugFileName : STRING;
0638: BEGIN
0639: FNopm_Receive_File := '';
0640: opmG_HTTPClient_TransactLog := '';
0641: SugFileName := '';
0642: IF (OperationStr <> '') THEN
0643: BEGIN
0644: CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0645: opmG_HTTPClient.DisconnectSocket;
0646: CommandStamp := DATETIMETOSTR (NOW);
0647: PostData := TIdMultiPartFormDataStream.Create;
0648: PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0649: PostData.AddFormField ('Op', OperationStr);
0650: PostData.AddFormField ('Fn', RetFileName);
0651: PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0652: PostData.AddFormField ('TS', CommandStamp);
0653: FileStream := TMemoryStream.Create;
0654: TRY
0655: TRY
0656: opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0657: IF (FileStream.Size > 10) THEN
0658: BEGIN
0659: FileStream.SaveToFile (RetFileName);
0660: SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0661: SugFileName := TRIM (COPY (SugFileName, POS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0662: FNopm_Receive_File := SugFileName;
0663: END
0664: ELSE FNopm_Receive_File := '';
0665: EXCEPT
0666: {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0667: FNopm_Receive_File := '';
0668: END;
0669: FINALLY
0670: PostData.Free;
0671: FileStream.Free;
0672: END;
0673: END;
0674: END;
0675:
0676:
0677:
0678:
0679: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0680: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0681: INITIALIZATION
0682:
0683: ExistNetLink := FNopm_NetExist;
0684: opmG_DBConnection := TZConnection.Create (Application);
0685: opmG_DBConnection.AutoCommit := TRUE;
0686: opmG_DBConnection.ReadOnly := TRUE;
0687: opmG_DBConnection.TransactIsolationLevel := tiNone;
0688: opmG_DBQuery := TZQuery.Create (Application);
0689: opmG_DBQuery.RequestLive := FALSE;
0690: opmG_DBQuery.CachedUpdates := FALSE;
0691: opmG_DBQuery.ParamCheck := FALSE;
0692: opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted];
0693: opmG_DBQuery.UpdateMode := umUpdateChanged;
0694: opmG_DBQuery.WhereMode := wmWhereKeyOnly;
0695: opmG_DBQuery.Options := [doCalcDefaults];
0696: opmG_DBQuery.Connection := opmG_DBConnection;
0697:
0698:
0699: opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0700: opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0701: opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0702: opmG_SSLHandler.SSLOptions.VerifyMode := [];
0703: opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0704:
0705: opmG_HTTPClient := TIdHTTP.Create (Application);
0706: opmG_HTTPClient.MaxLineAction := maException;
0707: opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0708: opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0709: opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0710: opmG_HTTPClient.AllowCookies := False;
0711: opmG_HTTPClient.HandleRedirects := True;
0712: opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0713: opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0714: opmG_HTTPClient.Request.ContentLength := 0;
0715: opmG_HTTPClient.Request.ContentRangeEnd := 0;
0716: opmG_HTTPClient.Request.ContentRangeStart := 0;
0717: opmG_HTTPClient.Request.Accept := 'text/html, */*';
0718: opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0719: opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0720: opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0721:
0722: {
0723: opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0724: }
0725:
0726: SSHTunnelHandle := 0;
0727:
0728: FINALIZATION
0729:
0730: {opmG_DBConnection.Free;}
0731:
0732: end.
