Source code of file oscpm_aspel/main.pas from the
osCommerce Product Manager for Windows.


0000:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001:   OSCPM-ASPEL2 module for the osCommerce Product Manager for Windows
0002:   0003:   
0004:   Permission is hereby granted, free of charge, to any person obtaining
0005:   a copy of this software and associated documentation files (the
0006:   "Software"), to deal in the Software without restriction, including
0007:   without limitation the rights to use, copy, modify, merge, publish,
0008:   distribute, sublicense, and/or sell copies of the Software, and to
0009:   permit persons to whom the Software is furnished to do so, subject to
0010:   the following conditions:
0011:   
0012:   The above copyright notice and this permission notice shall be
0013:   included in all copies or substantial portions of the Software.
0014:   
0015:   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
0016:   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
0017:   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
0018:   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
0019:   BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
0020:   ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
0021:   CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
0022:   SOFTWARE.
0023:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0024:   
0025:   unit main;
0026:   
0027:   interface
0028:   
0029:   uses
0030:     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
0031:     Dialogs, StdCtrls, DB, DBTables, IdBaseComponent, IdComponent, IdTCPServer,
0032:     IdAntiFreezeBase, IdAntiFreeze, SyncObjs, ComCtrls;
0033:   
0034:   
0035:   
0036:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0037:   Using the DB file (o1as_AspelDBFile), open the table (o1as_AspelDBTable)
0038:   and search for the received values in the input field (o1as_AspelInputField)
0039:   and returns the output field (o1as_AspelOutputField).
0040:   
0041:   For the TCP connection with the client, use the given TCP port (o1as_AspelTCPPort).
0042:   
0043:   If asked (o1as_AspelShowAll), show a detailed status panel about the transactions ().
0044:   
0045:   If asked, convert the output value using the following parameters:
0046:   For each found record (when searching the input value), get the conversion field
0047:   (o1as_AspelConvField) and search its value in the conversion table
0048:   (o1as_AspelConvDBTable) in the conversion input field (o1as_AspelConvInputField)
0049:   and return its conversion output value (o1as_AspelConvOutputField).
0050:   The output field will be multiplied by the conversion output value to get the
0051:   normalized return value.
0052:   Then search the conversion table again looking for the wanted conversion units
0053:   (o1as_AspelConvWantedLookup) in the conversion input field, get the conversion
0054:   output value and divide the normalized return value by it.
0055:   The return the value to the client.
0056:   
0057:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0058:   
0059:   
0060:   
0061:   
0062:   CONST
0063:     o1as_AppName = 'Sincronizador de OSCPM1-ASPEL II';
0064:     o1as_AppShortName = 'oscpm1-aspel-sync2';
0065:     o1as_Version = '0.2.1';
0066:     o1as_Homepage = 'http://www.mariovaldez.net/software/oscpmwin/modules/';
0067:     o1as_Copyright = 'Copyright 2004-2006 by Mario A. Valdez-Ramirez';
0068:     o1as_Email = 'mario@mariovaldez.org';
0069:     o1as_TCPPort = 27572;
0070:     o1as_TCPHost = '127.0.0.1';
0071:     o1as_TCPTimeout = 30000;
0072:     o1as_TCPMaxChars = 250;
0073:     o1as_MaxSimConnections = 10;
0074:     o1as_QuitCommand = 'QUIT OSCPM1';
0075:     o1as_StatCommand = 'STATS OSCPM1';
0076:     o1as_OKCode = 'OK';
0077:     o1as_StatCode = 'STAT';
0078:     o1as_StatCodeEnd = 'STAT END';
0079:     o1as_ModNACode = 'NOT FOUND';
0080:     o1as_ModErrorCode = 'ERROR ERROR';
0081:     o1as_GaugeBucket = 25;
0082:     o1as_StatTotalReqs = 'Consultas totales';
0083:     o1as_StatMatchingReqs = 'Consultas coincidentes';
0084:     o1as_StatNoMatchReqs = 'Consultas sin coincidentes';
0085:     o1as_StatErrorReqs = 'Consultas con error';
0086:     o1asC_Found = 1;
0087:     o1asC_NotFound = 2;
0088:     o1asC_Error = 3;
0089:     o1asC_Total = 4;
0090:     o1asC_ShowPanel = 'P';
0091:     o1asC_ShowDebug = 'D';
0092:     o1asC_ShowExch = 'X';
0093:   
0094:   
0095:   TYPE
0096:     To1as_Form_Main = class(TForm)
0097:       o1as_GroupBox_Main: TGroupBox;
0098:       o1as_label_conninfo: TLabel;
0099:       o1as_label_recinfo: TLabel;
0100:       o1as_label_dbinfo: TLabel;
0101:       o1as_TCPServer_Main: TIdTCPServer;
0102:       o1as_label_connstat: TLabel;
0103:       o1as_GroupBox_Stats: TGroupBox;
0104:       o1as_label_totalreqs: TLabel;
0105:       o1as_label_totalreqsLeg: TLabel;
0106:       o1as_label_recfoundLeg: TLabel;
0107:       o1as_label_recfound: TLabel;
0108:       o1as_label_recnotfound: TLabel;
0109:       o1as_label_recnotfoundLeg: TLabel;
0110:       o1as_label_recerrorLeg: TLabel;
0111:       o1as_label_recerror: TLabel;
0112:       o1as_label_dbinfo2: TLabel;
0113:       o1as_label_convfactor: TLabel;
0114:       o1as_IdAntiFreeze_Main: TIdAntiFreeze;
0115:       o1as_label_debug: TLabel;
0116:       procedure FormCreate(Sender: TObject);
0117:       procedure FormShow(Sender: TObject);
0118:       procedure o1as_TCPServer_MainExecute(AThread: TIdPeerThread);
0119:       procedure FormClose(Sender: TObject; var Action: TCloseAction);
0120:     public
0121:       PROCEDURE o1as_PRChangeTotalConns (NumDelta : LONGINT);
0122:       PROCEDURE o1as_PRShowDebugLine (DebugStr : STRING);
0123:       FUNCTION o1as_FNMakeConsult (SearchedData : STRING; VAR DBQuery : TQuery) : STRING;
0124:       FUNCTION o1as_FNGetProductItem (IndexData : STRING; VAR DBQuery : TQuery) : STRING;
0125:       FUNCTION o1as_FNGetConversionLookup (WishedData : STRING; VAR DBQuery : TQuery) : STRING;
0126:       PROCEDURE o1as_PRShowConnStatRec;
0127:       PROCEDURE o1as_PRShowConnStatFin;
0128:       PROCEDURE o1as_PRCloseAll (Sender: TObject);
0129:       PROCEDURE o1as_PRChangeCounter (CounterType, NumDelta : LONGINT);
0130:     end;
0131:   
0132:     o1as_QueryCounterRecord = RECORD
0133:                                 ThreadID : CARDINAL;
0134:                                 TotalReqs,
0135:                                 RecNotFound,
0136:                                 RecFound,
0137:                                 RecError : LONGINT;
0138:                               END;
0139:     o1as_QueryCounterList = ARRAY [0..o1as_MaxSimConnections] OF o1as_QueryCounterRecord;
0140:   
0141:   
0142:   VAR
0143:     o1as_Form_Main: To1as_Form_Main;
0144:     o1as_DBLock : TCriticalSection;
0145:     o1as_UILock : TCriticalSection;
0146:     o1as_GVLock : TCriticalSection;
0147:     o1asG_RunningLinks : LONGINT;
0148:     o1asG_AspelDBFile : STRING;
0149:     o1asG_AspelDBTable : STRING;
0150:     o1asG_AspelInputField : STRING;
0151:     o1asG_AspelOutputField : STRING;
0152:     o1asG_AspelTCPPort : LONGINT;
0153:     o1asG_AspelShowPanel : BOOLEAN;
0154:     o1asG_AspelShowDebug : BOOLEAN;
0155:     o1asG_AspelShowData : BOOLEAN;
0156:     o1asG_QueryCounters : o1as_QueryCounterRecord;
0157:     o1asG_AspelConvField : STRING;
0158:     o1asG_AspelConvDBTable : STRING;
0159:     o1asG_AspelConvInputField : STRING;
0160:     o1asG_AspelConvOutputField : STRING;
0161:     o1asG_AspelConvWantedLookup : STRING;
0162:     o1asG_AspelDoConversion : BOOLEAN;
0163:     o1asG_AspelConvWantedVal : STRING;
0164:   
0165:   
0166:   
0167:   implementation
0168:   
0169:   {$R *.dfm}
0170:   
0171:   uses IdSocketHandle;
0172:   
0173:   
0174:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0175:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0176:   procedure To1as_Form_Main.FormCreate (Sender: TObject);
0177:   VAR
0178:     ServerBind : TIdSocketHandle;
0179:     Query_Test : TQuery;
0180:   BEGIN
0181:     o1asG_RunningLinks := 0;
0182:     o1asG_AspelDBFile := TRIM (ParamStr(1));
0183:     o1asG_AspelDBTable := TRIM (ParamStr (2));
0184:     o1asG_AspelInputField := TRIM (ParamStr(3));
0185:     o1asG_AspelOutputField := TRIM (ParamStr(4));
0186:     o1asG_AspelShowPanel := (POS (o1asC_ShowPanel, UPPERCASE (TRIM (ParamStr (6)))) > 0);
0187:     o1asG_AspelShowDebug := (POS (o1asC_ShowDebug, UPPERCASE (TRIM (ParamStr (6)))) > 0);
0188:     o1asG_AspelShowData := (POS (o1asC_ShowExch, UPPERCASE (TRIM (ParamStr (6)))) > 0);
0189:     o1asG_AspelConvField := TRIM (ParamStr(7));
0190:     o1asG_AspelConvDBTable := TRIM (ParamStr(8));
0191:     o1asG_AspelConvInputField := TRIM (ParamStr(9));
0192:     o1asG_AspelConvOutputField := TRIM (ParamStr(10));
0193:     o1asG_AspelConvWantedLookup := TRIM (ParamStr(11));
0194:     o1asG_AspelDoConversion := ((o1asG_AspelConvDBTable <> '') AND (o1asG_AspelConvInputField <> '') AND (o1asG_AspelConvOutputField <> '') AND (o1asG_AspelConvField <> '') AND (o1asG_AspelConvWantedLookup <> ''));
0195:     IF ((o1asG_AspelDBFile <> '') AND
0196:         (o1asG_AspelDBTable <> '') AND
0197:         (o1asG_AspelInputField <> '') AND
0198:         (o1asG_AspelOutputField <> '')) THEN
0199:       TRY
0200:         Query_Test := TQuery.Create (Application);
0201:         Query_Test.DatabaseName := o1asG_AspelDBFile;
0202:         Query_Test.SQL.Text := 'select * from ' + o1asG_AspelDBTable;
0203:         Query_Test.RequestLive := FALSE;
0204:         Query_Test.UniDirectional := TRUE;
0205:         Query_Test.Active := TRUE;
0206:         IF (o1asG_AspelDoConversion) THEN
0207:           BEGIN
0208:             o1asG_AspelConvWantedVal := o1as_FNGetConversionLookup (o1asG_AspelConvWantedLookup, Query_Test);
0209:             IF (o1asG_AspelConvWantedVal = o1as_ModErrorCode) THEN
0210:               BEGIN
0211:                 MessageBeep (MB_ICONEXCLAMATION);
0212:   0213:                 Application.Terminate;
0214:               END;
0215:           END;
0216:       EXCEPT
0217:         MessageBeep (MB_ICONEXCLAMATION);
0218:         MessageDlg ('Hubo un error al abrir la base de datos de ASPEL ' + o1asG_AspelDBFile + '. Terminando.', mtError, [mbAbort], 0);
0219:         FREEANDNIL (Query_Test);
0220:         Application.Terminate;
0221:       END
0222:     ELSE
0223:       BEGIN
0224:         MessageBeep (MB_ICONEXCLAMATION);
0225:   0226:                     'archivoMDB tabla campoindice campobuscado [puertoTCP [panel [campoconvindice tablaconv campoconvbuscado campoconvvalor convdeseada]]] ', mtError, [mbAbort], 0);
0227:         Application.Terminate;
0228:       END;
0229:     SetPriorityClass (GetCurrentProcess, NORMAL_PRIORITY_CLASS);
0230:     SetThreadPriority (GetCurrentThread, THREAD_PRIORITY_LOWEST);
0231:     IF ((TRIM (ParamStr (5)) <> '') AND (TRIM (ParamStr (5)) <> '0')) THEN
0232:       o1asG_AspelTCPPort := STRTOINTDEF (TRIM (ParamStr (5)), o1as_TCPPort)
0233:     ELSE
0234:       o1asG_AspelTCPPort := o1as_TCPPort;
0235:     o1as_TCPServer_Main.Bindings.Clear;
0236:     ServerBind := o1as_TCPServer_Main.Bindings.Add;
0237:     ServerBind.Port := o1asG_AspelTCPPort;
0238:     ServerBind.IP := o1as_TCPHost;
0239:     o1as_TCPServer_Main.MaxConnections := o1as_MaxSimConnections;
0240:     TRY
0241:       o1as_TCPServer_Main.Active := TRUE;
0242:     EXCEPT
0243:     END;
0244:     IF (o1as_TCPServer_Main.Active = FALSE) THEN
0245:       BEGIN
0246:         MessageBeep (MB_ICONEXCLAMATION);
0247:   0248:         Application.Terminate;
0249:       END;
0250:   end;
0251:   
0252:   
0253:   
0254:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0255:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0256:   procedure To1as_Form_Main.FormShow(Sender: TObject);
0257:   begin
0258:     o1as_Form_Main.Caption := o1as_AppName + ' ' + o1as_Version;
0259:     o1as_GroupBox_Main.Caption := '';
0260:     o1as_GroupBox_Stats.Caption := '';
0261:     o1as_label_dbinfo.Caption := o1asG_AspelDBFile;
0262:     o1as_label_dbinfo2.Caption := o1asG_AspelInputField + ' -> ' + o1asG_AspelOutputField + '@' + o1asG_AspelDBTable;
0263:     o1as_label_conninfo.Caption := 'Esperando conexiones en ' + o1as_TCPHost + ':' + INTTOSTR (o1asG_AspelTCPPort);
0264:     o1as_label_recinfo.Caption := '';
0265:     o1as_label_connstat.Caption := 'Esperando conexiones.';
0266:     o1as_label_debug.Caption := '';
0267:     IF (o1asG_AspelDoConversion = TRUE) THEN
0268:       o1as_label_convfactor.Caption := o1asG_AspelConvField + ' -> ' + o1asG_AspelConvInputField + ' -> ' + o1asG_AspelConvOutputField + '@' + o1asG_AspelConvDBTable + ' [*' + o1asG_AspelConvWantedVal + ']'
0269:     ELSE
0270:   0271:     o1as_label_totalreqs.Caption := '0';
0272:     o1as_label_recfound.Caption := '0';
0273:     o1as_label_recnotfound.Caption := '0';
0274:     o1as_label_recerror.Caption := '0';
0275:     o1as_GroupBox_Main.Visible := o1asG_AspelShowPanel;
0276:     IF (o1asG_AspelShowPanel = TRUE) THEN o1as_GroupBox_Stats.Top := (o1as_GroupBox_Main.Height - 1);
0277:   end;
0278:   
0279:   
0280:   
0281:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0282:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0283:   procedure To1as_Form_Main.o1as_TCPServer_MainExecute(AThread: TIdPeerThread);
0284:   VAR
0285:     Query_Main : TQuery;
0286:     CurrInputItem : STRING;
0287:     CurrOutputItem : STRING;
0288:   begin
0289:     IF (o1asG_RunningLinks < o1as_MaxSimConnections) THEN
0290:       BEGIN
0291:         SetThreadPriority (GetCurrentThread, THREAD_PRIORITY_LOWEST);
0292:         o1as_PRChangeTotalConns (1);
0293:         AThread.OnTerminate := o1as_PRCloseAll;
0294:         CurrInputItem := '';
0295:         o1as_PRShowConnStatRec;
0296:   
0297:         Query_Main := TQuery.Create (NIL);
0298:         Query_Main.DatabaseName := o1asG_AspelDBFile;
0299:         Query_Main.SQL.Text := 'select * from ' + o1asG_AspelDBTable;
0300:         Query_Main.RequestLive := TRUE;
0301:         Query_Main.UniDirectional := TRUE;
0302:         o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Database connection set.' );
0303:         TRY
0304:           AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_AppName + ' ' + o1as_Version);
0305:           AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_Homepage);
0306:           AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_Copyright);
0307:           AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_Email);
0308:           o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Welcome headers sent.' );
0309:           REPEAT
0310:             SLEEP (1);
0311:             o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Database connection set.' );
0312:             CurrInputItem := AThread.Connection.ReadLn (#13#10, o1as_TCPTimeout, o1as_TCPMaxChars);
0313:             CurrInputItem := TRIM (AdjustLineBreaks (CurrInputItem));
0314:             o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Received query:' + CurrInputItem);
0315:             IF (UPPERCASE (CurrInputItem) = o1as_QuitCommand) THEN
0316:               BEGIN
0317:                 o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Disconnecting.');
0318:                 AThread.Connection.Disconnect;
0319:                 BREAK;
0320:               END
0321:             ELSE IF (UPPERCASE (CurrInputItem) = o1as_StatCommand) THEN
0322:               BEGIN
0323:                 o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Returning statistics.');
0324:                 AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_StatTotalReqs + ': ' + INTTOSTR (o1asG_QueryCounters.TotalReqs));
0325:                 AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_StatMatchingReqs + ': ' + INTTOSTR (o1asG_QueryCounters.RecFound));
0326:                 AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_StatNoMatchReqs + ': ' + INTTOSTR (o1asG_QueryCounters.RecNotFound));
0327:                 AThread.Connection.WriteLn (o1as_StatCode + ' ' + o1as_StatErrorReqs + ': ' + INTTOSTR (o1asG_QueryCounters.RecError));
0328:                 AThread.Connection.WriteLn (o1as_StatCodeEnd);
0329:               END
0330:             ELSE
0331:               BEGIN
0332:                 o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Processing query.');
0333:                 CurrOutputItem := o1as_FNMakeConsult (CurrInputItem, Query_Main);
0334:                 o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Returning query.');
0335:                 AThread.Connection.WriteLn (o1as_OKCode + ' ' + CurrOutputItem);
0336:                 IF (o1asG_AspelShowData) THEN AThread.Connection.WriteLn (o1as_StatCode + ' ' + CurrInputItem + ' <-> ' + CurrOutputItem);
0337:               END;
0338:           UNTIL ((UPPERCASE (CurrInputItem) = o1as_QuitCommand) OR (CurrInputItem = ''));
0339:         FINALLY
0340:           o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' Excepting, disconnecting.');
0341:           AThread.Connection.Disconnect;
0342:           FREEANDNIL (Query_Main);
0343:         END;
0344:         o1as_PRShowConnStatFin;
0345:       END
0346:     ELSE
0347:       BEGIN
0348:         o1as_PRShowDebugLine (INTTOSTR (AThread.ThreadID) + ' MaxConnLimit reached. Disconnecting.');
0349:         AThread.Connection.Disconnect;
0350:       END;
0351:   END;
0352:   
0353:   
0354:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0355:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0356:   PROCEDURE To1as_Form_Main.o1as_PRChangeTotalConns (NumDelta : LONGINT);
0357:   BEGIN
0358:     o1as_GVLock.Acquire;
0359:     TRY
0360:       o1asG_RunningLinks := o1asG_RunningLinks + NumDelta;
0361:     FINALLY
0362:       o1as_GVLock.Release;
0363:     END;
0364:   END;
0365:   
0366:   
0367:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0368:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0369:   PROCEDURE To1as_Form_Main.o1as_PRShowDebugLine (DebugStr : STRING);
0370:   BEGIN
0371:     IF (o1asG_AspelShowDebug) THEN
0372:       BEGIN
0373:         o1as_UILock.Acquire;
0374:         TRY
0375:           o1as_label_debug.Caption := DebugStr;
0376:         FINALLY
0377:           o1as_UILock.Release;
0378:         END;
0379:       END;
0380:   END;
0381:   
0382:   
0383:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0384:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0385:   FUNCTION To1as_Form_Main.o1as_FNMakeConsult (SearchedData : STRING; VAR DBQuery : TQuery) : STRING;
0386:   VAR
0387:     CurrOutputItem : STRING;
0388:   BEGIN
0389:     o1as_PRChangeCounter (o1asC_Total, 1);
0390:     SearchedData := TRIM (SearchedData);
0391:     IF (SearchedData <> '') THEN
0392:       BEGIN
0393:         CurrOutputItem := o1as_FNGetProductItem (SearchedData, DBQuery);
0394:         IF (o1asG_AspelDoConversion) THEN
0395:           TRY
0396:             CurrOutputItem := FLOATTOSTRF ((STRTOCURR (CurrOutputItem) / STRTOCURR (o1asG_AspelConvWantedVal)), ffFixed, 15, 2);
0397:           EXCEPT
0398:           END;
0399:       END
0400:     ELSE
0401:       BEGIN
0402:         CurrOutputItem := o1as_ModNACode;
0403:       END;
0404:     o1as_FNMakeConsult := CurrOutputItem;
0405:     o1as_UILock.Acquire;
0406:     TRY
0407:       IF (o1asG_AspelShowPanel = TRUE) THEN
0408:         BEGIN
0409:           o1as_label_recinfo.Caption := SearchedData + ' <-> ' + CurrOutputItem;
0410:           o1as_label_connstat.Caption := 'Conexiones totales ' + INTTOSTR (o1asG_RunningLinks);
0411:         END;
0412:       o1as_label_totalreqs.Caption := INTTOSTR (o1asG_QueryCounters.TotalReqs);
0413:       o1as_label_recfound.Caption := INTTOSTR (o1asG_QueryCounters.RecFound);
0414:       o1as_label_recnotfound.Caption := INTTOSTR (o1asG_QueryCounters.RecNotFound);
0415:       o1as_label_recerror.Caption := INTTOSTR (o1asG_QueryCounters.RecError);
0416:     FINALLY
0417:       o1as_UILock.Release;
0418:     END;
0419:   END;
0420:   
0421:   
0422:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0423:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0424:   PROCEDURE To1as_Form_Main.o1as_PRShowConnStatRec;
0425:   BEGIN
0426:     IF (o1asG_AspelShowPanel = TRUE) THEN
0427:       BEGIN
0428:         o1as_UILock.Acquire;
0429:         TRY
0430:   0431:         FINALLY
0432:           o1as_UILock.Release;
0433:         END;
0434:       END;
0435:   END;
0436:   
0437:   
0438:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0439:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0440:   PROCEDURE To1as_Form_Main.o1as_PRShowConnStatFin;
0441:   BEGIN
0442:     IF (o1asG_AspelShowPanel = TRUE) THEN
0443:       BEGIN
0444:         o1as_UILock.Acquire;
0445:         TRY
0446:   0447:           o1as_label_recinfo.Caption := '';
0448:         FINALLY
0449:           o1as_UILock.Release;
0450:         END;
0451:       END;
0452:   END;
0453:   
0454:   
0455:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0456:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0457:   FUNCTION To1as_Form_Main.o1as_FNGetProductItem (IndexData : STRING; VAR DBQuery : TQuery) : STRING;
0458:   VAR
0459:     TmpResult : STRING;
0460:   BEGIN
0461:     TmpResult := o1as_ModNACode;
0462:     o1as_DBLock.Acquire;
0463:     TRY
0464:       DBQuery.Active := FALSE;
0465:       DBQuery.SQL.Clear;
0466:       IF (o1asG_AspelDoConversion = FALSE) THEN
0467:         DBQuery.SQL.Add ('select ' + o1asG_AspelOutputField + ' from ' + o1asG_AspelDBTable + ' where ' + o1asG_AspelInputField + '="' + IndexData + '";')
0468:       ELSE
0469:         DBQuery.SQL.Add ('select (' + o1asG_AspelDBTable+'.'+o1asG_AspelOutputField + '*' + o1asG_AspelConvDBTable+'.'+o1asG_AspelConvOutputField + ') from ' + o1asG_AspelDBTable + ' left join ' + o1asG_AspelConvDBTable + ' on trim(' + o1asG_AspelDBTable+'.'+o1asG_AspelConvField + ')=trim(' + o1asG_AspelConvDBTable+'.'+o1asG_AspelConvInputField + ') where ' + o1asG_AspelDBTable+'.'+o1asG_AspelInputField + '="' + IndexData + '";');
0470:       TRY
0471:         DBQuery.Active := TRUE;
0472:         DBQuery.First;
0473:         IF (NOT DBQuery.EOF) THEN
0474:           BEGIN
0475:             TmpResult := TRIM (DBQuery.Fields[0].AsString);
0476:             o1as_PRChangeCounter (o1asC_Found, 1);
0477:           END
0478:         ELSE
0479:           BEGIN
0480:             TmpResult := o1as_ModNACode;
0481:             o1as_PRChangeCounter (o1asC_NotFound, 1);
0482:           END;
0483:       EXCEPT
0484:         TmpResult := o1as_ModErrorCode;
0485:         o1as_PRChangeCounter (o1asC_Error, 1);
0486:       END;
0487:     FINALLY
0488:       o1as_DBLock.Release;
0489:     END;
0490:     o1as_FNGetProductItem := TmpResult;
0491:   END;
0492:   
0493:   
0494:   
0495:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0496:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0497:   FUNCTION To1as_Form_Main.o1as_FNGetConversionLookup (WishedData : STRING; VAR DBQuery : TQuery) : STRING;
0498:   VAR
0499:     TmpResult : STRING;
0500:   BEGIN
0501:     TmpResult := o1as_ModNACode;
0502:     o1as_DBLock.Acquire;
0503:     TRY
0504:       DBQuery.Active := FALSE;
0505:       DBQuery.SQL.Clear;
0506:       DBQuery.SQL.Add ('select ' + o1asG_AspelConvInputField + ', ' + o1asG_AspelConvOutputField + ' from ' + o1asG_AspelConvDBTable + ' where ' + o1asG_AspelConvInputField + '="' + WishedData + '";');
0507:       TRY
0508:         DBQuery.Active := TRUE;
0509:         DBQuery.First;
0510:         IF (NOT DBQuery.EOF) THEN
0511:           TmpResult := TRIM (DBQuery.Fields[1].AsString)
0512:         ELSE
0513:           TmpResult := o1as_ModNACode;
0514:       EXCEPT
0515:         TmpResult := o1as_ModErrorCode;
0516:       END;
0517:     FINALLY
0518:       o1as_DBLock.Release;
0519:     END;
0520:     o1as_FNGetConversionLookup := TmpResult;
0521:   END;
0522:   
0523:   
0524:   
0525:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0526:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0527:   PROCEDURE To1as_Form_Main.o1as_PRChangeCounter (CounterType, NumDelta : LONGINT);
0528:   BEGIN
0529:     o1as_GVLock.Acquire;
0530:     TRY
0531:       CASE (CounterType) OF
0532:         o1asC_Total: o1asG_QueryCounters.TotalReqs := o1asG_QueryCounters.TotalReqs + NumDelta;
0533:         o1asC_Found: o1asG_QueryCounters.RecFound := o1asG_QueryCounters.RecFound + NumDelta;
0534:         o1asC_NotFound: o1asG_QueryCounters.RecNotFound := o1asG_QueryCounters.RecNotFound + NumDelta;
0535:         o1asC_Error: o1asG_QueryCounters.RecError := o1asG_QueryCounters.RecError + NumDelta;
0536:       END;
0537:     FINALLY
0538:       o1as_GVLock.Release;
0539:     END;
0540:   END;
0541:   
0542:   
0543:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0544:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0545:   procedure To1as_Form_Main.FormClose(Sender: TObject; var Action: TCloseAction);
0546:   begin
0547:     IF (o1asG_RunningLinks <= 0) THEN
0548:       BEGIN
0549:         o1as_TCPServer_Main.Active := FALSE;
0550:         Action := caFree
0551:       END
0552:     ELSE Action := caNone;
0553:   end;
0554:   
0555:   
0556:   
0557:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0558:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0559:   PROCEDURE To1as_Form_Main.o1as_PRCloseAll (Sender: TObject);
0560:   BEGIN
0561:     o1as_PRChangeTotalConns (-1);
0562:     IF (o1asG_RunningLinks <= 0) THEN
0563:       BEGIN
0564:         o1as_TCPServer_Main.Active := FALSE;
0565:         Application.Terminate;
0566:       END;
0567:   END;
0568:   
0569:   
0570:   
0571:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0572:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0573:   INITIALIZATION
0574:     o1as_DBLock := TCriticalSection.Create;
0575:     o1as_UILock := TCriticalSection.Create;
0576:     o1as_GVLock := TCriticalSection.Create;
0577:   
0578:   
0579:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0580:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0581:   FINALIZATION
0582:     FREEANDNIL (o1as_DBLock);
0583:     FREEANDNIL (o1as_UILock);
0584:     FREEANDNIL (o1as_GVLock);
0585:   
0586:   
0587:   END.
 
 
NA fum/lmd: 2007.07.24
Copyright ©1994-2017 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link