TomBuzin/HDCApi
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
TomBuz
2026-04-30 09:23:44 +02:00
parent 1258a27a4e
commit 18081c6bf8
10 changed files with 224 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files
_custom/INCOSystems/uSvcCustom.pas
+26 -25
View File
@@ -59,53 +59,54 @@ uses
w: TStreamWriter; w: TStreamWriter;
jo: System.JSON.TJsonObject; jo: System.JSON.TJsonObject;
begin begin
idJSON:= 0; idJSON := 0;
respString:= '['; respString := '[';
jo:= System.JSON.TJsonObject.Create; jo := System.JSON.TJsonObject.Create;
jsonData:= jsonData.Trim; jsonData := jsonData.Trim;
if (jsonData<>'') then if (jsonData<>'') then
begin begin
lQry:= TFDQuery.Create(nil); lQry := TFDQuery.Create(nil);
try try
lQry.Connection:= FDM.sqlConn; lQry.Connection := FDM.sqlConn;
try try
CoCreateGuid(guid); CoCreateGuid(guid);
if (System.SysUtils.CreateGUID(guid)=S_OK) then if (System.SysUtils.CreateGUID(guid)=S_OK) then
guidIdent:= System.SysUtils.GUIDToString(guid) guidIdent := System.SysUtils.GUIDToString(guid)
else else
guidIdent:= self.NewUUID32; guidIdent := self.NewUUID32;
lSQL:= 'INSERT ' + tblPrijataJsonData + ' (IdPHIdent, GUIDIdent, JSONData) SELECT 0, CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + '), N' + jsonData.QuotedString; lSQL := 'INSERT ' + tblPrijataJsonData + ' (IdPHIdent, GUIDIdent, JSONData) SELECT 0, CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + '), N' + jsonData.QuotedString;
FDM.sqlConn.ExecSQL(lSQL); FDM.sqlConn.ExecSQL (lSQL);
lSQL:= 'SELECT ID FROM ' + tblPrijataJsonData + ' WHERE GUIDIdent=CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + ')'; lSQL := 'SELECT ID FROM ' + tblPrijataJsonData + ' WHERE GUIDIdent=CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + ')';
lQry.Open(lSQL); lQry.Open (lSQL);
if (lQry.RecordCount=1) then if (lQry.RecordCount=1) then
begin begin
idJSON:= lQry.FieldByName('ID').AsInteger; idJSON := lQry.FieldByName('ID').AsInteger;
respString:= 'OK'; respString := 'OK';
jo.AddPair('heliosid', idJSON.ToString); jo.AddPair ('heliosid', idJSON.ToString);
end; end;
except on E:Exception do except on E:Exception do
begin begin
respString:= 'NOT OK'; respString := 'NOT OK';
raise EServiceException.Create('Chyba zápisu JSON dat: ' + E.Message); raise EServiceException.Create('Chyba zápisu JSON dat: ' + E.Message);
end; end;
end; end;
finally finally
FreeAndNil(lQry); lQry.Close;
lQry.Free;
end; end;
CoInitialize(nil); CoInitialize (nil);
j:= TJsonObject.Parse(jsonData) as JsonDataObjects.TJsonObject; j := TJsonObject.Parse(jsonData) as JsonDataObjects.TJsonObject;
try try
if (j<>nil) then if (j<>nil) then
if (j.Contains('akce')) then if (j.Contains('akce')) then
begin begin
akce:= j.S['akce'].Trim; akce := j.S['akce'].Trim;
if (idJSON>0) and (akce<>'') then if (idJSON>0) and (akce<>'') then
FDM.sqlConn.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Akce=N' + akce.QuotedString + ' WHERE ID=' + idJSON.ToString); FDM.sqlConn.ExecSQL ('UPDATE ' + tblPrijataJsonData + ' SET Akce=N' + akce.QuotedString + ' WHERE ID=' + idJSON.ToString);
{ {
for i:=0 to j['tasks'].Count-1 do for i:=0 to j['tasks'].Count-1 do
begin begin
@@ -125,12 +126,12 @@ uses
end end
else else
respString:= 'NO input data'; respString := 'NO input data';
jo.AddPair('status', respString); jo.AddPair ('status', respString);
respString:= '[' +respString + ']'; respString := '[' +respString + ']';
respString:= jo.ToString; respString := jo.ToString;
end; end;
_custom/Rootvin/sql/ep_Vyroba_GenObjednavkuMatDoVyrobyNew.sql
+7
View File
@@ -98,11 +98,13 @@ DELETE FROM dbo._TabVyroba_Objednavky_Pol WHERE IDPohybOZ NOT IN (SELECT ID FROM
SET @genDokladMat=0 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 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 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 BEGIN
SET @genDokladMat=1 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 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 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 END
SET @datumDokladuMat = ISNULL(@datumDokladuMat, GETDATE()) SET @datumDokladuMat = ISNULL(@datumDokladuMat, GETDATE())
@@ -112,11 +114,13 @@ SET @datumDokladuMat = ISNULL(@datumDokladuMat, GETDATE())
SET @genDokladFin=0 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 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 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 BEGIN
SET @genDokladFin=1 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 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 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 END
SET @datumDokladuFin = ISNULL(@datumDokladuFin, GETDATE()) SET @datumDokladuFin = ISNULL(@datumDokladuFin, GETDATE())
@@ -138,6 +142,7 @@ IF (@genDokladMat=1) OR (@genDokladFin=1)
AND Vratka=0 AND Vratka=0
AND Blokovano=0 AND Blokovano=0
AND IDPhIdent2 IS NOT NULL AND IDPhIdent2 IS NOT NULL
AND DATEDIFF(day, DatPorizeni, GETDATE())<6
GROUP BY JeMaterial GROUP BY JeMaterial
OPEN m OPEN m
WHILE (1=1) WHILE (1=1)
@@ -211,6 +216,7 @@ IF (@genDokladMat=1) OR (@genDokladFin=1)
AND Blokovano=0 AND Blokovano=0
AND IDPhIdent2 IS NOT NULL AND IDPhIdent2 IS NOT NULL
AND JeMaterial=@material AND JeMaterial=@material
AND DATEDIFF(day, DatPorizeni, GETDATE())<6
ORDER BY DatPorizeni ORDER BY DatPorizeni
OPEN c OPEN c
WHILE (1=1) WHILE (1=1)
@@ -322,6 +328,7 @@ DECLARE c CURSOR LOCAL FAST_FORWARD FOR
AND Vratka=0 AND Vratka=0
AND Storno=0 AND Storno=0
AND OdmitnutoSkladem=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) AND ID IN (SELECT 1 FROM dbo._TabVyroba_Objednavky_Pol p WITH(NOLOCK) WHERE p.IDHlava=ID)
OPEN c OPEN c
WHILE (1=1) WHILE (1=1)
_custom/Rootvin/winSvc/impl.inc
+47 -27
View File
@@ -1,15 +1,16 @@
constructor THeoRTNZapisObjMatThread.Create (AOnTerminate: TNotifyEvent; AService: TService); constructor THeoRTNZapisObjMatThread.Create (AOnTerminate: TNotifyEvent; AService: TService = nil; dm: TdatMod = nil);
begin begin
inherited Create (false); // Create thread in NOT suspended mode inherited Create (false); // Create thread in NOT suspended mode
FMainService:= AService; FMainService := AService;
FLock:= TCriticalSection.Create; FDataMod := dm;
FRunning:= false; FLock := TCriticalSection.Create;
FTermEvent:= TEvent.Create (nil, False, False, ''); FRunning := false;
FTermEvent := TEvent.Create (nil, False, False, '');
// OnTerminate:= AOnTerminate; // OnTerminate:= AOnTerminate;
// FreeOnTerminate:= true; // FreeOnTerminate:= true;
FreeOnTerminate:= false; // Ensure manual freeing of thread resources FreeOnTerminate := false; // Ensure manual freeing of thread resources
end; end;
@@ -20,11 +21,15 @@
{$IFDEF DEBUG} {$IFDEF DEBUG}
Write('Ukoncuji thread RTN Zapis objednavka materialu do ExpPr...'); Write('Ukoncuji thread RTN Zapis objednavka materialu do ExpPr...');
{$ENDIF} {$ENDIF}
if (FTimer<>0) then try
CloseHandle (FTimer); if (FTimer<>0) then
FTermEvent.Free; CloseHandle (FTimer);
FRunning:= false; FTermEvent.Free;
FMainService:= nil; finally
end;
FRunning := false;
FMainService := nil;
FDataMod := nil;
Terminate; Terminate;
FLock.Free; FLock.Free;
inherited; inherited;
@@ -53,6 +58,7 @@
procedure THeoRTNZapisObjMatThread.Execute; procedure THeoRTNZapisObjMatThread.Execute;
const _Second = 10_000_000; const _Second = 10_000_000;
var lSQL, errMsg, url, outData, fName, loopCasTyp: string; var lSQL, errMsg, url, outData, fName, loopCasTyp: string;
lokalniConn: boolean;
lLoop, idDigiFile, cnt, idx: Integer; lLoop, idDigiFile, cnt, idx: Integer;
lLoopMax, koefProCas: integer; lLoopMax, koefProCas: integer;
logRunCnt, intTemp: integer; logRunCnt, intTemp: integer;
@@ -141,9 +147,19 @@
if (lLoop=lLoopMax) or (firstRun) then // pri startu a pak kazdou minutu if (lLoop=lLoopMax) or (firstRun) then // pri startu a pak kazdou minutu
begin begin
sqlConnX := TFDConnection.Create (nil); lokalniConn := (FDataMod<>nil);
if not(lokalniConn) then
begin
sqlConnX := FDataMod.sqlConn;
end
else
begin
sqlConnX := TFDConnection.Create (nil);
sqlConnX.ConnectionDefName := sqlPoolName;
end;
try try
sqlConnX.Params.SetStrings (datMod.sqlConnParams); sqlConnX.Open;
lQry := TFDQuery.Create(nil); lQry := TFDQuery.Create(nil);
try try
lQry.Connection := sqlConnX; lQry.Connection := sqlConnX;
@@ -152,9 +168,9 @@
firstRun:= false; firstRun:= false;
if (logRunCnt<4) then 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 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 try
if not(inProg) then // nebezi uz ? if not(inProg) then // nebezi uz ?
@@ -162,7 +178,6 @@
if (1=1) then // pro rychle vypnuti if (1=1) then // pro rychle vypnuti
begin begin
sqlConnX.Open;
if (sqlConnX.Connected) then if (sqlConnX.Connected) then
begin begin
inProg:= true; inProg:= true;
@@ -174,44 +189,49 @@
if (lQry.RecordCount>0) then if (lQry.RecordCount>0) then
begin begin
lQry.First; lQry.First;
errMsg:= lQry.FieldByName('ErrMsg').AsString; errMsg := lQry.FieldByName('ErrMsg').AsString;
if (errMsg<>'') then if (errMsg<>'') then
begin 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} {$IFDEF DEBUG}
WriteLn('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); WriteLn ('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
{$ENDIF} {$ENDIF}
end; end;
end; end;
inProg:= false; inProg := false;
end; // sql Connected end; // sql Connected
end; // 1=1 end; // 1=1
end; end;
except on E:Exception do except on E:Exception do
begin begin
inProg:= false; inProg := false;
errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString; errMsg := E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString;
if (mamTabPrijataData) then if (mamTabPrijataData) then
begin begin
datMod.LogInfo (Quick.Logger.etError, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); datMod.LogInfo (Quick.Logger.etError, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
{$IFDEF DEBUG} {$IFDEF DEBUG}
WriteLn('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); WriteLn ('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg);
{$ENDIF} {$ENDIF}
end; end;
end; end;
end; end;
finally finally
lQry.Close;
lQry.Free; lQry.Free;
end; end;
finally finally
sqlConnX.Free; if (lokalniConn) then
begin
sqlConnX.Close;
sqlConnX.Free;
end;
end; end;
lLoop:= 0; lLoop := 0;
if (logRunCnt<5) then if (logRunCnt<6) then // pro vypnuti zprav o zpracovani dat
Inc (logRunCnt); Inc (logRunCnt);
end; // if lLoop=lLoopMax... end; // if lLoop=lLoopMax...
@@ -221,7 +241,7 @@
if (FTimer<>0) then if (FTimer<>0) then
SetWaitableTimer (FTimer, TLargeInteger(liDueTime), 0, nil, nil, false); SetWaitableTimer (FTimer, TLargeInteger(liDueTime), 0, nil, nil, false);
repeat repeat
lBusy:= MsgWaitForMultipleObjects (1, FTimer, false, INFINITE, QS_ALLINPUT); lBusy := MsgWaitForMultipleObjects (1, FTimer, false, INFINITE, QS_ALLINPUT);
until lBusy = WAIT_OBJECT_0; until lBusy = WAIT_OBJECT_0;
// Sleep (998); // Sleep (998);
_custom/Rootvin/winSvc/mainSvcStart.inc
+1 -1
View File
@@ -2,7 +2,7 @@
{$IFDEF DEBUG} {$IFDEF DEBUG}
WriteLn ('Start sluzby Zapis objednavek materialu do ExpPr - inverval 10 minut...'); WriteLn ('Start sluzby Zapis objednavek materialu do ExpPr - inverval 10 minut...');
{$ENDIF} {$ENDIF}
rtnZapisObjMatThr:= THeoRTNZapisObjMatThread.Create (ThreadTerminated, self); rtnZapisObjMatThr:= THeoRTNZapisObjMatThread.Create (ThreadTerminated, self, datMod);
if (rtnZapisObjMatThr.Started) then if (rtnZapisObjMatThr.Started) then
begin begin
datMod.LogInfo (Quick.Logger.etInfo, ' OK'); datMod.LogInfo (Quick.Logger.etInfo, ' OK');
_custom/Rootvin/winSvc/types.inc
+2 -1
View File
@@ -1,6 +1,7 @@
THeoRTNZapisObjMatThread = class(TThread) THeoRTNZapisObjMatThread = class(TThread)
private private
FMainService: TService; FMainService: TService;
FDataMod : TdatMod;
FLock: TCriticalSection; FLock: TCriticalSection;
FTermEvent: TEvent; FTermEvent: TEvent;
FRunning: boolean; FRunning: boolean;
@@ -9,7 +10,7 @@
procedure Execute; override; procedure Execute; override;
procedure TerminatedSet; override; // XE2+ only * procedure TerminatedSet; override; // XE2+ only *
public public
constructor Create (AOnTerminate: TNotifyEvent; AService: TService); constructor Create (AOnTerminate: TNotifyEvent; AService: TService=nil; dm: TdatMod = nil);
destructor Destroy; override; destructor Destroy; override;
procedure ThreadTerminate; procedure ThreadTerminate;
end; end;
_custom/Rootvin/zdroje.RES
BIN
View File
Binary file not shown.
hdcDZApi.dproj
+1 -1
View File
@@ -5,7 +5,7 @@
<FrameworkType>VCL</FrameworkType> <FrameworkType>VCL</FrameworkType>
<MainSource>hdcDZApi.dpr</MainSource> <MainSource>hdcDZApi.dpr</MainSource>
<Base>True</Base> <Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config> <Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform> <Platform Condition="'$(Platform)'==''">Win64</Platform>
<TargetedPlatforms>2</TargetedPlatforms> <TargetedPlatforms>2</TargetedPlatforms>
<AppType>Application</AppType> <AppType>Application</AppType>
hdcDZApi.res
BIN
View File
Binary file not shown.
uCtrlBase.pas
+37 -2
View File
@@ -10,6 +10,12 @@ uses
MVCFramework.Serializer.Commons, MVCFramework.Serializer.Commons,
MVCFramework.Nullables, MVCFramework.Nullables,
MVCFramework.Controllers.Register, 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, uDataMod,
uCommons, uCommons,
uSvc_Base, uSvc_Base,
@@ -35,6 +41,8 @@ const
type type
TBaseController = class abstract(TMVCController) TBaseController = class abstract(TMVCController)
private
FConn: TFDConnection;
strict private strict private
FObecnyService: TObecnyService; FObecnyService: TObecnyService;
@@ -160,7 +168,11 @@ type
function GetEMPNadobaService: TEMPNadobaService; function GetEMPNadobaService: TEMPNadobaService;
function GetEMPVytezeniDoklService: TEMPVytezeniDoklService; function GetEMPVytezeniDoklService: TEMPVytezeniDoklService;
{$ENDIF} {$ENDIF}
procedure OnBeforeAction (aContext: TWebContext; const aActionName: string; var AHandled: Boolean); override;
procedure OnAfterAction (aContext: TWebContext; const aActionName: string); override;
public public
property Conn: TFDConnection read FConn;
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;
function sanitizeSQLString (s: string): string; function sanitizeSQLString (s: string): string;
@@ -209,12 +221,35 @@ implementation
uses uses
Winapi.ActiveX, Winapi.ActiveX,
System.SysUtils, System.SysUtils,
System.DateUtils, System.DateUtils;
FireDAC.Stan.Consts;
{ TBaseController } { 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; constructor TBaseController.Create;
begin begin
inherited; inherited;
uWinService.pas
+103 -12
View File
@@ -24,7 +24,8 @@ uses
{$IFDEF CUSTOM_CTRL_EMPolar} {$IFDEF CUSTOM_CTRL_EMPolar}
{$I ./_custom/EMPolar/winSvc/usesTop.inc} {$I ./_custom/EMPolar/winSvc/usesTop.inc}
{$ENDIF} {$ENDIF}
flcCipher, Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files; flcCipher, Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files,
uDataMod;
const const
@@ -237,6 +238,7 @@ const
function Encrypt (const AStr: string): RawByteString; function Encrypt (const AStr: string): RawByteString;
function ReturnEncrypted(const AStr: string): string; function ReturnEncrypted(const AStr: string): string;
function ReadConfig (var errMsg: string): boolean; function ReadConfig (var errMsg: string): boolean;
procedure InitConn (var errMsg: string);
procedure ThreadTerminated (Sender: TObject); procedure ThreadTerminated (Sender: TObject);
{$IFDEF OMNIThreadLib} {$IFDEF OMNIThreadLib}
@@ -296,8 +298,11 @@ var
apiPort: integer; apiPort: integer;
webAuth, urlDZTaskyDown: string; 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; intProcessDZTasksSec: integer;
jeSSL, jeLoginMod: boolean; jeSSL, jeLoginMod: boolean;
@@ -341,7 +346,7 @@ uses
{$I ./_custom/Rootvin/winSvc/uses.inc} {$I ./_custom/Rootvin/winSvc/uses.inc}
{$ENDIF} {$ENDIF}
helTabsBIDs, helTabsBIDs,
uWebMod, uDataMod; uWebMod;
{$R *.DFM} {$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; function THDCDZApiService.ReadConfig (var errMsg: string): boolean;
var xN1: TXmlNode; var xN1: TXmlNode;
i: integer; i: integer;
@@ -1730,11 +1796,19 @@ Logger.WriteLog(logItem);
datMod.dbName:= 'Helios001'; datMod.dbName:= 'Helios001';
datMod.dbUser:= ''; datMod.dbUser:= '';
datMod.dbPwd:= ''; 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 datMod.chL:= true; // check licenci
intGetDZTasks:= 0; intGetDZTasks:= 0;
intProcessDZTasksSec:= 120; // default pro zapis tasku do Heliosu (zpracovani tabulky dbo._hdc_ph_PrijataJsonData) intProcessDZTasksSec:= 120; // default pro zapis tasku do Heliosu (zpracovani tabulky dbo._hdc_ph_PrijataJsonData)
DZTaksZapisTypCas:= 0; // sek DZTaksZapisTypCas:= 0; // sek
datMod.dbEncConn:= false;
webAuth:= 'https://forum.helios.eu/HeliosStoreWS/wsHeliosStore.asmx'; webAuth:= 'https://forum.helios.eu/HeliosStoreWS/wsHeliosStore.asmx';
urlDZTaskyDown:= 'http://manager.datazone.cloud/api/task/PH2'; urlDZTaskyDown:= 'http://manager.datazone.cloud/api/task/PH2';
@@ -1765,7 +1839,10 @@ Logger.WriteLog(logItem);
i:= attribs.IndexOf(sServer); i:= attribs.IndexOf(sServer);
if (i>-1) then if (i>-1) then
if (attribs.Get(i).NodeValue<>null) then if (attribs.Get(i).NodeValue<>null) then
datMod.dbServer:= attribs.Get(i).NodeValue; begin
datMod.dbServer:= attribs.Get(i).NodeValue;
s_dbServer:= attribs.Get(i).NodeValue;
end;
{$IFDEF DEBUG} {$IFDEF DEBUG}
Writeln('Server: ' + datMod.dbServer); Writeln('Server: ' + datMod.dbServer);
{$ENDIF} {$ENDIF}
@@ -1775,31 +1852,43 @@ Writeln('Server: ' + datMod.dbServer);
begin begin
sTemp:= attribs.Get(i).NodeValue; sTemp:= attribs.Get(i).NodeValue;
datMod.dbPort:= sTemp.ToInteger; datMod.dbPort:= sTemp.ToInteger;
s_dbPort:= sTemp.ToInteger;
end; end;
i:= attribs.IndexOf(sName); i:= attribs.IndexOf(sName);
if (i>-1) then if (i>-1) then
if (attribs.Get(i).NodeValue<>null) then if (attribs.Get(i).NodeValue<>null) then
datMod.dbName:= attribs.Get(i).NodeValue; begin
datMod.dbName:= attribs.Get(i).NodeValue;
s_dbName:= attribs.Get(i).NodeValue;
end;
{$IFDEF DEBUG} {$IFDEF DEBUG}
Writeln('DB: ' + datMod.dbName); Writeln('DB: ' + s_dbName);
{$ENDIF} {$ENDIF}
i:= attribs.IndexOf(sUser); i:= attribs.IndexOf(sUser);
if (i>-1) then if (i>-1) then
if (attribs.Get(i).NodeValue<>null) then if (attribs.Get(i).NodeValue<>null) then
datMod.dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue); begin
datMod.dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue);
s_dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue);
end;
i:= attribs.IndexOf(sPwd); i:= attribs.IndexOf(sPwd);
if (i>-1) then if (i>-1) then
if (attribs.Get(i).NodeValue<>null) then if (attribs.Get(i).NodeValue<>null) then
datMod.dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue); begin
datMod.dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue);
s_dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue);
end;
i:= attribs.IndexOf(sEncConn); i:= attribs.IndexOf(sEncConn);
if (i>-1) then if (i>-1) then
if (attribs.Get(i).NodeValue<>null) then if (attribs.Get(i).NodeValue<>null) then
if (attribs.Get(i).NodeValue='1') then if (attribs.Get(i).NodeValue='1') then
datMod.dbEncConn:= true; begin
datMod.dbEncConn:= true;
s_dbEncConn:= true;
end;
i:= attribs.IndexOf(sSSL); i:= attribs.IndexOf(sSSL);
@@ -2515,6 +2604,8 @@ Writeln('DB: ' + datMod.dbName);
Exit; Exit;
end; end;
initConnOK:= false;
InitConn (sTemp);
verText:= StringReplace(GetFileVersion2(GetModuleName(HInstance)),'.','',[rfReplaceAll]); verText:= StringReplace(GetFileVersion2(GetModuleName(HInstance)),'.','',[rfReplaceAll]);