Priprava na init poolingu uz ve WinService + do TBaseController dat jen FConn a na to okazovat dal

_custom/INCOSystems/uSvcCustom.pas

@@ -93,7 +93,8 @@ uses
           end;
         end;
        finally
-        FreeAndNil(lQry);
+        lQry.Close;
+        lQry.Free;
       end;
 
 

_custom/Rootvin/sql/ep_Vyroba_GenObjednavkuMatDoVyrobyNew.sql

@@ -98,11 +98,13 @@ DELETE FROM dbo._TabVyroba_Objednavky_Pol WHERE IDPohybOZ NOT IN (SELECT ID FROM
 SET @genDokladMat=0
 IF EXISTS (SELECT 1 FROM dbo._TabVyroba_Objednavky o WHERE o.Splneno=0 AND o.OdmitnutoSkladem=0 AND o.NocniObjednavka=0 AND o.Storno=0 AND o.Vratka=0
             AND o.JeMaterial=1 AND o.Blokovano=0 AND (o.Mnozstvi-ISNULL( (SELECT SUM(Mnozstvi) FROM dbo._TabVyroba_Objednavky_Pol WHERE IDHlava=o.ID), 0))>0
+            AND DATEDIFF(day, o.DatPorizeni, GETDATE())<6
           )
  BEGIN
   SET @genDokladMat=1
   SET @datumDokladuMat = (SELECT MIN(o.DatPorizeni) FROM dbo._TabVyroba_Objednavky o WHERE o.Splneno=0 AND o.OdmitnutoSkladem=0 AND o.NocniObjednavka=0 AND o.Storno=0 AND o.Vratka=0
                            AND o.JeMaterial=1 AND o.Blokovano=0 AND (o.Mnozstvi-ISNULL( (SELECT SUM(Mnozstvi) FROM dbo._TabVyroba_Objednavky_Pol WHERE IDHlava=o.ID), 0))>0
+                           AND DATEDIFF(day, o.DatPorizeni, GETDATE())<6
                           )
  END
 SET @datumDokladuMat = ISNULL(@datumDokladuMat, GETDATE())
@@ -112,11 +114,13 @@ SET @datumDokladuMat = ISNULL(@datumDokladuMat, GETDATE())
 SET @genDokladFin=0
 IF EXISTS (SELECT 1 FROM dbo._TabVyroba_Objednavky o WHERE o.Splneno=0 AND o.OdmitnutoSkladem=0 AND o.NocniObjednavka=0 AND o.Storno=0 AND o.Vratka=0
             AND o.JeMaterial=0 AND o.Blokovano=0 AND (o.Mnozstvi-ISNULL( (SELECT SUM(Mnozstvi) FROM dbo._TabVyroba_Objednavky_Pol WHERE IDHlava=o.ID), 0))>0
+            AND DATEDIFF(day, o.DatPorizeni, GETDATE())<6
           )
  BEGIN
   SET @genDokladFin=1
   SET @datumDokladuFin = (SELECT MIN(o.DatPorizeni) FROM dbo._TabVyroba_Objednavky o WHERE o.Splneno=0 AND o.OdmitnutoSkladem=0 AND o.NocniObjednavka=0 AND o.Storno=0 AND o.Vratka=0
                            AND o.JeMaterial=0 AND o.Blokovano=0 AND (o.Mnozstvi-ISNULL( (SELECT SUM(Mnozstvi) FROM dbo._TabVyroba_Objednavky_Pol WHERE IDHlava=o.ID), 0))>0
+                           AND DATEDIFF(day, o.DatPorizeni, GETDATE())<6
                          )
  END
 SET @datumDokladuFin = ISNULL(@datumDokladuFin, GETDATE())
@@ -138,6 +142,7 @@ IF (@genDokladMat=1) OR (@genDokladFin=1)
       AND Vratka=0
       AND Blokovano=0
       AND IDPhIdent2 IS NOT NULL
+      AND DATEDIFF(day, DatPorizeni, GETDATE())<6
     GROUP BY JeMaterial
   OPEN m
   WHILE (1=1)
@@ -211,6 +216,7 @@ IF (@genDokladMat=1) OR (@genDokladFin=1)
           AND Blokovano=0
           AND IDPhIdent2 IS NOT NULL
           AND JeMaterial=@material
+          AND DATEDIFF(day, DatPorizeni, GETDATE())<6
         ORDER BY DatPorizeni
       OPEN c
       WHILE (1=1)
@@ -322,6 +328,7 @@ DECLARE c CURSOR LOCAL FAST_FORWARD FOR
     AND Vratka=0
     AND Storno=0
     AND OdmitnutoSkladem=0
+    AND DATEDIFF(day, DatPorizeni, GETDATE())<14
     AND ID IN (SELECT 1 FROM dbo._TabVyroba_Objednavky_Pol p WITH(NOLOCK) WHERE p.IDHlava=ID)
 OPEN c
 WHILE (1=1)

_custom/Rootvin/winSvc/impl.inc

@@ -1,7 +1,8 @@
- constructor THeoRTNZapisObjMatThread.Create (AOnTerminate: TNotifyEvent; AService: TService);
+ constructor THeoRTNZapisObjMatThread.Create (AOnTerminate: TNotifyEvent; AService: TService = nil; dm: TdatMod = nil);
   begin
    inherited Create (false);          // Create thread in NOT suspended mode
    FMainService := AService;
+   FDataMod := dm;
    FLock := TCriticalSection.Create;
    FRunning := false;
    FTermEvent := TEvent.Create (nil, False, False, '');
@@ -20,11 +21,15 @@
 {$IFDEF DEBUG}
    Write('Ukoncuji thread RTN Zapis objednavka materialu do ExpPr...');
 {$ENDIF}
+   try
     if (FTimer<>0) then
      CloseHandle (FTimer);
     FTermEvent.Free;
+    finally
+   end;
    FRunning := false;
    FMainService := nil;
+   FDataMod := nil;
    Terminate;
    FLock.Free;
    inherited;
@@ -53,6 +58,7 @@
  procedure THeoRTNZapisObjMatThread.Execute;
   const _Second = 10_000_000;
   var lSQL, errMsg, url, outData, fName, loopCasTyp: string;
+      lokalniConn: boolean;
       lLoop, idDigiFile, cnt, idx: Integer;
       lLoopMax, koefProCas: integer;
       logRunCnt, intTemp: integer;
@@ -141,9 +147,19 @@
        if (lLoop=lLoopMax) or (firstRun) then  // pri startu a pak kazdou minutu
         begin
 
+         lokalniConn := (FDataMod<>nil);
+         if not(lokalniConn) then
+           begin
+            sqlConnX := FDataMod.sqlConn;
+           end
+          else
+           begin
             sqlConnX := TFDConnection.Create (nil);
+            sqlConnX.ConnectionDefName := sqlPoolName;
+           end;
          try
-           sqlConnX.Params.SetStrings (datMod.sqlConnParams);
+           sqlConnX.Open;
+
            lQry := TFDQuery.Create(nil);
            try
              lQry.Connection := sqlConnX;
@@ -152,9 +168,9 @@
              firstRun:= false;
 
              if (logRunCnt<4) then
-              datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky materialu do ExpPr c.' + logRunCnt.toString + '...');
+              FDataMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky materialu do ExpPr c.' + logRunCnt.toString + '...');
              if (logRunCnt=4) then
-              datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky - bezi, ale dal neloguju');
+              FDataMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky - bezi, ale dal neloguju');
 
              try
                if not(inProg) then // nebezi uz ?
@@ -162,7 +178,6 @@
 
                  if (1=1) then // pro rychle vypnuti
                   begin
-                   sqlConnX.Open;
                    if (sqlConnX.Connected) then
                     begin
                      inProg:= true;
@@ -177,7 +192,7 @@
                        errMsg := lQry.FieldByName('ErrMsg').AsString;
                        if (errMsg<>'') then
                         begin
-                         datMod.LogInfo (Quick.Logger.etInfo, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
+                         FDataMod.LogInfo (Quick.Logger.etInfo, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
    {$IFDEF DEBUG}
                          WriteLn ('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
    {$ENDIF}
@@ -203,15 +218,20 @@
                end;
              end;
             finally
+             lQry.Close;
              lQry.Free;
            end;
 
           finally
+           if (lokalniConn) then
+            begin
+             sqlConnX.Close;
              sqlConnX.Free;
             end;
+         end;
 
          lLoop := 0;
-         if (logRunCnt<5) then
+         if (logRunCnt<6) then // pro vypnuti zprav o zpracovani dat
           Inc (logRunCnt);
         end; // if lLoop=lLoopMax...
 

_custom/Rootvin/winSvc/mainSvcStart.inc

@@ -2,7 +2,7 @@
 {$IFDEF DEBUG}
          WriteLn ('Start sluzby Zapis objednavek materialu do ExpPr - inverval 10 minut...');
 {$ENDIF}
-         rtnZapisObjMatThr:= THeoRTNZapisObjMatThread.Create (ThreadTerminated, self);
+         rtnZapisObjMatThr:= THeoRTNZapisObjMatThread.Create (ThreadTerminated, self, datMod);
          if (rtnZapisObjMatThr.Started) then
           begin
            datMod.LogInfo (Quick.Logger.etInfo, '  OK');

_custom/Rootvin/winSvc/types.inc

@@ -1,6 +1,7 @@
   THeoRTNZapisObjMatThread = class(TThread)
    private
     FMainService: TService;
+    FDataMod : TdatMod;
     FLock: TCriticalSection;
     FTermEvent: TEvent;
     FRunning: boolean;
@@ -9,7 +10,7 @@
     procedure Execute; override;
     procedure TerminatedSet; override; // XE2+ only *
    public
-    constructor Create (AOnTerminate: TNotifyEvent; AService: TService);
+    constructor Create (AOnTerminate: TNotifyEvent; AService: TService=nil; dm: TdatMod = nil);
     destructor  Destroy; override;
     procedure ThreadTerminate;
   end;

hdcDZApi.dproj

@@ -5,7 +5,7 @@
         <FrameworkType>VCL</FrameworkType>
         <MainSource>hdcDZApi.dpr</MainSource>
         <Base>True</Base>
-        <Config Condition="'$(Config)'==''">Release</Config>
+        <Config Condition="'$(Config)'==''">Debug</Config>
         <Platform Condition="'$(Platform)'==''">Win64</Platform>
         <TargetedPlatforms>2</TargetedPlatforms>
         <AppType>Application</AppType>

uCtrlBase.pas

@@ -10,6 +10,12 @@ uses
   MVCFramework.Serializer.Commons,
   MVCFramework.Nullables,
   MVCFramework.Controllers.Register,
+  FireDAC.Stan.Intf, FireDAC.Stan.Option,
+  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
+  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait,
+  Data.DB, FireDAC.Comp.Client, FireDAC.Comp.UI, FireDAC.Phys.MSSQLDef,
+  FireDAC.Phys.ODBCBase, FireDAC.Phys.MSSQL, FireDAC.Stan.Param, FireDAC.DatS,
+  FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet, FireDAC.Stan.Consts,
   uDataMod,
   uCommons,
   uSvc_Base,
@@ -35,6 +41,8 @@ const
 
 type
   TBaseController = class abstract(TMVCController)
+   private
+    FConn: TFDConnection;
    strict private
     FObecnyService: TObecnyService;
 
@@ -160,7 +168,11 @@ type
     function GetEMPNadobaService: TEMPNadobaService;
     function GetEMPVytezeniDoklService: TEMPVytezeniDoklService;
 {$ENDIF}
+
+    procedure OnBeforeAction (aContext: TWebContext; const aActionName: string; var AHandled: Boolean); override;
+    procedure OnAfterAction (aContext: TWebContext; const aActionName: string); override;
    public
+    property Conn: TFDConnection read FConn;
     constructor Create; override;
     destructor Destroy; override;
     function sanitizeSQLString (s: string): string;
@@ -209,12 +221,35 @@ implementation
 uses
   Winapi.ActiveX,
   System.SysUtils,
-  System.DateUtils,
+  System.DateUtils;
-  FireDAC.Stan.Consts;
 
 
 { TBaseController }
 
+ procedure TBaseController.OnBeforeAction (aContext: TWebContext; const aActionName: string; var AHandled: Boolean);
+  begin
+   inherited;
+   AHandled := true;
+
+   FConn := TFDConnection.Create (nil);
+   FConn.ConnectionDefName := sqlPoolName;
+   FConn.Connected := true;
+  end;
+
+
+
+ procedure TBaseController.OnAfterAction (aContext: TWebContext; const aActionName: string);
+  begin
+   try
+     if Assigned(FConn) then
+      FConn.Close;
+    finally
+     FConn.Free;
+   end;
+  end;
+
+
+
  constructor TBaseController.Create;
   begin
    inherited;

uWinService.pas

@@ -24,7 +24,8 @@ uses
 {$IFDEF CUSTOM_CTRL_EMPolar}
  {$I ./_custom/EMPolar/winSvc/usesTop.inc}
 {$ENDIF}
-  flcCipher, Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files;
+  flcCipher, Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files,
+  uDataMod;
 
 
 const
@@ -237,6 +238,7 @@ const
     function Encrypt (const AStr: string): RawByteString;
     function ReturnEncrypted(const AStr: string): string;
     function ReadConfig (var errMsg: string): boolean;
+    procedure InitConn (var errMsg: string);
 
     procedure ThreadTerminated (Sender: TObject);
 {$IFDEF OMNIThreadLib}
@@ -296,8 +298,11 @@ var
   apiPort: integer;
   webAuth, urlDZTaskyDown: string;
 
-  dbName, dbServer, dbUser, dbPwd, heoLic, apiLic, dataZoneKlic, heoPath, sslLibPath: string;
+  heoLic, apiLic, dataZoneKlic, heoPath, sslLibPath: string;
-  dbPort, intGetDZTasks: integer;
+  s_dbName, s_dbServer, s_dbUser, s_dbPwd: string;
+  s_dbPort: integer;
+  s_dbEncConn, initConnOK: boolean;
+  intGetDZTasks: integer;
   intProcessDZTasksSec: integer;
   jeSSL, jeLoginMod: boolean;
 
@@ -341,7 +346,7 @@ uses
  {$I ./_custom/Rootvin/winSvc/uses.inc}
 {$ENDIF}
   helTabsBIDs,
-  uWebMod, uDataMod;
+  uWebMod;
 {$R *.DFM}
 
 
@@ -1650,6 +1655,67 @@ Logger.WriteLog(logItem);
 
 
 
+ procedure THDCDZApiService.InitConn (var errMsg: string);
+  var Def: IFDStanConnectionDef;
+      oPars: TStrings; // TFDPhysMSSQLConnectionDefParams;
+  begin
+   errMsg := '';
+   Def := FDManager.ConnectionDefs.FindConnectionDef (sqlPoolName);
+   if (Def=nil) and (s_dbServer<>'') and not(initConnOK) then
+    begin
+     oPars:= TStringList.Create;
+     try
+       try
+         oPars.Add (S_FD_ConnParam_Common_Server + '=' + s_dbServer);
+         oPars.Add (S_FD_ConnParam_Common_Port + '=' + s_dbPort.ToString);
+         oPars.Add (S_FD_ConnParam_Common_Database + '=' + s_dbName);
+         oPars.Add (S_FD_ConnParam_Common_UserName + '=' + s_dbUser);
+         oPars.Add (S_FD_ConnParam_Common_Password + '=' + s_dbPwd);
+         oPars.Add (S_FD_ConnParam_Common_OSAuthent + '=No');
+         oPars.Add (S_FD_ConnParam_Common_MetaDefSchema + '=dbo');
+         oPars.Add (S_FD_ConnParam_Common_LoginTimeout + '=15');
+         oPars.Add (S_FD_ConnParam_MSSQL_MARS + '=Yes');
+         oPars.Add (S_FD_ConnParam_Common_ExtendedMetadata + '=False'); // True jen pri pouziti AutoGenerate SQL / CachedUpdates / UpdateObject
+         oPars.Add (S_FD_ConnParam_Common_ApplicationName + '=hdcdzAPIsvc');
+         oPars.Add (S_FD_ConnParam_Common_Pooled + '=True');
+         oPars.Add (S_FD_ConnParam_Common_Pool_MaximumItems + '=300');
+         oPars.Add (S_FD_ConnParam_Common_Pool_ExpireTimeout + '=30000');  // FireDAC v intervalu 30 sekund testuje platnost spojeni, jestli to SQL server neukoncil
+         oPars.Add (S_FD_ConnParam_Common_Pool_CleanupTimeout + '=90000');  // FireDAC v intervalu 90 sekund cisti nepouzivana spojeni
+         oPars.Add (S_FD_ConnParam_ODBC_ODBCAdvanced + '=TrustServerCertificate=yes');
+//         oPars.Add('CommandTimeout=120');
+         if (s_dbEncConn) then
+          oPars.Add (S_FD_ConnParam_MSSQL_Encrypt + '=Yes');
+
+         if not(ConnInit) then
+          begin
+           TMonitor.Enter(ConnInitLock);
+           try
+             if not(ConnInit) then
+              begin
+               if (FDManager.ConnectionDefs.FindConnectionDef(sqlPoolName) = nil) then
+                FDManager.AddConnectionDef (sqlPoolName, 'MSSQL', oPars);
+               ConnInit := True;
+              end;
+            finally
+             TMonitor.Exit (ConnInitLock);
+           end;
+          end;
+
+         initConnOK := true;
+        except
+         initConnOK := false;
+       end;
+      finally
+       oPars.Free;
+    end;
+
+   if (FDManager.State = dmsInactive) then
+    FDManager.Open;
+  end;
+
+
+
+
  function THDCDZApiService.ReadConfig (var errMsg: string): boolean;
   var xN1: TXmlNode;
       i: integer;
@@ -1730,11 +1796,19 @@ Logger.WriteLog(logItem);
             datMod.dbName:= 'Helios001';
             datMod.dbUser:= '';
             datMod.dbPwd:= '';
+            datMod.dbEncConn:= false;
+
+            s_dbServer:= 'localhost';
+            s_dbPort:= 1433;
+            s_dbName:= 'Helios001';
+            s_dbUser:= '';
+            s_dbPwd:= '';
+            s_dbEncConn:= false;
+
             datMod.chL:= true; // check licenci
             intGetDZTasks:= 0;
             intProcessDZTasksSec:= 120; // default pro zapis tasku do Heliosu (zpracovani tabulky dbo._hdc_ph_PrijataJsonData)
             DZTaksZapisTypCas:= 0; // sek
-            datMod.dbEncConn:= false;
             webAuth:= 'https://forum.helios.eu/HeliosStoreWS/wsHeliosStore.asmx';
             urlDZTaskyDown:= 'http://manager.datazone.cloud/api/task/PH2';
 
@@ -1765,7 +1839,10 @@ Logger.WriteLog(logItem);
                    i:= attribs.IndexOf(sServer);
                    if (i>-1) then
                     if (attribs.Get(i).NodeValue<>null) then
+                     begin
                       datMod.dbServer:= attribs.Get(i).NodeValue;
+                      s_dbServer:= attribs.Get(i).NodeValue;
+                     end;
 {$IFDEF DEBUG}
 Writeln('Server: ' + datMod.dbServer);
 {$ENDIF}
@@ -1775,31 +1852,43 @@ Writeln('Server: ' + datMod.dbServer);
                      begin
                       sTemp:= attribs.Get(i).NodeValue;
                       datMod.dbPort:= sTemp.ToInteger;
+                      s_dbPort:= sTemp.ToInteger;
                      end;
 
                    i:= attribs.IndexOf(sName);
                    if (i>-1) then
                     if (attribs.Get(i).NodeValue<>null) then
+                     begin
                       datMod.dbName:= attribs.Get(i).NodeValue;
+                      s_dbName:= attribs.Get(i).NodeValue;
+                     end;
 {$IFDEF DEBUG}
-Writeln('DB: ' + datMod.dbName);
+Writeln('DB: ' + s_dbName);
 {$ENDIF}
                    i:= attribs.IndexOf(sUser);
                    if (i>-1) then
                     if (attribs.Get(i).NodeValue<>null) then
+                     begin
                       datMod.dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue);
+                      s_dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue);
+                     end;
 
                    i:= attribs.IndexOf(sPwd);
                    if (i>-1) then
                     if (attribs.Get(i).NodeValue<>null) then
+                     begin
                       datMod.dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue);
-
+                      s_dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue);
+                     end;
 
                    i:= attribs.IndexOf(sEncConn);
                    if (i>-1) then
                     if (attribs.Get(i).NodeValue<>null) then
                      if (attribs.Get(i).NodeValue='1') then
+                      begin
                        datMod.dbEncConn:= true;
+                       s_dbEncConn:= true;
+                      end;
 
 
                    i:= attribs.IndexOf(sSSL);
@@ -2515,6 +2604,8 @@ Writeln('DB: ' + datMod.dbName);
      Exit;
     end;
 
+   initConnOK:= false;
+   InitConn (sTemp);
 
 
    verText:= StringReplace(GetFileVersion2(GetModuleName(HInstance)),'.','',[rfReplaceAll]);