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