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:   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.
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2017 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link