Source code of file oscpmwin_v0.1.1.875/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:             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 (POS ('=', DataString) > 0) THEN
0339:           BEGIN
0340:             IF (POS ('http=', DataString) > 0) THEN
0341:               BEGIN
0342:                 DELETE (DataString, 1, POS ('http=', DataString) + LENGTH ('http=') - 1);
0343:                 ProxyHost := COPY (DataString, 1, POS (':', DataString) - 1);
0344:                 DELETE (DataString, 1, POS (':', 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, POS (':', DataString) - 1);
0356:             DELETE (DataString, 1, POS (':', 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, POS ('[', opmG_HTTPClient_TransactLog) + 1, POS (']', opmG_HTTPClient_TransactLog) - POS ('[', opmG_HTTPClient_TransactLog) - 1);
0544:             FNopm_Upload_File := TRUE;
0545:           END
0546:         ELSE
0547:           BEGIN
0548:             IF (POS (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 (POS (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 (POS (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 (POS (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, POS ('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.
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2017 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link