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