Source code of file oscpmwin_v0.1.2.436/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) : LONGINT;
0053:   FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0054:   FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0055:   FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0056:   FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0057:   
0058:   
0059:   VAR
0060:     ExistNetLink : BOOLEAN;
0061:     opmG_DBConnection : TZConnection;
0062:     SSHTunnelHandle : CARDINAL;
0063:     opmG_Network_EventHandler : Topm_EventHandler;
0064:     opmG_DBQuery : TZQuery;
0065:     opmG_HTTPClient: TIdHTTP;
0066:     opmG_SSLHandler: TIdSSLIOHandlerSocket;
0067:     opmG_HTTP_ProgressBar : TProgressBar;
0068:     opmG_HTTP_ProgressLabel : TLabel;
0069:     opmG_INDY_AntiFreeze : TIdAntiFreeze;
0070:     opmG_HTTPClient_TransactLog : STRING;
0071:   
0072:   
0073:   IMPLEMENTATION
0074:   
0075:   USES Windows, SysUtils, gnugettext, ZDbcIntfs, Forms, dataman, oscpmdata, WinInet, Dialogs, attention, IdGlobal,
0076:        Classes, imageman, IdMultipartFormData;
0077:   
0078:   
0079:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0080:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0081:   FUNCTION FNopm_NetExist : BOOLEAN;
0082:   BEGIN
0083:     IF ((GetSystemMetrics (SM_NETWORK) AND $01) > 0) THEN
0084:       FNopm_NetExist := TRUE
0085:     ELSE
0086:       FNopm_NetExist := FALSE;
0087:   END;
0088:   
0089:   
0090:   
0091:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0092:   Open a connection to the database server.
0093:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0094:   FUNCTION FNopm_OpenDBConnection (DBHost : STRING; DBPort : WORD;
0095:                                     DBProt, DBBase, DBUser, DBPass : STRING;
0096:                                     DBCompress : INTEGER) : STRING;
0097:   VAR
0098:     LapseTime : DOUBLE;
0099:     ConnTries : LONGINT;
0100:   BEGIN
0101:     FNopm_OpenDBConnection := 'ERROR';
0102:     IF ((DBHost <> '') AND
0103:         (DBPort > 0) AND
0104:         (DBProt <> '') AND
0105:         (DBBase <> '') AND
0106:         (DBUser <> '') AND
0107:         (opmG_DBConnection.Connected = FALSE)) THEN
0108:       BEGIN
0109:         opmG_DBConnection.HostName := DBHost;
0110:         opmG_DBConnection.Port := DBPort;
0111:         opmG_DBConnection.Protocol := DBProt;
0112:         opmG_DBConnection.Database := DBBase;
0113:         opmG_DBConnection.User := DBUser;
0114:         opmG_DBConnection.Password := DBPass;
0115:         IF (DBCompress > 0) THEN
0116:           opmG_DBConnection.Properties.Text := 'compress=yes'
0117:         ELSE
0118:           opmG_DBConnection.Properties.Text := '';
0119:         FOR ConnTries := 1 TO opmG_DBConnRetries DO
0120:           BEGIN
0121:             TRY
0122:               opmG_DBConnection.Connect;
0123:             EXCEPT
0124:               ON E : Exception DO
0125:                 BEGIN
0126:                   FNopm_OpenDBConnection := _('Error while connecting to database') + ' (' + DBBase + ' @ ' + DBHost + ').'#13#10 + E.Message;
0127:                 END;
0128:             END;
0129:             LapseTime := GetTickCount;
0130:             REPEAT
0131:               Application.ProcessMessages;
0132:             UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait);
0133:             IF (opmG_DBConnection.Connected = TRUE) THEN
0134:               BEGIN
0135:                 FNopm_OpenDBConnection := '';
0136:                 BREAK;
0137:               END;
0138:           END;
0139:       END
0140:     ELSE
0141:       BEGIN
0142:         FNopm_OpenDBConnection := _('Invalid database connection parameters or database already connected.');
0143:       END;
0144:   END;
0145:   
0146:   
0147:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0148:   Closes the connection to the database server.
0149:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0150:   FUNCTION FNopm_CloseDBConnection : STRING;
0151:   BEGIN
0152:     IF (opmG_DBConnection.Connected) THEN
0153:       BEGIN
0154:         opmG_DBConnection.Disconnect;
0155:         FNopm_CloseDBConnection := '';
0156:       END
0157:     ELSE
0158:       BEGIN
0159:         FNopm_CloseDBConnection := _('The database is not connected');
0160:       END;
0161:   END;
0162:   
0163:   
0164:   
0165:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0166:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0167:   FUNCTION FNopm_ConnectionState : BOOLEAN;
0168:   BEGIN
0169:     FNopm_ConnectionState := opmG_DBConnection.Connected;
0170:   END;
0171:   
0172:   
0173:   
0174:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0175:   Send a SQL query to the database server, returning the number
0176:   of returned records (if any). If query is a SELECT, the Query
0177:   is keep Active so other routines can read its records.
0178:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0179:   FUNCTION FNopm_ExecQuery (SQLQueryString : STRING; SQLQueryType : LONGINT) : LONGINT;
0180:   VAR
0181:     RetryCount : LONGINT;
0182:     ResultStatus : LONGINT;
0183:     StatusString : STRING;
0184:     LapseTime : DOUBLE;
0185:   BEGIN
0186:     IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Executing query of type ' + INTTOSTR (SQLQueryType) + ': ' + SQLQueryString);
0187:     RetryCount := 0;
0188:     IF (SQLQueryString <> '') THEN
0189:       BEGIN
0190:         ResultStatus := -1;
0191:         StatusString := '';
0192:         IF (FNopm_ConnectionState) THEN
0193:           BEGIN
0194:             Application.ProcessMessages;
0195:             REPEAT
0196:               IF (SQLQueryType = opmC_SQLSelect) THEN
0197:                 BEGIN
0198:                   IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0199:                   TRY
0200:                     {opmG_DBQuery.Active := FALSE;}
0201:                     opmG_DBQuery.Close;
0202:                     opmG_DBQuery.SQL.Clear;
0203:                     opmG_DBQuery.SQL.Add (SQLQueryString);
0204:                     IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!');
0205:                     {opmG_DBQuery.Active := TRUE;}
0206:                     opmG_DBQuery.Open;
0207:                     IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!');
0208:                     ResultStatus := opmG_DBQuery.RecordCount;
0209:                   EXCEPT
0210:                     ON E : Exception DO
0211:                       BEGIN
0212:                         IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR! : ' + E.Message);
0213:                         StatusString := E.Message;
0214:                       END;
0215:                   END;
0216:                 END
0217:               ELSE IF ((SQLQueryType = opmC_SQLUpdate) OR (SQLQueryType = opmC_SQLInsert) OR (SQLQueryType = opmC_SQLDelete)) THEN
0218:                 BEGIN
0219:                   IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Try ' + INTTOSTR (RetryCount) + ' Ready... set...');
0220:                   TRY
0221:                     opmG_DBQuery.Active := FALSE;
0222:                     opmG_DBQuery.SQL.Clear;
0223:                     opmG_DBQuery.SQL.Add (SQLQueryString);
0224:                     IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Go!');
0225:                     opmG_DBQuery.ExecSQL;
0226:                     opmG_DBQuery.Active := FALSE;
0227:                     IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Done!');
0228:                     ResultStatus := 0;
0229:                   EXCEPT
0230:                     ON E : Exception DO
0231:                       BEGIN
0232:                         IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('ERROR (after ' + INTTOSTR (RetryCount) + ' tries)! : ' + E.Message);
0233:                         StatusString := E.Message;
0234:                       END;
0235:                   END;
0236:                 END;
0237:               INC (RetryCount);
0238:               IF (ResultStatus < 0) THEN
0239:                 BEGIN
0240:                   LapseTime := GetTickCount;
0241:                   REPEAT
0242:                     Application.ProcessMessages;
0243:                   UNTIL ((GetTickCount - LapseTime) > opmG_DBConnWait);
0244:                 END;
0245:             UNTIL (RetryCount > 3) OR (ResultStatus >= 0);
0246:             IF (ResultStatus < 0) THEN FNopm_Message (_('An error ocurred while processing the database query.') + #13#10 + StatusString, mtError, [mbOk], opmG_UISilent);
0247:           END
0248:         ELSE
0249:           BEGIN
0250:             IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Connection was down. Nothing done.');
0251:           END;
0252:       END
0253:     ELSE
0254:       BEGIN
0255:         ResultStatus := 0;
0256:         IF (opmG_DBDebugLog > 0) THEN PRopm_WriteLog ('Query was empty. Nothing done.');
0257:       END;
0258:     FNopm_ExecQuery := ResultStatus;
0259:   END;
0260:   
0261:   
0262:   
0263:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0264:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0265:   FUNCTION FNopm_OpenSSHTunnel (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; VisibleWindow : INTEGER) : BOOLEAN;
0266:   VAR
0267:     CallParams : STRING;
0268:   BEGIN
0269:     CallParams := FNopm_BuildTunnelCall (SSHLHost, SSHRHost, SSHLPort, SSHRPort, SSHUser, SSHPass, (opmC_Def_SSHCompress > 0));
0270:     IF (VisibleWindow > 0) THEN
0271:       BEGIN
0272:         SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0273:                            CallParams, ExtractFilePath (Application.Exename), FALSE, TRUE, opmG_SSHConnWait);
0274:       END
0275:     ELSE
0276:       SSHTunnelHandle := FNopm_RunExternalApp (ExtractFilePath (Application.Exename) + opmC_Def_SSHExe,
0277:                          CallParams, ExtractFilePath (Application.Exename), FALSE, FALSE, opmG_SSHConnWait);
0278:     FNopm_OpenSSHTunnel := (SSHTunnelHandle > 0);
0279:   END;
0280:   
0281:   
0282:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0283:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0284:   FUNCTION FNopm_BuildTunnelCall (SSHLHost, SSHRHost : STRING; SSHLPort, SSHRPort : WORD; SSHUser, SSHPass : STRING; Compress : BOOLEAN) : STRING;
0285:   VAR
0286:     PlinkParams : STRING;
0287:   BEGIN
0288:     PLinkParams := '-ssh -' + INTTOSTR (opmC_Def_SSHProtocol);
0289:     IF (Compress = TRUE) THEN PLinkParams := PLinkParams + ' -C';
0290:     PLinkParams := PLinkParams + ' -l ' + SSHUser + ' -pw ' + SSHPass;
0291:     PLinkParams := PLinkParams + ' -L ' + INTTOSTR (SSHLPort) + ':' + SSHLHost + ':' + INTTOSTR (SSHRPort);
0292:     PLinkParams := PLinkParams + ' ' + SSHRHost + '';
0293:     FNopm_BuildTunnelCall := PLinkParams;
0294:   END;
0295:   
0296:   
0297:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0298:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0299:   PROCEDURE PRopm_CloseSSHTunnel;
0300:   BEGIN
0301:     PRopm_StopExternalApp (SSHTunnelHandle);
0302:     SSHTunnelHandle := 0;
0303:   END;
0304:   
0305:   
0306:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0307:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0308:   FUNCTION FNopm_CheckStallTunnel : BOOLEAN;
0309:   BEGIN
0310:     FNopm_CheckStallTunnel := (FNopm_IsAppRunning (opmC_Def_SSHExe) = TRUE);
0311:   END;
0312:   
0313:   
0314:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0315:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0316:   PROCEDURE PRopm_GetIEProxyData (VAR ProxyHost : STRING; VAR ProxyPort : LONGINT);
0317:   VAR
0318:     ProxyInfo : PInternetProxyInfo;
0319:     DataLen : CARDINAL;
0320:     DataString : STRING;
0321:   BEGIN
0322:     DataString := '';
0323:     ProxyHost := '';
0324:     ProxyPort := 0;
0325:     DataLen := 4096;
0326:     GetMem (ProxyInfo, DataLen);
0327:     TRY
0328:       IF (InternetQueryOption (NIL, INTERNET_OPTION_PROXY, ProxyInfo, DataLen)) THEN
0329:         IF (ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY) THEN
0330:           BEGIN
0331:             DataString := ProxyInfo^.lpszProxy;
0332:           END;
0333:     FINALLY
0334:       FREEMEM (ProxyInfo);
0335:     END;
0336:     IF (DataString <> '') THEN
0337:       BEGIN
0338:         IF (ANSIPOS ('=', DataString) > 0) THEN
0339:           BEGIN
0340:             IF (ANSIPOS ('http=', DataString) > 0) THEN
0341:               BEGIN
0342:                 DELETE (DataString, 1, ANSIPOS ('http=', DataString) + LENGTH ('http=') - 1);
0343:                 ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0344:                 DELETE (DataString, 1, ANSIPOS (':', DataString));
0345:                 ProxyPort := FNopm_StrToInt (DataString);
0346:               END
0347:             ELSE
0348:               BEGIN
0349:                 ProxyHost := '';
0350:                 ProxyPort := 0;
0351:               END;
0352:           END
0353:         ELSE
0354:           BEGIN
0355:             ProxyHost := COPY (DataString, 1, ANSIPOS (':', DataString) - 1);
0356:             DELETE (DataString, 1, ANSIPOS (':', DataString));
0357:             ProxyPort := FNopm_StrToInt (DataString);
0358:           END;
0359:       END;
0360:   END;
0361:   
0362:   
0363:   
0364:   
0365:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0366:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0367:   PROCEDURE PRopm_WriteLog (LogString: STRING);
0368:   VAR
0369:     LogDirname: STRING;
0370:     LogFile:  TEXTFILE;
0371:   BEGIN
0372:     LogDirname := ExtractFilePath (Application.Exename);
0373:     ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0374:     TRY
0375:       IF FILEEXISTS (LogDirname + opmC_DebugFile) THEN APPEND (LogFile) ELSE REWRITE(Logfile);
0376:       WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW), '|', LogString);
0377:       CLOSEFILE (LogFile)
0378:     EXCEPT
0379:     END;
0380:   END;
0381:   
0382:   
0383:   
0384:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0385:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0386:   PROCEDURE PRopm_ResetLog;
0387:   VAR
0388:     LogDirname: STRING;
0389:     LogFile:  TEXTFILE;
0390:   BEGIN
0391:     LogDirname := ExtractFilePath (Application.Exename);
0392:     ASSIGNFILE (LogFile, LogDirname + opmC_DebugFile);
0393:     TRY
0394:       REWRITE(Logfile);
0395:       WRITELN (LogFile, FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz', NOW));
0396:       WRITELN (LogFile, opmC_DebugFileSeparator);
0397:       WRITELN (LogFile, '');
0398:       CLOSEFILE (LogFile)
0399:     EXCEPT
0400:     END;
0401:   END;
0402:   
0403:   
0404:   
0405:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0406:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0407:   PROCEDURE PRopm_Prepare_HTTPClient (ProgressBar : TProgressBar; ProgressLabel : TLabel; UseProxy : BOOLEAN);
0408:   BEGIN
0409:     opmG_HTTP_ProgressBar := ProgressBar;
0410:     opmG_HTTP_ProgressLabel := ProgressLabel;
0411:     IF (UseProxy AND (opmG_WBProxyHost <> '') AND (opmG_WBProxyPort > 0)) THEN
0412:       BEGIN
0413:         opmG_HTTPClient.ProxyParams.ProxyServer := opmG_WBProxyHost;
0414:         opmG_HTTPClient.ProxyParams.ProxyPort := opmG_WBProxyPort;
0415:       END
0416:     ELSE
0417:       BEGIN
0418:         opmG_HTTPClient.ProxyParams.ProxyServer := '';
0419:         opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0420:       END;
0421:     opmG_HTTPClient.ReadTimeout := opmC_Def_HTTPWaitFactor * opmG_HTTPConnWait;
0422:     opmG_HTTPClient.ConnectTimeout := opmG_HTTPConnWait;
0423:     opmG_HTTPClient.Request.UserAgent := opmG_FullUserAgent;
0424:     IF (opmG_WBNoCacheImg > 0) THEN opmG_HTTPClient.Request.CacheControl := 'min-fresh=1,max-age=1,no-cache' ELSE opmG_HTTPClient.Request.CacheControl := '';
0425:   END;
0426:   
0427:   
0428:   
0429:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0430:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0431:   PROCEDURE PRopm_Disconnect_HTTPClient;
0432:   BEGIN
0433:     opmG_HTTPClient.DisconnectSocket;
0434:   END;
0435:   
0436:   
0437:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0438:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0439:   PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkBegin (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCountMax: INTEGER);
0440:   BEGIN
0441:     IF ((AWorkCountMax > 0) AND (opmG_HTTP_ProgressBar <> NIL)) THEN
0442:       BEGIN
0443:         opmG_HTTP_ProgressBar.Enabled := TRUE;
0444:         opmG_HTTP_ProgressBar.Min := 0;
0445:         opmG_HTTP_ProgressBar.Max := AWorkCountMax;
0446:         opmG_HTTP_ProgressBar.Position := 0;
0447:       END;
0448:     Application.ProcessMessages;
0449:   END;
0450:   
0451:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0452:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0453:   PROCEDURE Topm_EventHandler.PRopm_HTTPClient_Work (Sender: TOBJECT; AWorkMode: TWorkMode; CONST AWorkCount: INTEGER);
0454:   BEGIN
0455:     IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0456:       BEGIN
0457:         opmG_HTTP_ProgressLabel.Caption := INTTOSTR (AWorkCount) + _(' bytes');
0458:         opmG_HTTP_ProgressBar.Position := AWorkCount;
0459:       END;
0460:     Application.ProcessMessages;
0461:   END;
0462:   
0463:   
0464:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0465:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0466:   PROCEDURE Topm_EventHandler.PRopm_HTTPClient_WorkEnd (Sender: TOBJECT; AWorkMode: TWorkMode);
0467:   BEGIN
0468:     IF ((opmG_HTTP_ProgressBar <> NIL) AND (opmG_HTTP_ProgressLabel <> NIL)) THEN
0469:       BEGIN
0470:         opmG_HTTP_ProgressBar.Enabled := FALSE;
0471:         opmG_HTTP_ProgressBar.Min := 0;
0472:         opmG_HTTP_ProgressBar.Max := 100;
0473:         opmG_HTTP_ProgressBar.Position := 0;
0474:         opmG_HTTP_ProgressLabel.Caption := '';
0475:       END;
0476:     Application.ProcessMessages;
0477:   END;
0478:   
0479:   
0480:   
0481:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0482:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0483:   FUNCTION FNopm_Download_File (FileURL, FileFileName : STRING) : BOOLEAN;
0484:   VAR
0485:     FileStream : TMemoryStream;
0486:   BEGIN
0487:     FNopm_Download_File := FALSE;
0488:     IF ((FileURL <> '') AND (FileFileName <> '')) THEN
0489:       BEGIN
0490:         SysUtils.DELETEFILE (FileFileName);
0491:         FileURL := opmG_HTTPClient.URL.URLEncode (FileURL);
0492:         opmG_HTTPClient.DisconnectSocket;
0493:         FileStream := TMemoryStream.Create;
0494:         TRY
0495:           opmG_HTTPClient.Get (FileURL, FileStream);
0496:           FileStream.SaveToFile (FileFileName);
0497:           FNopm_Download_File := TRUE;
0498:         EXCEPT
0499:           ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;
0500:         ELSE
0501:         END;
0502:         FileStream.Free;
0503:       END;
0504:   END;
0505:   
0506:   
0507:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0508:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0509:   FUNCTION FNopm_Upload_File (UploadURL, FileFile, FileFileName, FileSubdir : STRING;
0510:                               VAR RenFileName : STRING) : LONGINT;
0511:   VAR
0512:     PostData : TIdMultiPartFormDataStream;
0513:     UploadStamp : STRING;
0514:     ErrPos : LONGINT;
0515:   BEGIN
0516:     FNopm_Upload_File := opmC_WebScriptDefaultCode;
0517:     RenFileName := '';
0518:     opmG_HTTPClient_TransactLog := '';
0519:     IF ((UploadURL <> '') AND (FileFile <> '')) THEN
0520:       BEGIN
0521:         UploadURL := opmG_HTTPClient.URL.URLEncode (UploadURL);
0522:         opmG_HTTPClient.DisconnectSocket;
0523:         UploadStamp := DATETIMETOSTR (NOW);
0524:         PostData := TIdMultiPartFormDataStream.Create;
0525:         PostData.AddFormField ('Pw', opm_FNMD5 (UploadStamp + opmG_DBPassword));
0526:         PostData.AddFormField ('Op', 'upload');
0527:         PostData.AddFormField ('Fn', FileFileName);
0528:         PostData.AddFormField ('SD', FileSubdir);
0529:         PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0530:         PostData.AddFormField ('TS', UploadStamp);
0531:         PostData.AddFile ('Fl', FileFile, 'application/octet-stream');
0532:         PostData.Position := 0;
0533:         TRY
0534:           TRY
0535:             opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (UploadURL, PostData);
0536:           EXCEPT
0537:             {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0538:             opmG_HTTPClient_TransactLog := '';
0539:           END;
0540:         FINALLY
0541:           PostData.Free;
0542:         END;
0543:         RenFilename := opmG_HTTPClient_TransactLog;
0544:         IF (opmG_HTTPClient_TransactLog <> '') THEN
0545:           BEGIN
0546:             IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0547:               BEGIN
0548:                 RenFileName := COPY (opmG_HTTPClient_TransactLog, ANSIPOS ('[', opmG_HTTPClient_TransactLog) + 1, ANSIPOS (']', opmG_HTTPClient_TransactLog) - ANSIPOS ('[', opmG_HTTPClient_TransactLog) - 1);
0549:                 FNopm_Upload_File := 0
0550:               END
0551:             ELSE
0552:               BEGIN
0553:                 ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0554:                 IF (ErrPos > 0) THEN
0555:                   BEGIN
0556:                     DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0557:                     ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0558:                     IF (ErrPos > 0) THEN FNopm_Upload_File := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0559:                   END
0560:                 ELSE FNopm_Upload_File := opmC_WebScriptUnknownCode;
0561:               END;
0562:           END
0563:         ELSE FNopm_Upload_File := opmC_WebScriptDefaultCode;
0564:       END;
0565:   END;
0566:   
0567:   
0568:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0569:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0570:   FUNCTION FNopm_Send_Command (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0571:   VAR
0572:     PostData : TIdMultiPartFormDataStream;
0573:     CommandStamp : STRING;
0574:     ErrPos : LONGINT;
0575:   BEGIN
0576:     FNopm_Send_Command := opmC_WebScriptDefaultCode;
0577:     OpResult := '';
0578:     opmG_HTTPClient_TransactLog := '';
0579:     IF (OperationStr <> '') THEN
0580:       BEGIN
0581:         CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0582:         opmG_HTTPClient.DisconnectSocket;
0583:         CommandStamp := DATETIMETOSTR (NOW);
0584:         PostData := TIdMultiPartFormDataStream.Create;
0585:         PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0586:         PostData.AddFormField ('Op', OperationStr);
0587:         PostData.AddFormField ('Fn', OpParams);
0588:         PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0589:         PostData.AddFormField ('TS', CommandStamp);
0590:         TRY
0591:           TRY
0592:             opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0593:           EXCEPT
0594:             {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0595:             opmG_HTTPClient_TransactLog := '';
0596:           END;
0597:         FINALLY
0598:           PostData.Free;
0599:         END;
0600:         OpResult := opmG_HTTPClient_TransactLog;
0601:         IF (opmG_HTTPClient_TransactLog <> '') THEN
0602:           BEGIN
0603:             IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0604:               FNopm_Send_Command := 0
0605:             ELSE
0606:               BEGIN
0607:                 ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0608:                 IF (ErrPos > 0) THEN
0609:                   BEGIN
0610:                     DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0611:                     ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0612:                     IF (ErrPos > 0) THEN FNopm_Send_Command := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0613:                   END
0614:                 ELSE FNopm_Send_Command := opmC_WebScriptUnknownCode;
0615:               END;
0616:           END
0617:         ELSE FNopm_Send_Command := opmC_WebScriptDefaultCode;
0618:       END;
0619:   END;
0620:   
0621:   
0622:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0623:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0624:   FUNCTION FNopm_Send_SimpleCommand (CommandURL, OperationStr, OpParams : STRING; VAR OpResult : STRING) : LONGINT;
0625:   VAR
0626:     PostData : TIdMultiPartFormDataStream;
0627:     ErrPos : LONGINT;
0628:   BEGIN
0629:     FNopm_Send_SimpleCommand := opmC_WebDefaultCode;
0630:     OpResult := '';
0631:     opmG_HTTPClient_TransactLog := '';
0632:     IF (OperationStr <> '') THEN
0633:       BEGIN
0634:         CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0635:         opmG_HTTPClient.DisconnectSocket;
0636:         PostData := TIdMultiPartFormDataStream.Create;
0637:         PostData.AddFormField ('Op', OperationStr);
0638:         PostData.AddFormField ('Fn', OpParams);
0639:         TRY
0640:           TRY
0641:             opmG_HTTPClient_TransactLog := opmG_HTTPClient.Post (CommandURL, PostData);
0642:           EXCEPT
0643:             {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0644:             opmG_HTTPClient_TransactLog := '';
0645:           END;
0646:         FINALLY
0647:           PostData.Free;
0648:         END;
0649:         OpResult := opmG_HTTPClient_TransactLog;
0650:         IF (ANSIPOS (opmC_WebScriptOKCode, opmG_HTTPClient_TransactLog) > 0) THEN
0651:           FNopm_Send_SimpleCommand := 0
0652:         ELSE
0653:           BEGIN
0654:             ErrPos := ANSIPOS (opmC_WebScriptERRORCode, opmG_HTTPClient_TransactLog);
0655:             IF (ErrPos > 0) THEN
0656:               BEGIN
0657:                 DELETE (opmG_HTTPClient_TransactLog, 1, ErrPos + LENGTH (opmC_WebScriptERRORCode));
0658:                 ErrPos := ANSIPOS (' ', opmG_HTTPClient_TransactLog);
0659:                 IF (ErrPos > 0) THEN FNopm_Send_SimpleCommand := FNopm_StrToInt (COPY (opmG_HTTPClient_TransactLog, 1, (ErrPos - 1)));
0660:               END
0661:             ELSE FNopm_Send_SimpleCommand := opmC_WebScriptUnknownCode;
0662:           END;
0663:       END;
0664:   END;
0665:   
0666:   
0667:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0668:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0669:   FUNCTION FNopm_Receive_File (CommandURL, OperationStr, RetFileName : STRING) : STRING;
0670:   VAR
0671:     PostData : TIdMultiPartFormDataStream;
0672:     CommandStamp : STRING;
0673:     FileStream : TMemoryStream;
0674:     SugFileName : STRING;
0675:   BEGIN
0676:     FNopm_Receive_File := '';
0677:     opmG_HTTPClient_TransactLog := '';
0678:     SugFileName := '';
0679:     SysUtils.DELETEFILE (RetFileName);
0680:     IF (OperationStr <> '') THEN
0681:       BEGIN
0682:         CommandURL := opmG_HTTPClient.URL.URLEncode (CommandURL);
0683:         opmG_HTTPClient.DisconnectSocket;
0684:         CommandStamp := DATETIMETOSTR (NOW);
0685:         PostData := TIdMultiPartFormDataStream.Create;
0686:         PostData.AddFormField ('Pw', opm_FNMD5 (CommandStamp + opmG_DBPassword));
0687:         PostData.AddFormField ('Op', OperationStr);
0688:         PostData.AddFormField ('Fn', RetFileName);
0689:         PostData.AddFormField ('Vn', opmC_WebScriptVersion);
0690:         PostData.AddFormField ('TS', CommandStamp);
0691:         FileStream := TMemoryStream.Create;
0692:         TRY
0693:           TRY
0694:             opmG_HTTPClient.Post (CommandURL, PostData, FileStream);
0695:             IF (FileStream.Size > 10) THEN
0696:               BEGIN
0697:                 FileStream.SaveToFile (RetFileName);
0698:                 SugFileName := opmG_HTTPClient.Response.RawHeaders.Values['Content-disposition'];
0699:                 SugFileName := TRIM (COPY (SugFileName, ANSIPOS ('filename=', SugFileName) + LENGTH ('filename='), 50));
0700:                 FNopm_Receive_File := SugFileName;
0701:               END
0702:             ELSE FNopm_Receive_File := '';
0703:           EXCEPT
0704:             {ON EIdOSSLCouldNotLoadSSLLibrary DO RAISE;}
0705:             FNopm_Receive_File := '';
0706:           END;
0707:         FINALLY
0708:           PostData.Free;
0709:           FileStream.Free;
0710:         END;
0711:       END;
0712:   END;
0713:   
0714:   
0715:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0716:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0717:   FUNCTION FNopm_FullRemoteError (ErrorCode : LONGINT) : STRING;
0718:   BEGIN
0719:     CASE ErrorCode OF
0720:       opmC_WebScriptDefaultCode  : FNopm_FullRemoteError := 'ERROR 100:  ' + _('There was an error while trying to connect to the server-side script.') + #13#10 + _('Please check it is installed and check your proxy settings.');
0721:       opmC_WebScriptUnknownCode  : FNopm_FullRemoteError := 'ERROR 200:  ' + _('General script error.') + #13#10 + _('The script failed and could not even report the error.');
0722:       opmC_WebDefaultCode  : FNopm_FullRemoteError := 'ERROR 50:  ' + _('There was an error while trying to connect to the web file.') + #13#10 + _('This could be a temporary failure in the web server. Please, try later.') + #13#10 + _('But also could be a misconfiguration; please check your proxy settings.');
0723:       1000 : FNopm_FullRemoteError := 'ERROR 1000: ' + _('The version of the server-side script is wrong.') + #13#10 + _('Please install the file provided with this application.');
0724:       1010 : FNopm_FullRemoteError := 'ERROR 1010: ' + _('The server image directory cannot be found.');
0725:       1020 : FNopm_FullRemoteError := 'ERROR 1020: ' + _('The password is not correct.');
0726:       1021 : FNopm_FullRemoteError := 'ERROR 1021: ' + _('There has been an error while trying to get the server password.');
0727:       1031 : FNopm_FullRemoteError := 'ERROR 1031: ' + _('There has been an error while trying to connect the database from the server-side script.');
0728:       1110 : FNopm_FullRemoteError := 'ERROR 1110: ' + _('The requested file cannot be found.');
0729:       1120 : FNopm_FullRemoteError := 'ERROR 1120: ' + _('There has been an error deleting the file (the file was not deleted).');
0730:       1121 : FNopm_FullRemoteError := 'ERROR 1121: ' + _('There has been an error deleting the file.');
0731:       1130 : FNopm_FullRemoteError := 'ERROR 1130: ' + _('There has been an error while uploading the file (the uploaded file was not found).');
0732:       1131 : FNopm_FullRemoteError := 'ERROR 1131: ' + _('There has been an error while uploading the file (the uploaded file could not be moved).');
0733:       1133 : FNopm_FullRemoteError := 'ERROR 1133: ' + _('There has been an error while uploading the file (the uploaded file already exists).');
0734:       1134 : FNopm_FullRemoteError := 'ERROR 1134: ' + _('There has been an error while uploading the file.');
0735:       1150 : FNopm_FullRemoteError := 'ERROR 1150: ' + _('There has been an error while trying to get the exchange rates (the remote server did not answered).');
0736:       1151 : FNopm_FullRemoteError := 'ERROR 1151: ' + _('There has been an error while trying to get the exchange rates (the currency code is invalid).');
0737:       1152 : FNopm_FullRemoteError := 'ERROR 1152: ' + _('There has been an error while trying to get the exchange rates (no currency code was specified).');
0738:     ELSE
0739:       FNopm_FullRemoteError := _('Unknown error.');
0740:     END;
0741:   END;
0742:   
0743:   
0744:   
0745:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0746:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0747:   INITIALIZATION
0748:   
0749:   ExistNetLink := FNopm_NetExist;
0750:   opmG_DBConnection := TZConnection.Create (Application);
0751:   opmG_DBConnection.AutoCommit := TRUE;
0752:   opmG_DBConnection.ReadOnly := TRUE;
0753:   opmG_DBConnection.TransactIsolationLevel := tiNone;
0754:   opmG_DBQuery := TZQuery.Create (Application);
0755:   opmG_DBQuery.RequestLive := FALSE;
0756:   opmG_DBQuery.CachedUpdates := FALSE;
0757:   opmG_DBQuery.ParamCheck := FALSE;
0758:   opmG_DBQuery.ShowRecordTypes := [utUnmodified, utModified, utInserted, utDeleted];
0759:   opmG_DBQuery.UpdateMode := umUpdateChanged;
0760:   opmG_DBQuery.WhereMode := wmWhereKeyOnly;
0761:   opmG_DBQuery.Options := [doCalcDefaults];
0762:   opmG_DBQuery.Connection := opmG_DBConnection;
0763:   
0764:   
0765:   opmG_SSLHandler := TIdSSLIOHandlerSocket.Create (Application);
0766:   opmG_SSLHandler.SSLOptions.Method := sslvSSLv2;
0767:   opmG_SSLHandler.SSLOptions.Mode := sslmUnassigned;
0768:   opmG_SSLHandler.SSLOptions.VerifyMode := [];
0769:   opmG_SSLHandler.SSLOptions.VerifyDepth := 0;
0770:   
0771:   opmG_HTTPClient := TIdHTTP.Create (Application);
0772:   opmG_HTTPClient.MaxLineAction := maException;
0773:   opmG_HTTPClient.OnWork := opmG_Network_EventHandler.PRopm_HTTPClient_Work;
0774:   opmG_HTTPClient.OnWorkBegin := opmG_Network_EventHandler.PRopm_HTTPClient_WorkBegin;
0775:   opmG_HTTPClient.OnWorkEnd := opmG_Network_EventHandler.PRopm_HTTPClient_WorkEnd;
0776:   opmG_HTTPClient.AllowCookies := False;
0777:   opmG_HTTPClient.HandleRedirects := True;
0778:   opmG_HTTPClient.ProxyParams.BasicAuthentication := FALSE;
0779:   opmG_HTTPClient.ProxyParams.ProxyPort := 0;
0780:   opmG_HTTPClient.Request.ContentLength := 0;
0781:   opmG_HTTPClient.Request.ContentRangeEnd := 0;
0782:   opmG_HTTPClient.Request.ContentRangeStart := 0;
0783:   opmG_HTTPClient.Request.Accept := 'text/html, */*';
0784:   opmG_HTTPClient.Request.BasicAuthentication := FALSE;
0785:   opmG_HTTPClient.HTTPOptions := [hoForceEncodeParams];
0786:   opmG_HTTPClient.IOHandler := opmG_SSLHandler;
0787:   
0788:   
0789:   opmG_INDY_AntiFreeze := TIdAntiFreeze.Create (Application);
0790:   
0791:   
0792:   SSHTunnelHandle := 0;
0793:   
0794:   FINALIZATION
0795:   
0796:   {opmG_DBConnection.Free;}
0797:   
0798:   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