3063 lines
87 KiB
ObjectPascal
3063 lines
87 KiB
ObjectPascal
unit uWinService;
|
|
|
|
interface
|
|
{$I 'globalDefs.inc'}
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr,
|
|
Vcl.Dialogs, Winapi.ShellAPI, Winapi.ActiveX, IdHTTPWebBrokerBridge, Xml.XmlIntf, Xml.xmldom, Xml.XMLDoc, JsonDataObjects,
|
|
System.IOUtils, System.SyncObjs, IdBaseComponent, IdComponent, IdServerIOHandler, IdSSL, IdHTTP, IdURI,
|
|
IdSSLOpenSSL, IdSSLOpenSSLHeaders, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdException, IdStack,
|
|
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
|
|
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Consts,
|
|
FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
|
|
Neslib.Xml, Neslib.Xml.IO, Neslib.Xml.Types,
|
|
{$IFDEF OMNIThreadLib}
|
|
OtlParallel, OtlCommon, OtlTask, OtlTaskControl, OtlEventMonitor, OtlSync, OtlComm,
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/usesTop.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/usesTop.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/usesTop.inc}
|
|
{$ENDIF}
|
|
flcCipher, Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files,
|
|
uDataMod;
|
|
|
|
|
|
const
|
|
{$I globalConsts.inc}
|
|
|
|
SrvNameConst = 'HDCDZApiService';
|
|
SrvDispNameConst = 'HDC DataZone API Server';
|
|
|
|
eKey2 = '9!81Aq#cU:MCntb6';
|
|
sName = 'DBName';
|
|
eKey1 = 'qe*cX!8k@4WA!gQ5';
|
|
defsFName = 'hdcDZAPIdefs';
|
|
sSSL = 'SSL';
|
|
sServer = 'DBServer';
|
|
sEncConn = 'DBEncConn';
|
|
pwd1 = 'L~4';
|
|
sPortS = 'DBPort';
|
|
pwd2 = 'Qe!r';
|
|
sDZTasksIntZapisHeO = 'DZTasksIntervalZapisHeO';
|
|
sDzKlic = 'DataZoneKey';
|
|
sSSLCert = 'SSLCertFile';
|
|
sHeoPath = 'IniPath';
|
|
sUser = 'DBUser';
|
|
iVect2 = '3r!9q$';
|
|
sPwd = 'DBPwd';
|
|
sLCh = 'licCheck';
|
|
sHeoLic = 'HEOLicence';
|
|
sDZTasksDownURL = 'DZTasksDownloadURL';
|
|
sSSLKey = 'SSLKeyFile';
|
|
iVect1 = 's4W*ERr9';
|
|
sDZTaskIntZapisTypCas = 'DZTaskZapisIntervalTypCas';
|
|
sPort = 'APIPort';
|
|
sCfgComp = 'confComp';
|
|
sHeliosStoreURL = 'HeliosStoreURL';
|
|
sLoginMod = 'JWTAuthMod';
|
|
sDZTasksIntDown = 'DZTasksIntervalDownload';
|
|
cfgFName = 'hdcDZAPIcfg.dat';
|
|
tblHDCDZApiKonfig = '[dbo].[_hdc_DataZone_konfig]';
|
|
|
|
tblPrijataJsonData = '[dbo].[_hdc_ph_PrijataJsonData]';
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
tblOperaceStartStop = '[dbo].[_TabVyroba_OperaceStartStop]';
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/consts.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/consts.inc}
|
|
{$ENDIF}
|
|
|
|
|
|
uqLicMutex = '{77567050-19D8-45EB-B32A-B431079E45AD}';
|
|
MY_MSG_SERVICE_CONTROL = 1;
|
|
|
|
WM_FREE_THREAD1 = WM_APP + 1;
|
|
WM_FREE_THREAD2 = WM_APP + 2;
|
|
WM_FREE_THREAD3 = WM_APP + 3;
|
|
|
|
OPENSSL_LIBS: array of string = ['libeay32.dll', 'ssleay32.dll'];
|
|
|
|
licReq = '<?xml version="1.0" encoding="utf-8"?>'
|
|
+ '<soap12:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap12="http://www.w3.org/2003/05/soap-envelope">'
|
|
+ ' <soap12:Body>'
|
|
+ ' <GetInstallationCode xmlns="http://helios.eu/">'
|
|
+ ' <License>LicenseString</License>'
|
|
+ ' <SysName>HDCDZApi</SysName>'
|
|
+ ' </GetInstallationCode>'
|
|
+ ' </soap12:Body>'
|
|
+ '</soap12:Envelope>';
|
|
|
|
|
|
|
|
|
|
|
|
type
|
|
TSSLEventHandlers = class
|
|
procedure OnGetSSLPassword (var APassword: {$IF CompilerVersion < 27}AnsiString{$ELSE}string{$ENDIF});
|
|
procedure OnQuerySSLPort (APort: Word; var VUseSSL: boolean);
|
|
end;
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/types.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/types.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/types.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/types.inc}
|
|
{$ENDIF}
|
|
|
|
THeoZpracujJSONThread = class(TThread)
|
|
private
|
|
FLock: TCriticalSection;
|
|
FRunning: boolean;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create (AOnTerminate: TNotifyEvent);
|
|
destructor Destroy; override;
|
|
procedure ThreadTerminate;
|
|
end;
|
|
|
|
|
|
|
|
|
|
THeoZapisDZTasksThread = class(TThread)
|
|
private
|
|
FLock: TCriticalSection;
|
|
FRunning: boolean;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create (AOnTerminate: TNotifyEvent);
|
|
destructor Destroy; override;
|
|
procedure ThreadTerminate;
|
|
end;
|
|
|
|
|
|
|
|
TDownDZTasksThread = class(TThread)
|
|
private
|
|
FLock: TCriticalSection;
|
|
fPausedEvent: TEvent;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create (AOnTerminate: TNotifyEvent);
|
|
destructor Destroy; override;
|
|
procedure ThreadTerminate;
|
|
end;
|
|
|
|
|
|
|
|
TKontrolaLicThread = class(TThread)
|
|
private
|
|
FLock: TCriticalSection;
|
|
FHeliosLic: string;
|
|
FLicJeOK: boolean;
|
|
FLicInfo: boolean;
|
|
fPausedEvent: TEvent;
|
|
FMainThreadHandle: NativeUInt;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create (AOnTerminate: TNotifyEvent; heoLic: string);
|
|
destructor Destroy; override;
|
|
procedure ThreadTerminate;
|
|
property LicenceJeOK: boolean read FLicJeOK;
|
|
property MainThreadHandle: NativeUInt read FMainThreadHandle write FMainThreadHandle;
|
|
end;
|
|
|
|
|
|
|
|
THDCDZApiService = class(TService)
|
|
sslHandler: TIdServerIOHandlerSSLOpenSSL;
|
|
FDQuery1: TFDQuery;
|
|
procedure ServiceCreate (Sender: TObject);
|
|
procedure ServiceExecute (Sender: TService);
|
|
procedure ServiceStart (Sender: TService; var Started: Boolean);
|
|
procedure ServiceStop (Sender: TService; var Stopped: Boolean);
|
|
procedure ServiceAfterInstall (Sender: TService);
|
|
procedure ServiceAfterUninstall (Sender: TService);
|
|
procedure ServicePause (Sender: TService; var Paused: Boolean);
|
|
procedure ServiceContinue (Sender: TService; var Continued: Boolean);
|
|
procedure ServiceBeforeUninstall(Sender: TService);
|
|
private
|
|
FServiceNum: integer;
|
|
fServer: TIdHTTPWebBrokerBridge;
|
|
downThr: TDownDZTasksThread;
|
|
licThr: TKontrolaLicThread;
|
|
zapisDZTasksThr: THeoZapisDZTasksThread;
|
|
zpracJsonThr: THeoZpracujJSONThread;
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainPrivs.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainPrivs.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainPrivs.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainPrivs.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
tskLicKontrola: IOmniTaskControl;
|
|
tskZapisDZTasks: IOmniTaskControl;
|
|
tskZpracujJSON: IOmniTaskControl;
|
|
cancelToken: IOmniCancellationToken;
|
|
{$ENDIF}
|
|
fZastavAPI: boolean;
|
|
|
|
procedure GetServiceName;
|
|
procedure GetServiceDisplayName;
|
|
|
|
// fSSLPassword: TSSLEventHandlers;
|
|
function CheckOPENSSLLibs (var useHeoPath: boolean): boolean;
|
|
function Decrypt (const AStr: string): RawByteString;
|
|
function ReturnDecrypted (const AStr: string): string;
|
|
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}
|
|
procedure ZpracujOmniZpravy (const task: IOmniTaskControl; const msg: TOmniMessage);
|
|
procedure UkonciVse;
|
|
procedure OmniZpracujJSON (const task: IOmniTask);
|
|
procedure TaskTerminated (const task: IOmniTaskControl);
|
|
{$ENDIF}
|
|
procedure SQLKontroly;
|
|
procedure SQLDefinice;
|
|
public
|
|
FGlobLicJeOK: Boolean;
|
|
FUninstallMode: Boolean;
|
|
function GetServiceController: TServiceController; override;
|
|
constructor Create (AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
TServiceControlMessage = record
|
|
lic: Boolean;
|
|
// Zde mùžete pøidat další údaje, které chcete poslat
|
|
end;
|
|
|
|
|
|
function ShutdownBlockReasonDestroy(hWnd: HWND): Bool; stdcall; external user32;
|
|
|
|
|
|
|
|
|
|
var
|
|
HDCDZApiService: THDCDZApiService;
|
|
UninstallMode: boolean;
|
|
verText: string;
|
|
testLicTimeout, downDZTasksTimeout: Integer;
|
|
DZTaksZapisTypCas: integer;
|
|
licMutex, licMutexSvc: TMutex;
|
|
sslPwds: TSSLEventHandlers;
|
|
eServDLL: boolean;
|
|
eServPath: string;
|
|
Logger: TLogFileProvider;
|
|
logItem: TLogItem;
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
omniMonitor: TOmniEventMonitor;
|
|
{$ENDIF}
|
|
|
|
dbgStep: integer;
|
|
|
|
heoZapisDZTasks: TCriticalSection;
|
|
tblDZTExistuje: boolean; // existuje tabulka dbo._hdc_DataZone_Tasky ???
|
|
mamTabPrijataData: boolean; // existuje tabulka dbo._hdc_ph_PrijataJsonData ???
|
|
|
|
cfgXML: XML.XmlIntf.IXMLDocument;
|
|
n1: XML.XmlIntf.IXMLNode;
|
|
fName, sslCertFile, sslKeyFile: string;
|
|
apiPort: integer;
|
|
webAuth, urlDZTaskyDown: string;
|
|
|
|
heoLic, apiLic, dataZoneKlic, heoPath, sslLibPath: string;
|
|
s_dbName, s_dbServer, s_dbUser, s_dbPwd: string;
|
|
s_dbPort: integer;
|
|
s_dbEncConn, initConnOK: boolean;
|
|
intGetDZTasks: integer;
|
|
intProcessDZTasksSec: integer;
|
|
jeSSL, jeLoginMod: boolean;
|
|
|
|
rbsTemp: RawByteString;
|
|
|
|
sqlDefinice: TArray<string>;
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/vars.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/vars.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/vars.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/vars.inc}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.StrUtils, System.Win.Registry, System.Variants, IdContext, System.Generics.Collections, System.DateUtils,
|
|
Winapi.WinSvc,
|
|
Web.WebReq, System.Hash, MVCFramework.Commons, MVCFramework.Logger,
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/uses.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/uses.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/uses.inc}
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/uses.inc}
|
|
{$ENDIF}
|
|
helTabsBIDs,
|
|
uWebMod;
|
|
{$R *.DFM}
|
|
|
|
|
|
procedure TSSLEventHandlers.OnGetSSLPassword (var APassword: {$IF CompilerVersion < 27}AnsiString{$ELSE}string{$ENDIF});
|
|
begin
|
|
APassword := '';
|
|
end;
|
|
|
|
procedure TSSLEventHandlers.OnQuerySSLPort(APort: Word; var VUseSSL: boolean);
|
|
begin
|
|
VUseSSL := true;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
function GetLinkerTimestamp: TDateTime;
|
|
begin
|
|
result:= PImageNtHeaders(HInstance + Cardinal(PImageDosHeader(HInstance)^._lfanew))^.FileHeader.TimeDateStamp / SecsPerDay + UnixDateDelta;
|
|
end;
|
|
|
|
|
|
|
|
function GetFileVersion2 (sFileName:string): string;
|
|
var VerInfoSize: DWORD;
|
|
VerInfo: Pointer;
|
|
VerValueSize: DWORD;
|
|
VerValue: PVSFixedFileInfo;
|
|
Dummy: DWORD;
|
|
begin
|
|
VerInfoSize := GetFileVersionInfoSize (PChar(sFileName), Dummy);
|
|
GetMem(VerInfo, VerInfoSize);
|
|
GetFileVersionInfo(PChar(sFileName), 0, VerInfoSize, VerInfo);
|
|
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
|
|
with VerValue^ do
|
|
begin
|
|
Result := IntToStr(dwFileVersionMS shr 16);
|
|
Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
|
|
Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
|
|
Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
|
|
end;
|
|
FreeMem(VerInfo, VerInfoSize);
|
|
end;
|
|
|
|
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/impl.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/impl.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/impl.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/impl.inc}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
constructor THeoZpracujJSONThread.Create (AOnTerminate: TNotifyEvent);
|
|
begin
|
|
inherited Create (false); // Create thread without suspending it
|
|
FLock:= TCriticalSection.Create;
|
|
FRunning:= false;
|
|
// OnTerminate:= AOnTerminate;
|
|
// FreeOnTerminate:= true;
|
|
FreeOnTerminate:= false; // Ensure manual freeing of thread resources
|
|
end;
|
|
|
|
|
|
|
|
|
|
destructor THeoZpracujJSONThread.Destroy;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
Write('Ukoncuji thread ZpracujJSON...');
|
|
{$ENDIF}
|
|
FRunning:= false;
|
|
Terminate;
|
|
FLock.Free;
|
|
inherited;
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
procedure THeoZpracujJSONThread.ThreadTerminate;
|
|
begin
|
|
Terminate;
|
|
WaitFor;
|
|
end;
|
|
|
|
|
|
|
|
procedure THeoZpracujJSONThread.Execute;
|
|
var lSQL, errMsg: string;
|
|
lLoop, lLoopMax, idTask, cnt, koefProCas: Integer;
|
|
logRun: Int64;
|
|
Msg: TMsg;
|
|
mamTabPrijataData, firstRun, inProg, canCont: boolean;
|
|
lQry, lQry2, lQry3: TFDQuery;
|
|
sqlConnX: TFDConnection;
|
|
begin
|
|
lLoop:= 0;
|
|
idTask:= 0;
|
|
logRun:= 0;
|
|
|
|
firstRun:= true;
|
|
inProg:= false;
|
|
canCont:= false;
|
|
|
|
FRunning:= false;
|
|
if not(datMod.SQLTableExists(tblPrijataJsonData)) then
|
|
Exit;
|
|
|
|
mamTabPrijataData:= datMod.SQLTableExists(tblPrijataJsonData);
|
|
|
|
datMod.qryZpracPrijataData.Connection:= datMod.sqlConn;
|
|
|
|
FRunning:= true;
|
|
|
|
koefProCas:= 0; // default vteriny
|
|
case DZTaksZapisTypCas of
|
|
0: koefProCas:= 1;
|
|
1: koefProCas:= 60;
|
|
2: koefProCas:= 3600;
|
|
end;
|
|
lLoopMax:= koefProCas * intProcessDZTasksSec;
|
|
|
|
|
|
try
|
|
while not(Terminated) or not(FRunning) do
|
|
begin
|
|
if (HDCDZApiService<>nil) then
|
|
if (HDCDZApiService.Terminated) then
|
|
begin
|
|
Terminate;
|
|
FRunning:= false;
|
|
end;
|
|
|
|
PeekMessage(&Msg, 0, 0, 0, PM_NOREMOVE);
|
|
if (lLoop=lLoopMax) or (firstRun) then // pri startu a pak dle intervalu z konfigurace, prednastaveno je 120 sek
|
|
begin
|
|
firstRun:= false;
|
|
|
|
try
|
|
if not(inProg) then // nebezi uz ?
|
|
begin
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
if (1=1) then
|
|
{$ELSE}
|
|
if (mamTabPrijataData) then
|
|
{$ENDIF}
|
|
begin
|
|
|
|
// sqlConnX:= TFDConnection.Create(nil);
|
|
// sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
// sqlConnX.Open;
|
|
|
|
if (1=1) then // (sqlConnX.Connected)
|
|
begin
|
|
lSQL := 'SELECT d.ID FROM ' + tblPrijataJsonData + ' d WITH(NOLOCK) WHERE d.Blokovano=0 AND d.DatZpracovani IS NULL';
|
|
lSQL := lSQL + ' AND ISNULL(d.PosledniChyba,N'''')=N'''' AND d.Nezpracovat=0';
|
|
lSQL := lSQL + ' AND d.Blokovano=0 '; // AND ISNULL( (SELECT COUNT(ID) FROM dbo._hdc_ph_Log WHERE LogText=N''Zpracovani API json'' AND IntValue=d.ID), 0)<4';
|
|
lSQL := lSQL + ' ORDER BY d.ID';
|
|
|
|
lQry := TFDQuery.Create(nil);
|
|
lQry2:= TFDQuery.Create(nil);
|
|
// lQry2.Connection:= sqlConnX;
|
|
try
|
|
// lQry.Connection:= sqlConnX;
|
|
lQry.ConnectionName := sqlPoolName;
|
|
lQry2.ConnectionName := sqlPoolName;
|
|
|
|
lQry.Open(lSQL);
|
|
lQry.First;
|
|
|
|
inProg := true;
|
|
|
|
while not(lQry.EOF) do
|
|
begin
|
|
idTask := lQry.FieldByName('ID').asInteger;
|
|
canCont := true;
|
|
|
|
lQry2.Open ('SELECT COUNT(ID) AS Pocet FROM dbo._hdc_ph_Log WITH(NOLOCK) WHERE IntValue=' + idTask.ToString + ' AND LogText LIKE N''%Zpracova%''');
|
|
lQry2.First;
|
|
cnt := lQry2.FieldByName('Pocet').AsInteger;
|
|
if (cnt>3) then
|
|
canCont:= false;
|
|
|
|
if (canCont) then
|
|
begin
|
|
lQry2.ExecSQL('INSERT dbo._hdc_ph_Log (IntValue, LogText) SELECT ' + idTask.ToString + ', N''Zpracovani API json''');
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Zpracovani prijatych JSON dat - idTask ' + idTask.ToString);
|
|
|
|
// LogInfo(Quick.Logger.etError, 'Zpracovani PrijataJSONData ID ' + idTask.ToString);
|
|
try
|
|
lQry2.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Blokovano=1 WHERE ID=' + idTask.ToString);
|
|
lSQL:= '';
|
|
{$IFDEF DEBUG}
|
|
Write ('Zpracovani prijateho JSON id ' + idTask.ToString);
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
lSQL:= 'IF OBJECT_ID(N''dbo.ep_Vyroba_Doklady_Micharna'', N''P'') IS NOT NULL' + CRLF + ' EXEC dbo.ep_Vyroba_Doklady_Micharna @idJson=' + idTask.ToString + CRLF;
|
|
{$ELSE}
|
|
lSQL:= lSQL + 'IF OBJECT_ID(N''dbo.ep_HDCDZApi_ZpracujPrijataData'', N''P'') IS NOT NULL' + CRLF + ' EXEC dbo.ep_HDCDZApi_ZpracujPrijataData @idJson=' + idTask.ToString;
|
|
{$ENDIF}
|
|
lQry2.ExecSQL(lSQL);
|
|
lQry2.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET PosledniChyba=NULL WHERE ID=' + idTask.ToString);
|
|
|
|
{$IFDEF DEBUG}
|
|
Writeln(' - OK');
|
|
{$ENDIF}
|
|
|
|
except on E:Exception do
|
|
begin
|
|
errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString;
|
|
{$IFDEF DEBUG}
|
|
WriteLn ('Chyba zpracovani prijateho JSON id ' + idTask.ToString + ' >> ' + errMsg);
|
|
{$ENDIF}
|
|
lQry2.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET PosledniChyba=N' + errMsg.QuotedString + ' WHERE ID=' + idTask.ToString);
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba evidence start/stop operace PrijataJSONData ID ' + idTask.ToString + ' : ' + errMsg);
|
|
{$ELSE}
|
|
datMod.LogInfo(Quick.Logger.etError, 'Chyba zpracovani PrijataJSONData ID ' + idTask.ToString + ' : ' + errMsg);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
lQry2.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Blokovano=0 WHERE ID=' + idTask.ToString);
|
|
end;
|
|
lQry.Next;
|
|
end;
|
|
finally
|
|
lQry2.Close;
|
|
FreeAndNil (lQry2);
|
|
lQry.Close;
|
|
FreeAndNil (lQry);
|
|
end;
|
|
|
|
inProg:= false;
|
|
end; // sql Connected
|
|
if Assigned(sqlConnx) then
|
|
sqlConnX.Free;
|
|
|
|
end;
|
|
end;
|
|
|
|
except on E:Exception do
|
|
begin
|
|
inProg:= false;
|
|
errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString;
|
|
if (mamTabPrijataData) then
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba zpracovani prijatych JSON dat ID ' + idTask.ToString + ' : ' + errMsg);
|
|
end;
|
|
end;
|
|
|
|
|
|
lLoop:= 0;
|
|
end;
|
|
Inc (lLoop);
|
|
Sleep (998);
|
|
end;
|
|
finally
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
constructor THeoZapisDZTasksThread.Create (AOnTerminate: TNotifyEvent);
|
|
begin
|
|
inherited Create (false);
|
|
FLock:= TCriticalSection.Create;
|
|
FRunning:= false;
|
|
// OnTerminate:= AOnTerminate;
|
|
FreeOnTerminate:= false; // Ensure manual freeing of thread resources
|
|
end;
|
|
|
|
|
|
|
|
procedure THeoZapisDZTasksThread.ThreadTerminate;
|
|
begin
|
|
Terminate;
|
|
WaitFor;
|
|
end;
|
|
|
|
|
|
destructor THeoZapisDZTasksThread.Destroy;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Ukoncuji thread ZapisDZTasks...');
|
|
{$ENDIF}
|
|
FRunning:= false;
|
|
Terminate;
|
|
FLock.Free;
|
|
inherited;
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
procedure THDCDZApiService.OmniZpracujJSON (const task: IOmniTask);
|
|
var lSQL, errMsg: string;
|
|
i, idTask, typTasku, idMzdy, lLoop, zapsano: integer;
|
|
jeKoop: boolean;
|
|
lQry, lQry2: TFDQuery;
|
|
canCont, firstRun: boolean;
|
|
Msg: TMsg;
|
|
begin
|
|
while not(task.Terminated) do
|
|
begin
|
|
if (task.CancellationToken.IsSignalled) then
|
|
task.Terminate;
|
|
PeekMessage (&Msg, 0, 0, 0, PM_NOREMOVE);
|
|
Sleep(5000);
|
|
task.Terminate;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
|
|
procedure THeoZapisDZTasksThread.Execute;
|
|
var lSQL, errMsg: string;
|
|
i, idTask, typTasku, idMzdy, lLoop, zapsano: integer;
|
|
jeKoop: boolean;
|
|
lQry, lQry2: TFDQuery;
|
|
sqlConnX, sqlConnX2: TFDConnection;
|
|
canCont, firstRun: boolean;
|
|
Msg: TMsg;
|
|
begin
|
|
|
|
firstRun:= true;
|
|
|
|
canCont:= true;
|
|
i:= 0;
|
|
lLoop:= 1;
|
|
|
|
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
|
|
|
|
lQry:= TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection:= sqlConnX;
|
|
lSQL:= 'DECLARE @i INT=0' + CRLF + 'IF OBJECT_ID(N' + tblDZTasky.Replace('[','').Replace(']','').QuotedString + ', N''U'') IS NOT NULL SET @i=1' + CRLF + 'SELECT @i AS TabTest';
|
|
lQry.Open(lSQL);
|
|
if (lQry.RecordCount=1) then
|
|
i:= lQry.FieldByName('TabTest').AsInteger
|
|
else
|
|
canCont:= false;
|
|
if (i=0) then
|
|
canCont:= false;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
|
|
idTask:= 0;
|
|
|
|
if (canCont) then
|
|
begin
|
|
try
|
|
while not (Terminated) do
|
|
begin
|
|
|
|
if (HDCDZApiService<>nil) then
|
|
if (HDCDZApiService.Terminated) then
|
|
Terminate;
|
|
|
|
PeekMessage(&Msg, 0, 0, 0, PM_NOREMOVE);
|
|
|
|
// LogInfo(Quick.Logger.etInfo, 'Pokus o evidenci nezapsaných DZ Taskù / lLoop ' + lLoop.ToString);
|
|
if (lLoop>2*60) or (firstRun) then // zapis kazde 2 minuty
|
|
begin
|
|
|
|
sqlConnX2:= TFDConnection.Create(nil);
|
|
sqlConnX2.ConnectionDefName:= sqlPoolName;
|
|
|
|
// FLock.Enter;
|
|
if (firstRun) then
|
|
firstRun:= false;
|
|
|
|
try
|
|
lQry:= TFDQuery.Create(nil);
|
|
lQry.Connection:= sqlConnX;
|
|
|
|
lQry2:= TFDQuery.Create(nil);
|
|
lQry2.Connection:= sqlConnX2;
|
|
|
|
|
|
lSQL:= 'SELECT ID, Kooperace, Typ FROM ' + tblDZTasky + ' WHERE Nezpracovavat=0 AND DatZpracovani IS NULL AND DATEDIFF(day, DatPorizeni, GETDATE())<4 ORDER BY ID';
|
|
lQry.Open(lSQL);
|
|
if (lQry.RecordCount>0) then
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pokus o evidenci nezapsanych DZ Tasku, pocet ' + lQry.RecordCount.ToString);
|
|
lQry.First;
|
|
|
|
zapsano:= 0;
|
|
|
|
while not(lQry.Eof) do
|
|
begin
|
|
idMzdy:= 0;
|
|
idTask:= lQry.FieldByName('ID').AsInteger;
|
|
typTasku:= lQry.FieldByName('Typ').AsInteger;
|
|
jeKoop:= lQry.FieldByName('Kooperace').AsBoolean;
|
|
|
|
if (typTasku>0) then // nedefinovane prijate JSON maji typTasku=0
|
|
begin
|
|
if (jeKoop) then
|
|
begin // vytvoreni kooperacni objednavky (pro Koramex)
|
|
|
|
{$IFDEF CUSTOM_CTRL_Koramex}
|
|
lSQL:= 'IF OBJECT_ID(N''dbo.ep_HDC_DataZone_Vyroba_VytvorKoopObjednavku'', N''P'') IS NOT NULL EXEC dbo.ep_HDC_DataZone_Vyroba_VytvorKoopObjednavku @idTask=' + idTask.ToString;
|
|
try
|
|
sqlConnX.ExecSQL(lSQL);
|
|
except on E:Exception do
|
|
sqlConnX.ExecSQL('UPDATE ' + tblDZTasky + ' SET PosledniChyba=N' + QuotedStr('Chyba vytvareni koopObj: ' + E.Message) + ' WHERE ID=' + idTask.ToString);
|
|
end;
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
lSQL:= 'DECLARE @errMsg NVARCHAR(500)=N'''', @idMzdy INT, @idVPr INT, @dokl INT, @alt NCHAR(1), @datStart DATETIME, @datKonec DATETIME, @ksOdv NUMERIC(19,6), @ksZmet NUMERIC(19,6)'
|
|
+ ', @ksZmetNeopr NUMERIC(19,6), @idZ INT, @cisZ INT, @idPrac INT, @bc NVARCHAR(20), @i INT=' + idTask.ToString + CRLF
|
|
+ 'SELECT @idVPr=IDPrikaz, @dokl=DokladPrP, @alt=AltPrP, @datStart=DatumStart, @datKonec=DatumKonec, @ksOdv=kusy_odv, @ksZmet=Kusy_zmet_opr, @ksZmetNeopr=Kusy_zmet_neopr'
|
|
+ ', @idZ=ZamestnanecID, @cisZ=Zamestnanec, @idPrac=IDPracoviste, @bc=BarCode FROM ' + tblDZTasky + ' WHERE ID=@i' + CRLF
|
|
+ 'IF (ISNULL(@bc,N'''')<>N'''') AND (@idVPr IS NULL OR @dokl IS NULL)' + CRLF
|
|
+ ' SELECT TOP(1) @idVPr=IDPrikaz, @dokl=Doklad, @alt=Alt, @idPrac=pracoviste FROM ' + tblPrPost + ' WHERE IDOdchylkyDo IS NULL AND BarCode=@bc' + CRLF
|
|
+ 'IF (@idZ IS NULL) AND (@cisZ IS NOT NULL) SELECT @idZ=ID FROM ' + tblCZam + ' WHERE Cislo=@cisZ' + CRLF + 'BEGIN TRY' + CRLF
|
|
+ 'EXEC @idMzdy=dbo.hp_EvidenceOperace @IDPrikaz=@idVPr, @Doklad=@dokl, @Alt=@alt, @Datum=@datStart, @Kusy_odv=@ksOdv, @kusy_zmet_opr=@ksZmet, @kusy_zmet_neopr=@ksZmetNeopr'
|
|
+ ', @DatumZahajeniOp=@datStart, @DatumUkonceniOp=@datKonec, @IDZam=@idZ, @IDPracoviste=@idPrac, @Stav=1' + CRLF + 'END TRY' + CRLF + 'BEGIN CATCH' + CRLF
|
|
+ 'SET @errMsg=ERROR_MESSAGE()' + CRLF + 'END CATCH' + CRLF + 'SELECT ISNULL(@idMzdy,0) AS IDMzdy, @errMsg AS ErrMsg';
|
|
// LogInfo(Quick.Logger.etInfo, CRLF + lSQL + CRLF);
|
|
|
|
try
|
|
lQry2.Open(lSQL);
|
|
if (lQry2.RecordCount=1) then
|
|
begin
|
|
idMzdy:= lQry2.FieldByName('IDMzdy').AsInteger;
|
|
errMsg:= lQry2.FieldByName('ErrMsg').AsString;
|
|
end
|
|
else
|
|
begin
|
|
errMsg:= 'Evidence mzdy se nezdaøila, zkuste ji zaevidovat rucne';
|
|
idMzdy:= 0;
|
|
end;
|
|
lQry2.Close;
|
|
if (idMzdy=0) then
|
|
begin
|
|
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET NovyZaznam=0, PosledniChyba=N' + errMsg.QuotedString + ' WHERE ID=' + idTask.ToString);
|
|
if (errMsg.Contains('2000735')) then
|
|
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET PosledniChyba=N''(2000735) ID/barcode neodpovídá výrobní operaci'', DatZpracovani=GETDATE() WHERE ID=' + idTask.ToString);
|
|
if (errMsg.Contains('2000742')) then
|
|
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET PosledniChyba=N''(2000742) Není zadán zamìstnanec'', DatZpracovani=GETDATE() WHERE ID=' + idTask.ToString);
|
|
end
|
|
else
|
|
begin
|
|
Inc(zapsano);
|
|
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET NovyZaznam=0, IDMzdy=' + idMzdy.ToString + ', PosledniChyba=N'''', DatZpracovani=GETDATE() WHERE ID=' + idTask.ToString);
|
|
end;
|
|
except on E:Exception do
|
|
begin
|
|
errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString;
|
|
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET NovyZaznam=0, PosledniChyba=N' + errMsg.QuotedString + ' WHERE ID=' + idTask.ToString);
|
|
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba evidence DataZone tasku ID ' + idTask.ToString + ' : ' + E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
end; // typTasku>0
|
|
|
|
lQry.Next; // dalsi task
|
|
end;
|
|
|
|
if (zapsano>0) then
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Evidence DataZone tasku ID ' + idTask.ToString + ' - zapsano ' + zapsano.ToString + ' operaci');
|
|
|
|
|
|
lQry.Free;
|
|
lQry2.Free;
|
|
except on E:Exception do
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba evidence DataZone tasku ID ' + idTask.ToString + ' : ' + E.Message);
|
|
end;
|
|
end;
|
|
// FLock.Leave;
|
|
lLoop:= 0;
|
|
|
|
sqlConnX2.Close;
|
|
sqlConnX2.Free;
|
|
|
|
end;
|
|
Inc(lLoop);
|
|
Sleep(1000);
|
|
end;
|
|
finally
|
|
end;
|
|
end;
|
|
|
|
sqlConnX.Close;
|
|
sqlConnX.Free;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
constructor TKontrolaLicThread.Create (AOnTerminate: TNotifyEvent; heoLic: string);
|
|
begin
|
|
inherited Create (false);
|
|
FLock:= TCriticalSection.Create;
|
|
FreeOnTerminate:= false;
|
|
// OnTerminate:= AOnTerminate;
|
|
FHeliosLic:= heoLic;
|
|
FLicJeOK:= false;
|
|
end;
|
|
|
|
|
|
procedure TKontrolaLicThread.ThreadTerminate;
|
|
begin
|
|
Terminate;
|
|
WaitFor;
|
|
end;
|
|
|
|
|
|
destructor TKontrolaLicThread.Destroy;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Ukoncuji thread KontrolaLic...');
|
|
{$ENDIF}
|
|
FLock.Free;
|
|
inherited;
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TKontrolaLicThread.Execute;
|
|
var req, resp, licReqL, kodResp: string;
|
|
reqBody: TStream;
|
|
i: integer;
|
|
intLoop: integer;
|
|
hc: TIdHTTP;
|
|
Msg: TMsg;
|
|
zkontrolovatLic: boolean;
|
|
pocetKontrol: integer;
|
|
ho: byte;
|
|
begin
|
|
|
|
licReqL:= '';
|
|
FLicInfo:= false;
|
|
i:= -1;
|
|
|
|
intLoop:= 1;
|
|
|
|
zkontrolovatLic:= true;
|
|
pocetKontrol:= 0;
|
|
|
|
while not (Terminated) do
|
|
begin
|
|
|
|
PeekMessage(&Msg, 0, 0, 0, PM_NOREMOVE);
|
|
|
|
// kontrola licence kazdy den v 9 hodin
|
|
ho:= HourOf(Now);
|
|
if not(zkontrolovatLic) and (ho=9) and (pocetKontrol=0) then
|
|
zkontrolovatLic:= true;
|
|
if (ho<>9) then
|
|
pocetKontrol:= 0;
|
|
|
|
|
|
if (zkontrolovatLic) then
|
|
begin
|
|
hc:= TIdHTTP.Create(nil);
|
|
try
|
|
try
|
|
hc.Request.Accept:= 'application/soap+xml';
|
|
hc.HTTPOptions:= hc.HTTPOptions + [hoKeepOrigProtocol] + [hoNoProtocolErrorException];
|
|
hc.Request.ContentType:= 'application/soap+xml; charset=utf-8';
|
|
{$IFDEF DEBUG}
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Dotaz na licenci...');
|
|
{$ENDIF}
|
|
licReqL:= licReq.Replace('LicenseString', FHeliosLic);
|
|
reqBody:= TStringStream.Create(licReqL, TEncoding.UTF8);
|
|
resp:= hc.Post(webAuth, reqBody);
|
|
{$IFDEF DEBUG}
|
|
datMod.LogInfo(Quick.Logger.etInfo, 'Mam data o licenci...');
|
|
{$ENDIF}
|
|
if (resp.Contains('<GetInstallationCodeResult>')) then
|
|
begin
|
|
kodResp:= Trim(MidStr(resp, Pos('<GetInstallationCodeResult>', resp)+27, 6));
|
|
if (kodResp<>'') then
|
|
if not(TryStrToInt('$'+kodResp, i)) then
|
|
i:= -1;
|
|
end
|
|
else
|
|
begin
|
|
FLicJeOK:= false;
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba kontroly licence - HDCDZApi zrejme neni licencovano');
|
|
i:= -1;
|
|
end;
|
|
zkontrolovatLic:= false;
|
|
Inc(pocetKontrol);
|
|
except on E:Exception do
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba kontroly licence: ' + E.Message); // + licReqL;
|
|
i:= -1;
|
|
end;
|
|
end;
|
|
|
|
if (i=-1) and (datMod.chL) then
|
|
Terminate;
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Lic RespCode - ' + i.ToString);
|
|
|
|
FLicJeOK:= (i>0);
|
|
if not(datMod.chL) then
|
|
FLicJeOK:= true;
|
|
|
|
if not(FLicJeOK) then
|
|
begin
|
|
// zkus vytvorit mutex signalizujici neplatnou licenci, na to nepotrebujes zadna Win bezpecnostni prava
|
|
licMutex:= TMutex.Create(nil, True, uqLicMutex);
|
|
end;
|
|
|
|
except on E:Exception do
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba kontroly licence (2): ' + E.Message + CRLF + licReqL);
|
|
Terminate;
|
|
end;
|
|
end;
|
|
hc.Free;
|
|
intLoop:= 0;
|
|
end;
|
|
|
|
Sleep(999);
|
|
Inc(intLoop);
|
|
end;
|
|
|
|
{$IFDEF DEBUG}
|
|
Writeln('Sluzba kontroly licence ukoncena');
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
constructor TDownDZTasksThread.Create (AOnTerminate: TNotifyEvent);
|
|
begin
|
|
inherited Create (false);
|
|
FLock:= TCriticalSection.Create;
|
|
// OnTerminate:= AOnTerminate;
|
|
FreeOnTerminate:= false;
|
|
end;
|
|
|
|
|
|
procedure TDownDZTasksThread.ThreadTerminate;
|
|
begin
|
|
Terminate;
|
|
WaitFor;
|
|
end;
|
|
|
|
|
|
destructor TDownDZTasksThread.Destroy;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
Write('Ukoncuji thread DownDZTasks...');
|
|
{$ENDIF}
|
|
FLock.Free;
|
|
inherited;
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TDownDZTasksThread.Execute;
|
|
var lSQL, jsonData, strTmp, strTmp2: string;
|
|
hc: TIdHTTP;
|
|
j: TJSONObject;
|
|
i: integer;
|
|
intLoop: integer;
|
|
sqlConnX: TFDConnection;
|
|
begin
|
|
intLoop:= 1;
|
|
|
|
while not Terminated do
|
|
begin
|
|
if (intLoop>=intGetDZTasks*60*999) then
|
|
begin
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
|
|
hc:= TIdHTTP.Create(nil);
|
|
try
|
|
hc.Request.BasicAuthentication := False;
|
|
hc.Request.CustomHeaders.Clear;
|
|
hc.Request.CustomHeaders.Values['DataZoneKey']:= dataZoneKlic;
|
|
jsonData:= hc.Get(urlDZTaskyDown);
|
|
|
|
if (jsonData<>'') then
|
|
begin
|
|
j:= TJsonObject.Parse(jsonData) as TJsonObject;
|
|
if (j<>nil) then
|
|
begin
|
|
{
|
|
logItem.EventType:= etInfo;
|
|
logItem.EventDate:= now;
|
|
logItem.Msg:= 'Start downloading DZ tasks...';
|
|
Logger.WriteLog(logItem);
|
|
}
|
|
|
|
i:= 0;
|
|
while not(Terminated) and (i<=j['tasks'].Count-1) do
|
|
begin
|
|
strTmp:= j['tasks'].Items[i].S['startedAt'];
|
|
if (strTmp<>'') then
|
|
strTmp:= MidStr(strTmp, 9, 2) + '.' + MidStr(strTmp, 6, 2) + '.' + LeftStr(strTmp, 4) + ' ' + MidStr(strTmp, 12, 8);
|
|
|
|
strTmp2:= j['tasks'].Items[i].S['finishedAt'];
|
|
if (strTmp2<>'') then
|
|
strTmp2:= MidStr(strTmp2, 9, 2) + '.' + MidStr(strTmp2, 6, 2) + '.' + LeftStr(strTmp2, 4) + ' ' + MidStr(strTmp2, 12, 8);
|
|
|
|
lSQL:= 'IF OBJECT_ID(N''dbo._hdc_DataZone_Tasky'', N''U'') IS NOT NULL' + CRLF
|
|
+ 'IF NOT EXISTS (SELECT 1 FROM ' + tblDZTasky + ' WHERE IdDataZoneTaskID=' + j['tasks'].Items[i].S['id'] + ')' + CRLF
|
|
+ 'INSERT ' + tblDZTasky + ' (IdDataZoneTaskID, Kooperace, DeviceID, Obsah, StatusText, DatumStart, DatumKonec)'
|
|
+ ' SELECT ' + j['tasks'].Items[i].S['id'] + ', ' + j['tasks'].Items[i].BoolValue.ToString(false)
|
|
+ ', N'+ IfThen(j['tasks'].Items[i].S['machine']='', 'ULL', j['tasks'].Items[i].S['machine'].QuotedString) + ', CONVERT(varchar(max), N' + jsonData.QuotedString + ')'
|
|
+ ', N' + j['tasks'].Items[i].S['status'].QuotedString + ', ' + IfThen(strTmp<>'',' CONVERT(datetime, N' + strTmp.QuotedString + ', 104)', 'NULL')
|
|
+ ', ' + IfThen(strTmp2<>'',' CONVERT(datetime, N' + strTmp2.QuotedString + ', 104)', 'NULL');
|
|
sqlConnX.ExecSQL(lSQL);
|
|
i:= i+1;
|
|
end;
|
|
end;
|
|
end;
|
|
except on E:Exception do
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba nacitani DataZone tasku: ' + E.Message);
|
|
end;
|
|
hc.Free;
|
|
intLoop:= 0;
|
|
|
|
sqlConnX.Close;
|
|
sqlConnX.Free;
|
|
|
|
end;
|
|
|
|
Sleep(1000);
|
|
Inc(intLoop);
|
|
end;
|
|
|
|
{$IFDEF DEBUG}
|
|
Writeln('Sluzba zapisu DataZone tasku ukoncena');
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
procedure ServiceController (CtrlCode: DWord); stdcall;
|
|
begin
|
|
HDCDZApiService.Controller(CtrlCode);
|
|
end;
|
|
|
|
|
|
|
|
|
|
function THDCDZApiService.Encrypt (const AStr: string): RawByteString;
|
|
begin
|
|
result:= flcCipher.Encrypt(ctRC4, cmECB, cpNone, 256, RawByteString(eKey1+eKey2), RawByteString(AStr), iVect1+iVect2);
|
|
end;
|
|
|
|
|
|
|
|
function THDCDZApiService.ReturnEncrypted (const AStr: string): string;
|
|
function String2Hex(const Buffer: AnsiString): string;
|
|
begin
|
|
SetLength(Result, Length(Buffer) * 2);
|
|
BinToHex(PAnsiChar(Buffer), PChar(Result), Length(Buffer));
|
|
end;
|
|
begin
|
|
result:= '';
|
|
if (AStr<>'') then
|
|
result:= String2Hex(Encrypt(AStr));
|
|
end;
|
|
|
|
|
|
|
|
function THDCDZApiService.Decrypt (const AStr: string): RawByteString;
|
|
begin
|
|
result:= flcCipher.Decrypt(ctRC4, cmECB, cpNone, 256, RawByteString(eKey1+eKey2), RawByteString(AStr), iVect1+iVect2);
|
|
end;
|
|
|
|
|
|
|
|
function THDCDZApiService.ReturnDecrypted (const AStr: string): string;
|
|
var i: integer;
|
|
sText, AStrTemp, sVal, sVal2: string;
|
|
sTemp: RawByteString;
|
|
y, x: integer;
|
|
function Hex2String(const Buffer: string): AnsiString;
|
|
begin
|
|
SetLength(Result, Length(Buffer) div 2);
|
|
HexToBin(PChar(Buffer), PAnsiChar(Result), Length(Result));
|
|
end;
|
|
begin
|
|
result:= '';
|
|
sTemp:= '';
|
|
AStrTemp:= AStr.Trim;
|
|
i:= (Length(AStrTemp) div 2);
|
|
for i:=0 to (Length(AStr) div 2)-1 do
|
|
begin
|
|
if (Length(AStrTemp)>1) then
|
|
begin
|
|
sVal:= LeftStr(AStrTemp, 2);
|
|
AStrTemp:= MidStr(AStrTemp, 3, 65535);
|
|
if (AStrTemp.Length>1) then
|
|
begin
|
|
sVal2:= LeftStr(AStrTemp, 2);
|
|
if not(TryStrToInt('$' + sVal2, x)) then
|
|
x:= -1;
|
|
end;
|
|
if (x>-1) then
|
|
begin
|
|
// sVal:= Copy(AStr, (i*2)+1, 2);
|
|
y:= StrToInt('$' + sVal);
|
|
sTemp:= sTemp + AnsiChar(y);
|
|
end;
|
|
end;
|
|
end;
|
|
if (sTemp<>'') then
|
|
result:= Decrypt(sTemp);
|
|
end;
|
|
|
|
|
|
|
|
|
|
function THDCDZApiService.GetServiceController: TServiceController;
|
|
begin
|
|
result:= ServiceController;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceCreate (Sender: TObject);
|
|
var r: TRegistry;
|
|
k, vn, imgPath: string;
|
|
openRes: boolean;
|
|
i: integer;
|
|
canCont: boolean;
|
|
begin
|
|
|
|
|
|
if (UninstallMode) then
|
|
begin
|
|
k:= '\SOFTWARE\HDConsultingCZ';
|
|
r:= TRegistry.Create (KEY_READ or KEY_WRITE);
|
|
try
|
|
i:= 1;
|
|
canCont:= true;
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
if (r.KeyExists(k)) then
|
|
if (r.OpenKey(k, false)) then
|
|
begin
|
|
while (canCont) and (i<21) do
|
|
begin
|
|
vn:= SrvNameConst + i.ToString;
|
|
if (r.ValueExists(vn)) then
|
|
begin
|
|
imgPath:= r.ReadString(vn);
|
|
if (imgPath=ParamStr(0)) then
|
|
canCont:= false
|
|
else
|
|
Inc(i);
|
|
end
|
|
else
|
|
Inc(i);
|
|
end;
|
|
FServiceNum:= i;
|
|
end;
|
|
r.CloseKey;
|
|
finally
|
|
r.Free;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
// if not(Application.Installing) then
|
|
// begin
|
|
k:= '\SOFTWARE\HDConsultingCZ';
|
|
r:= TRegistry.Create (KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
|
|
if (r.OpenKey(k, true)) then
|
|
begin
|
|
FServiceNum:= 1;
|
|
canCont:= true;
|
|
while (canCont) and (FServiceNum<21) do
|
|
begin
|
|
if not(r.ValueExists(SrvNameConst + FServiceNum.ToString)) then
|
|
canCont:= false
|
|
else
|
|
Inc(FServiceNum);
|
|
end;
|
|
end;
|
|
r.CloseKey;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
end;
|
|
|
|
GetServiceName;
|
|
GetServiceDisplayName;
|
|
|
|
if (WebRequestHandler<>nil) then
|
|
WebRequestHandler.WebModuleClass:= WebModuleClass;
|
|
// end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceAfterInstall (Sender: TService);
|
|
var r: TRegistry;
|
|
k, imgPath: string;
|
|
begin
|
|
|
|
k:= '\SOFTWARE\HDConsultingCZ';
|
|
r:= TRegistry.Create (KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
if (r.OpenKey(k, true)) then
|
|
r.WriteString(Self.Name, ParamStr(0));
|
|
r.CloseKey;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
|
|
|
|
k:= '\SYSTEM\CurrentControlSet\Services\' + Self.Name;
|
|
r:= TRegistry.Create(KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey := HKEY_LOCAL_MACHINE;
|
|
if r.OpenKey(k, true) then
|
|
begin
|
|
r.WriteString('Description', 'HDC-DataZone API komunikator');
|
|
imgPath:= ParamStr(0) + ' /name "' + Self.Name + '"';
|
|
r.WriteString('ImagePath', imgPath);
|
|
r.CloseKey;
|
|
end;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
|
|
|
|
k:= '\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + Self.Name;
|
|
r:= TRegistry.Create(KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
if r.OpenKey(k, True) then
|
|
begin
|
|
r.WriteString('EventMessageFile', ParamStr(0));
|
|
r.WriteInteger('TypesSupported', 7);
|
|
r.CloseKey;
|
|
end;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceAfterUninstall (Sender: TService);
|
|
var r: TRegistry;
|
|
k: string;
|
|
begin
|
|
k:= '\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + Self.Name;
|
|
r:= TRegistry.Create(KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey := HKEY_LOCAL_MACHINE;
|
|
if r.KeyExists(k) then
|
|
r.DeleteKey(k);
|
|
finally
|
|
r.Free;
|
|
end;
|
|
|
|
k:= '\SOFTWARE\HDConsultingCZ';
|
|
r:= TRegistry.Create (KEY_READ or KEY_WRITE);
|
|
try
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
if (r.KeyExists(k)) then
|
|
if (r.OpenKey(k, false)) then
|
|
if (r.ValueExists(Self.Name)) then
|
|
r.DeleteValue(Self.Name);
|
|
r.CloseKey;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceBeforeUninstall (Sender: TService);
|
|
var r: TRegistry;
|
|
k, vn, ip: string;
|
|
i: integer;
|
|
canCont: Boolean;
|
|
begin
|
|
k:= '\SOFTWARE\HDConsultingCZ';
|
|
r:= TRegistry.Create (KEY_READ or KEY_WRITE);
|
|
try
|
|
i:= 1;
|
|
canCont:= true;
|
|
r.RootKey:= HKEY_LOCAL_MACHINE;
|
|
if (r.KeyExists(k)) then
|
|
if (r.OpenKey(k, false)) then
|
|
begin
|
|
while (canCont) and (i<21) do
|
|
begin
|
|
vn:= SrvNameConst + i.ToString;
|
|
if (r.ValueExists(vn)) then
|
|
begin
|
|
ip:= r.ReadString(vn);
|
|
if (ip=ParamStr(0)) then
|
|
canCont:= false
|
|
else
|
|
Inc(i);
|
|
end
|
|
else
|
|
Inc(i);
|
|
end;
|
|
FServiceNum:= i;
|
|
GetServiceName;
|
|
GetServiceDisplayName;
|
|
end;
|
|
r.CloseKey;
|
|
finally
|
|
r.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceContinue (Sender: TService; var Continued: Boolean);
|
|
begin
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainSvcCont.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainSvcCont.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainSvcCont.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainSvcCont.inc}
|
|
{$ENDIF}
|
|
|
|
if (zapisDZTasksThr<>nil) then
|
|
if (zapisDZTasksThr.Suspended) then
|
|
zapisDZTasksThr.Resume;
|
|
|
|
if (downThr<>nil) then
|
|
if (downThr.Suspended) then
|
|
downThr.Resume;
|
|
|
|
if (licThr<>nil) then
|
|
if (licThr.Suspended) then
|
|
licThr.Resume;
|
|
|
|
Continued:= true;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
procedure THDCDZApiService.TaskTerminated (const task: IOmniTaskControl);
|
|
var exitCode: integer;
|
|
begin
|
|
exitCode:= task.ExitCode;
|
|
Self.Stop;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceExecute (Sender: TService);
|
|
var aktTimeoutLic, aktZapisDZTasks: integer;
|
|
s: Boolean;
|
|
msg: TMsg;
|
|
m: TMessage;
|
|
Started: boolean;
|
|
i, licRetry: integer;
|
|
licMutexErr: Integer;
|
|
begin
|
|
|
|
// PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
|
|
|
|
if Application.DelayInitialize then
|
|
Application.Initialize;
|
|
Started:= True;
|
|
|
|
|
|
fZastavAPI:= false;
|
|
|
|
|
|
FGlobLicJeOK:= true;
|
|
while (not Terminated) and not(fZastavAPI) do
|
|
begin
|
|
|
|
|
|
licMutexErr:= 0;
|
|
// zkus vytvorit mutex, na to nepotrebujes zadna bezpecnostni prava
|
|
licMutexSvc:= TMutex.Create(nil, True, uqLicMutex);
|
|
// byl vytvoren ?
|
|
licMutexErr:= GetLastError;
|
|
// pokud mutex uz existuje, je to indikace chyby licence, tak sluzbu zastav
|
|
if (licMutexErr <> ERROR_SUCCESS) then
|
|
FGlobLicJeOK:= false
|
|
else
|
|
if (Assigned(licMutexSvc)) then
|
|
FreeAndNil(licMutexSvc);
|
|
|
|
|
|
|
|
if (Assigned(ServiceThread)) then
|
|
ServiceThread.ProcessRequests (false);
|
|
TThread.Sleep(998);
|
|
|
|
if (licThr<>nil) then
|
|
if not(licThr.Started) then
|
|
begin
|
|
licThr.Start;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby testu licence');
|
|
end;
|
|
|
|
|
|
if (zapisDZTasksThr<>nil) then
|
|
if not(zapisDZTasksThr.Started) then
|
|
begin
|
|
zapisDZTasksThr.Start;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby zapisu DataZone tasku');
|
|
end;
|
|
|
|
|
|
if not(FGlobLicJeOK) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Chybna Helios licence');
|
|
self.ServiceStop (Sender, s);
|
|
end;
|
|
|
|
|
|
if (zpracJsonThr<>nil) then
|
|
if not(zpracJsonThr.Started) then
|
|
begin
|
|
zpracJsonThr.Start;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby zpracovani JSON zprav - pocet ' + datMod.SQLGetString('SELECT COUNT(ID) FROM ' + tblPrijataJsonData + ' WHERE DatZpracovani IS NULL'));
|
|
end;
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainSvcExec.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainSvcExec.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainSvcExec.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainSvcExec.inc}
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
|
if Assigned(licMutexSvc) then
|
|
FreeAndNil(licMutexSvc);
|
|
if Assigned(licMutex) then
|
|
FreeAndNil(licMutex);
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServicePause (Sender: TService; var Paused: Boolean);
|
|
begin
|
|
if (zapisDZTasksThr<>nil) then
|
|
if not(zapisDZTasksThr.Suspended) then
|
|
zapisDZTasksThr.Suspend;
|
|
|
|
if (downThr<>nil) then
|
|
if not(downThr.Suspended) then
|
|
downThr.Suspend;
|
|
|
|
if (licThr<>nil) then
|
|
if not(licThr.Suspended) then
|
|
licThr.Suspend;
|
|
|
|
if (zpracJsonThr<>nil) then
|
|
if not(zpracJsonThr.Suspended) then
|
|
zpracJsonThr.Suspend;
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainSvcPause.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainSvcPause.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainSvcPause.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainSvcPause.inc}
|
|
{$ENDIF}
|
|
|
|
Paused:= True;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.GetServiceDisplayName;
|
|
var ServiceDisplayName : String;
|
|
begin
|
|
// if not FindCmdLineSwitch('display', ServiceDisplayName) then
|
|
// raise Exception.Create('Prosim specifikujte zobrazovany nazev sluzby pomoci parametru /display');
|
|
// DisplayName:= ServiceDisplayName;
|
|
if FindCmdLineSwitch('display', ServiceDisplayName) then
|
|
begin
|
|
DisplayName:= ServiceDisplayName.Trim;
|
|
if (DisplayName='') then
|
|
raise Exception.Create('Prosim specifikujte zobrazovany nazev sluzby pomoci parametru /display');
|
|
end
|
|
else
|
|
DisplayName:= SrvDispNameConst + ' (' + IntToStr(FServiceNum) + ')';
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.GetServiceName;
|
|
var ServiceName : String;
|
|
begin
|
|
// if not FindCmdLineSwitch('name', ServiceName) then
|
|
// raise Exception.Create('Prosim specifikujte nazev sluzby pomoci parametru /name');
|
|
// Name:= ServiceName.Trim;
|
|
|
|
if (FindCmdLineSwitch('name', ServiceName)) then
|
|
begin
|
|
Name:= ServiceName.Trim;
|
|
if (Name='') then
|
|
raise Exception.Create('Prosim specifikujte nazev sluzby pomoci parametru /name');
|
|
end
|
|
else
|
|
Name:= SrvNameConst + IntToStr(FServiceNum);
|
|
end;
|
|
|
|
|
|
|
|
|
|
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;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function THDCDZApiService.ReadConfig (var errMsg: string): boolean;
|
|
var xN1: TXmlNode;
|
|
i: integer;
|
|
s, sTemp: string;
|
|
fs: TFileStream;
|
|
attribs: IXMLNodeList;
|
|
begin
|
|
result:= true;
|
|
|
|
eServPath:= '';
|
|
try
|
|
eServPath:= TDirectory.GetParent(ExtractFilePath(ParamStr(0)));
|
|
if (DirectoryExists(TPath.Combine(eServPath, 'eServer'))) then
|
|
eServPath:= TPath.Combine(eServPath, 'eServer')
|
|
else
|
|
eServPath:= '';
|
|
except
|
|
end;
|
|
|
|
fName:= ExtractFilePath(ParamStr(0)) + cfgFName;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Konfiguracni soubor: ' + fName);
|
|
|
|
jeSSL:= false;
|
|
jeLoginMod:= false;
|
|
dataZoneKlic:= '';
|
|
heoLic:= '';
|
|
heoPath:= '';
|
|
sslLibPath:= '';
|
|
datMod.chL:= true;
|
|
datMod.cfgComp:= '';
|
|
|
|
try
|
|
CoInitialize(nil);
|
|
if (FileExists(fName)) then
|
|
begin
|
|
try
|
|
fs:= TFileStream.Create(fName, fmOpenRead);
|
|
if (fs.Size>0) then
|
|
begin
|
|
SetLength(s, fs.Size);
|
|
fs.Read(s[Low(s)], fs.Size);
|
|
s:= ReplaceStr(s, #0, '');
|
|
end;
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
|
|
try
|
|
|
|
try
|
|
if (LeftStr(s, 2)='7D') then
|
|
s:= ReturnDecrypted(s);
|
|
s:= s.Replace(#13#10,'');
|
|
|
|
if (LeftStr(s, 2)='<?') then
|
|
begin
|
|
cfgXML:= Xml.XMLDoc.TXMLDocument.Create(nil);
|
|
cfgXML.LoadFromXML(s);
|
|
end
|
|
else
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Nespravny format konfiguracniho souboru (hdcDZAPIcfg.dat)');
|
|
datMod.LogInfo (Quick.Logger.etCritical, s);
|
|
result:= false;
|
|
CoUninitialize;
|
|
Exit;
|
|
end;
|
|
|
|
|
|
cfgXML.Active:= true;
|
|
|
|
|
|
apiPort:= 8080;
|
|
sslCertFile:= '';
|
|
sslKeyFile:= '';
|
|
datMod.dbServer:= 'localhost';
|
|
datMod.dbPort:= 1433;
|
|
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
|
|
webAuth:= 'https://forum.helios.eu/HeliosStoreWS/wsHeliosStore.asmx';
|
|
urlDZTaskyDown:= 'http://manager.datazone.cloud/api/task/PH2';
|
|
|
|
|
|
|
|
if not(cfgXML.IsEmptyDoc) then
|
|
begin
|
|
if (cfgXML.DocumentElement<>nil) then
|
|
begin
|
|
n1:= cfgXML.DocumentElement;
|
|
if (n1.NodeName='config') then
|
|
begin
|
|
attribs:= n1.AttributeNodes;
|
|
|
|
i:= attribs.IndexOf(sCfgComp);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
datMod.cfgComp:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sPort);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
begin
|
|
sTemp:= attribs.Get(i).NodeValue;
|
|
apiPort:= sTemp.ToInteger;
|
|
end;
|
|
|
|
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}
|
|
i:= attribs.IndexOf(sPortS);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
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: ' + 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);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
if (attribs.Get(i).NodeValue='1') then
|
|
jeSSL:= true;
|
|
|
|
i:= attribs.IndexOf(sLCh);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
if (attribs.Get(i).NodeValue='0') then
|
|
datMod.chL:= false;
|
|
|
|
i:= attribs.IndexOf(sLoginMod);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
if (attribs.Get(i).NodeValue='1') then
|
|
jeLoginMod:= true;
|
|
|
|
i:= attribs.IndexOf(sSSLCert);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
sslCertFile:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sSSLKey);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
sslKeyFile:= attribs.Get(i).NodeValue;
|
|
|
|
|
|
|
|
i:= attribs.IndexOf(sDzKlic);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
dataZoneKlic:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTasksDownURL);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
urlDZTaskyDown:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sHeoLic);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
heoLic:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sHeoPath);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
heoPath:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sHeliosStoreURL);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
webAuth:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTasksIntDown);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
begin
|
|
intGetDZTasks:= attribs.Get(i).NodeValue;
|
|
intGetDZTasks:= Abs(intGetDZTasks); // pocet minut intervalu stahovani dat tasku DataZone
|
|
end;
|
|
|
|
|
|
i:= attribs.IndexOf(sDZTaskIntZapisTypCas);
|
|
if (i>-1) then
|
|
if not VarIsNull(attribs.Get(i).NodeValue) then
|
|
DZTaksZapisTypCas:= attribs.Get(i).NodeValue; // 0=sek / 1=min / 2=hod
|
|
|
|
i:= attribs.IndexOf(sDZTasksIntZapisHeO);
|
|
if (i>-1) then
|
|
if not VarIsNull(attribs.Get(i).NodeValue) then
|
|
begin
|
|
intProcessDZTasksSec:= attribs.Get(i).NodeValue;
|
|
intProcessDZTasksSec:= Abs(intProcessDZTasksSec); // pocet sekund/minut/hodin intervalu stahovani dat tasku DataZone (viz typ casu DZTaksZapisTypCas)
|
|
end;
|
|
|
|
|
|
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Nemam obsah konfiguracniho XML');
|
|
result:= false;
|
|
Exit;
|
|
end;
|
|
|
|
s:= 'Konfigurace - HTTP/S API port ' + apiPort.ToString + ' / SSL ' + IfThen(jeSSL, 'ano', 'ne') + ' / SQL server ' + datMod.dbServer + IfThen(datMod.dbPort<>1433, ':' + datMod.dbPort.ToString, '');
|
|
s:= s + ' / databaze ' + datMod.dbName + ' / user ' + datMod.dbUser + ' / SQL conn Encrypted ' + IfThen(datMod.dbEncConn, 'ano', 'ne');
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
s:= s + ' / custom ROOTVIN';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Kdynium}
|
|
s:= s + ' / custom KDYNIUM';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Koramex}
|
|
s:= s + ' / custom KORAMEX';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_INCOSystems}
|
|
s:= s + ' / custom INCOSystems';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
s:= s + ' / custom Gornicky';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
s:= s + ' / custom MBM Westra';
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
s:= s + ' / custom EMPolar';
|
|
{$ENDIF}
|
|
datMod.LogInfo (Quick.Logger.etInfo, s);
|
|
except on E:Exception do
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba konfigurace: ' + E.Message);
|
|
result:= false;
|
|
end;
|
|
end;
|
|
except on E:Exception do
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Chyba konfigurace: ' + E.Message);
|
|
result:= false;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etError, 'Nelze najit konfiguracni soubor (' + cfgFName + ')');
|
|
result:= false;
|
|
end;
|
|
finally
|
|
begin
|
|
if (cfgXML<>nil) then
|
|
cfgXML:= nil;
|
|
CoUninitialize;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DEBUG}
|
|
datMod.chL:= false;
|
|
{$ENDIF}
|
|
|
|
uWebMod.jeLoginMod:= jeLoginMod;
|
|
uWebMod.dataZoneKlic:= dataZoneKlic;
|
|
|
|
|
|
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF CUSTOM_CTRL_Kdynium}
|
|
if (datMod.dbName<>'Kdynium') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom Kdynium x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
if (datMod.dbName<>'Rootvin') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom Rootvin x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_INCOSystems}
|
|
if (datMod.dbName<>'INCOSystems') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom INCOSystems x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
if (datMod.dbName<>'Gornicky') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom Gornicky x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_GornickyGrp}
|
|
if (datMod.dbName<>'GornickyGrp') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom GornickyGrp x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
if (datMod.dbName<>'Westra') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom Westra x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
if (datMod.dbName<>'EMPolar') then
|
|
begin
|
|
errMsg:= ' - Chybna DB: custom EMPolar x db ' + datMod.dbName;
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
if (datMod.dbServer<>'') then
|
|
begin
|
|
datMod.ConnectServer;
|
|
if not(datMod.sqlConn.Connected) then
|
|
datMod.sqlConn.Open;
|
|
sTemp:= datMod.SQLGetString ('SELECT ICO FROM ' + tblCOrg + ' WHERE CisloOrg=0', datMod.sqlConn);
|
|
if (sTemp<>'') then
|
|
begin
|
|
{$IFDEF CUSTOM_CTRL_Kdynium}
|
|
if (sTemp<>'45357293') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
if (sTemp<>'48950670') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_INCOSystems}
|
|
if (sTemp<>'02964538') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
if (sTemp<>'26069733') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_GornickyGrp}
|
|
if (sTemp<>'03526895') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_GornickyGrp}
|
|
if (sTemp<>'63887282') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
if (sTemp<>'60066130') then
|
|
begin
|
|
errMsg:= ' - Chybna DB';
|
|
result:= false;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function THDCDZApiService.CheckOPENSSLLibs (var useHeoPath: boolean): boolean;
|
|
const eServPathX = 'eServer\openssl\64';
|
|
var f, lOpenSSLLib, s: string;
|
|
heoOK: boolean;
|
|
begin
|
|
result:= true;
|
|
heoOK:= true;
|
|
|
|
eServPath:= '';
|
|
{
|
|
useHeoPath:= true;
|
|
if (heoPath<>'') then
|
|
for lOpenSSLLib in OPENSSL_LIBS do
|
|
begin
|
|
s:= heoPath + PathDelim + 'eServer' + PathDelim + eServPathX + PathDelim + lOpenSSLLib;
|
|
if not(FileExists(s)) then
|
|
begin
|
|
useHeoPath:= false;
|
|
heoOK:= false;
|
|
sslLibPath:= '';
|
|
end
|
|
else
|
|
sslLibPath:= ExcludeTrailingPathDelimiter (s);
|
|
|
|
|
|
s:= heoPath + PathDelim + eServPathX + PathDelim + lOpenSSLLib;
|
|
if not(heoOK) then
|
|
begin
|
|
if not(FileExists(s)) then
|
|
begin
|
|
useHeoPath:= false;
|
|
heoOK:= false;
|
|
sslLibPath:= '';
|
|
end
|
|
else
|
|
if (sslLibPath='') then
|
|
sslLibPath:= ExcludeTrailingPathDelimiter (s);
|
|
end;
|
|
|
|
end
|
|
else
|
|
heoOK:= false;
|
|
}
|
|
|
|
{
|
|
if not(heoOK) and (sslLibPath='') then
|
|
begin
|
|
}
|
|
result:= true;
|
|
f:= ExtractFilePath (ParamStr(0));
|
|
sslLibPath:= f;
|
|
|
|
// Just a check for
|
|
for lOpenSSLLib in OPENSSL_LIBS do
|
|
begin
|
|
if (eServPath<>'') then
|
|
begin
|
|
if not(FileExists(TPath.Combine(eServPath, lOpenSSLLib))) then
|
|
result:= false;
|
|
end
|
|
else
|
|
if not(FileExists(f + lOpenSSLLib)) then
|
|
result:= false;
|
|
end;
|
|
|
|
if (sslLibPath='') then
|
|
for lOpenSSLLib in OPENSSL_LIBS do
|
|
begin
|
|
if (FileExists(f + lOpenSSLLib)) then
|
|
sslLibPath:= ExcludeTrailingPathDelimiter (f)
|
|
else
|
|
sslLibPath:= '';
|
|
end;
|
|
{
|
|
end;
|
|
}
|
|
|
|
if (sslLibPath<>'') then
|
|
result:= true;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure sslOnConnect(var AContext: TIdContext);
|
|
begin
|
|
TIdSSLIOHandlerSocketOpenSSL (AContext.Connection).PassThrough:= false;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.SQLDefinice;
|
|
var lSQL, lSQL2, lSQLX, srcNazev, trgName, errMsg, errMsg2: string;
|
|
objectNazev, sqlDefDB, sqlDefPlg, hash1, hash2: string;
|
|
rs: TResourceStream;
|
|
ms: TMemoryStream;
|
|
arrDefs: TStringList;
|
|
i, iTemp: integer;
|
|
canCont, canCont2, canCont3: boolean;
|
|
function LoadStringFromStream (const AStream: TStream): String;
|
|
var lenX: Integer;
|
|
begin
|
|
AStream.Seek(0,0);
|
|
lenX:= AStream.Size - AStream.Position;
|
|
SetLength(Result, lenX);
|
|
if (lenX>0) then
|
|
AStream.ReadBuffer(Result[1], lenX);
|
|
end;
|
|
function MemoryStreamToAnsiString (const M: TMemoryStream): AnsiString;
|
|
begin
|
|
SetString(Result, PAnsiChar(M.Memory), M.Size);
|
|
end;
|
|
begin
|
|
arrDefs:= TStringList.Create;
|
|
// arrDefs.Add('tbl_hdc_DataZone_konfig');
|
|
arrDefs.Add('tbl_hdc_ph_log');
|
|
arrDefs.Add('trg_hdc_ph_Log_D');
|
|
arrDefs.Add('tbl_hdc_ph_PrijataJsonData');
|
|
arrDefs.Add('trg_hdc_ph_PrijataJsonData_D');
|
|
arrDefs.Add('ef_EncodeBase64');
|
|
{$IFNDEF CUSTOM_CTRL_FILES}
|
|
// arrDefs.Add('ep_HDCDZApi_ZpracujPrijataData');
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc_zdroje.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_INCOSystems}
|
|
// arrDefs.Add('incosystems_spec_Clear');
|
|
iTemp:= arrDefs.IndexOf('ep_HDCDZApi_ZpracujPrijataData');
|
|
if (iTemp>-1) then
|
|
arrDefs.Delete(iTemp);
|
|
|
|
arrDefs.Add('tbl_hdc_ph_PrijataJsonData_rozsireni');
|
|
arrDefs.Add('col_TabPredna_EXT');
|
|
arrDefs.Add('col_TabKmenZbozi_EXT');
|
|
arrDefs.Add('col_TabPrPostup_EXT');
|
|
arrDefs.Add('col_TabEvidRozpracOper_EXT');
|
|
arrDefs.Add('ef_Vyroba_EvidROpR_MamNeuzavrenouPredchozi');
|
|
arrDefs.Add('ep_Vyroba_InsertEvidRozpracOper');
|
|
arrDefs.Add('ep_Vyroba_InsertEvidRozpracOperPol');
|
|
arrDefs.Add('ep_Vyroba_GenOdvodZeMzdy');
|
|
arrDefs.Add('ep_Vyroba_GenVydejZeMzdy');
|
|
arrDefs.Add('ep_HDCDZApi_ZpracujPrijataData');
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
iTemp:= arrDefs.IndexOf('ep_HDCDZApi_ZpracujPrijataData');
|
|
if (iTemp>-1) then
|
|
arrDefs.Delete(iTemp);
|
|
{$I '_custom/Gornicky/sqlDefs.inc'}
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
iTemp:= arrDefs.IndexOf('ep_HDCDZApi_ZpracujPrijataData');
|
|
if (iTemp>-1) then
|
|
arrDefs.Delete(iTemp);
|
|
{$I '_custom/Westra/sqlDefs.inc'}
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
iTemp:= arrDefs.IndexOf('ep_HDCDZApi_ZpracujPrijataData');
|
|
if (iTemp>-1) then
|
|
arrDefs.Delete(iTemp);
|
|
{$I '_custom/EMPolar/sqlDefs.inc'}
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Metalcasting}
|
|
arrDefs.Add('col_TabDokumenty_DokladProAPI');
|
|
{$ENDIF}
|
|
|
|
|
|
errMsg:= 'Nacitani SQL definici...';
|
|
datMod.LogInfo (Quick.Logger.etInfo, errMsg);
|
|
{$IFDEF DEBUG}
|
|
WriteLn (errMsg);
|
|
{$ENDIF}
|
|
|
|
for i:=0 to arrDefs.Count-1 do
|
|
begin
|
|
srcNazev:= arrDefs.Strings[i];
|
|
canCont:= true;
|
|
|
|
{
|
|
if (srcNazev.ToLower='ep_P01') then
|
|
canCont:= false;
|
|
if (srcNazev.ToLower='ep_P03') then
|
|
canCont:= false;
|
|
}
|
|
|
|
if (canCont) then
|
|
begin
|
|
ms:= TMemoryStream.Create;
|
|
try
|
|
rs:= TResourceStream.Create(HInstance, srcNazev, RT_RCDATA); // RT_RCDATA = MakeIntResource(10);
|
|
ms.CopyFrom(rs, rs.Size);
|
|
|
|
lSQL:= MemoryStreamToAnsiString(ms);
|
|
objectNazev:= LeftStr(lSQL, lSQL.IndexOf(Chr(13))).Replace('-- ', '');
|
|
|
|
|
|
if (srcNazev.StartsWith('ep_', true))
|
|
or (srcNazev.StartsWith('bp_', true))
|
|
or (srcNazev.StartsWith('ef_', true))
|
|
or (srcNazev.StartsWith('hpx_', true))
|
|
or (srcNazev.StartsWith('epx_', true))
|
|
or (srcNazev.StartsWith('trg_', true)) then
|
|
begin
|
|
canCont:= false;
|
|
hash1:= '';
|
|
hash2:= '';
|
|
|
|
if (srcNazev.StartsWith('trg_')) then
|
|
lSQLX:= 'SELECT m.definition FROM ' + datMod.dbName + '.sys.triggers t INNER JOIN ' + datMod.dbName + '.sys.objects o on t.object_id = o.object_id'
|
|
+ ' INNER JOIN ' + datMod.dbName + '.sys.sql_modules m on m.object_id = o.object_id WHERE t.name=N' + objectNazev.Replace('dbo.','').QuotedString
|
|
else
|
|
lSQLX:= 'SELECT OBJECT_DEFINITION(OBJECT_ID(N' + (datMod.dbName + '.' + objectNazev).QuotedString + '))';
|
|
sqlDefDB:= datMod.SQLGetString (lSQLX);
|
|
if (sqlDefDB<>'') then
|
|
begin
|
|
// sqlDefDB:= sqlDefDB.Replace('/*' + plgHDCRTN_Name + '*/', '');
|
|
hash1:= THashMD5.GetHashString(sqlDefDB);
|
|
sqlDefPlg:= MidStr(lSQL, lSQL.IndexOf(Chr(13))+3, lSQL.Length);
|
|
if (sqlDefPlg.StartsWith(CRLF)) then
|
|
sqlDefPlg:= MidStr(sqlDefPlg, 3, sqlDefPlg.Length);
|
|
if (sqlDefPlg.EndsWith(CRLF)) then
|
|
sqlDefPlg:= LeftStr(sqlDefPlg, sqlDefPlg.Length-2);
|
|
hash2:= THashMD5.GetHashString (sqlDefPlg);
|
|
if (hash1<>hash2) then
|
|
canCont:= true;
|
|
end
|
|
else
|
|
canCont:= true;
|
|
end;
|
|
|
|
if not(canCont) then
|
|
Continue;
|
|
|
|
|
|
if (srcNazev.StartsWith('ep_')) or (srcNazev.StartsWith('bp_')) then
|
|
begin
|
|
canCont3:= true;
|
|
if (srcNazev.StartsWith('bp_')) and not(srcNazev.ToUpper.Contains('HDC')) then
|
|
canCont3:= false;
|
|
if (canCont3) then
|
|
begin
|
|
datMod.sqlConn.ExecSQL('DROP PROCEDURE IF EXISTS dbo.' + srcNazev);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pregenerovani procedury: ' + srcNazev);
|
|
end;
|
|
end;
|
|
|
|
if (srcNazev.StartsWith('ef_')) then
|
|
begin
|
|
datMod.sqlConn.ExecSQL('DROP FUNCTION IF EXISTS dbo.' + srcNazev);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pregenerovani funkce: ' + srcNazev);
|
|
end;
|
|
|
|
if (srcNazev.StartsWith('tbl_')) then
|
|
begin
|
|
lSQL:= lSQL.Trim;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pregenerovani tabulky: ' + srcNazev);
|
|
end;
|
|
|
|
if (srcNazev.StartsWith('trg_')) then
|
|
begin
|
|
if (lSQL.StartsWith('-- ')) then
|
|
lSQL:= MidStr(lSQL, lSQL.IndexOf(Chr(13))+3, lSQL.Length);
|
|
trgName:= LeftStr(lSQL, lSQL.IndexOf(' ON dbo.'));
|
|
trgName:= trgName.Replace ('CREATE TRIGGER ', '');
|
|
datMod.sqlConn.ExecSQL ('DROP TRIGGER IF EXISTS ' + trgName);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pregenerovani triggeru: ' + trgName);
|
|
end;
|
|
|
|
|
|
try
|
|
if (lSQL<>'') then
|
|
datMod.sqlConn.ExecSQL(lSQL);
|
|
except on E:Exception do
|
|
begin
|
|
errMsg2:= E.Message;
|
|
errMsg:= 'Nezdarilo se nacteni definice: ' + srcNazev + ' >> ' + errMsg2;
|
|
datMod.LogInfo (Quick.Logger.etCritical, errMsg);
|
|
{$IFDEF DEBUG}
|
|
WriteLn (errMsg);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
finally
|
|
ms.Free;
|
|
if (rs<>nil) then
|
|
rs.Free;
|
|
end;
|
|
Sleep(200);
|
|
end;
|
|
end;
|
|
arrDefs.Free;
|
|
|
|
errMsg:= 'SQL definice nacteny';
|
|
datMod.LogInfo (Quick.Logger.etInfo, errMsg);
|
|
{$IFDEF DEBUG}
|
|
WriteLn (errMsg);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.SQLKontroly;
|
|
var lSQL: string;
|
|
lQry: TFDQuery;
|
|
cfgDat, canCont: boolean;
|
|
begin
|
|
// CoInitialize(nil);
|
|
SQLDefinice;
|
|
|
|
lQry:= TFDQuery.Create(nil);
|
|
lQry.Connection:= datMod.sqlConn;
|
|
lSQL:= 'SELECT 1 AS X FROM sys.tables t INNER JOIN sys.schemas s ON (s.schema_id=t.schema_id) WHERE s.[name]=''dbo'' AND t.[name]=N''_hdc_DataZone_Tasky''';
|
|
lQry.Open(lSQL);
|
|
try
|
|
tblDZTExistuje:= (lQry.RecordCount>0);
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
|
|
// CoUninitialize;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
procedure THDCDZApiService.ZpracujOmniZpravy (const task: IOmniTaskControl; const msg: TOmniMessage);
|
|
var lSQL: string;
|
|
begin
|
|
lSQL:= 'MsgId ' + msg.MsgID.ToString;
|
|
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
|
|
|
|
constructor THDCDZApiService.Create (AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
{$IFDEF OMNIThreadLib}
|
|
tskLicKontrola:= nil;
|
|
tskZapisDZTasks:= nil;
|
|
tskZpracujJSON:= nil;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
|
|
destructor THDCDZApiService.Destroy;
|
|
begin
|
|
{$IFDEF OMNIThreadLib}
|
|
if (Assigned(tskLicKontrola)) then
|
|
begin
|
|
tskLicKontrola.Terminate;
|
|
tskLicKontrola:= nil;
|
|
end;
|
|
|
|
if (Assigned(tskZpracujJSON)) then
|
|
begin
|
|
tskZpracujJSON.Terminate;
|
|
tskZpracujJSON:= nil;
|
|
end;
|
|
|
|
if (Assigned(tskZapisDZTasks)) then
|
|
begin
|
|
tskZapisDZTasks.Terminate;
|
|
tskZapisDZTasks:= nil;
|
|
end;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceStart (Sender: TService; var Started: Boolean);
|
|
var lSQL, s, url, libP, errMsg: string;
|
|
sTemp: string;
|
|
bResp: boolean;
|
|
iCanStart, useHeoSSL: boolean;
|
|
h: NativeUInt;
|
|
begin
|
|
|
|
// globalni promenne MVCFrameworku
|
|
IsMultiThread:= true;
|
|
UseConsoleLogger:= false;
|
|
// When MVCSerializeNulls = True empty nullables and nil are serialized as json null.
|
|
// When MVCSerializeNulls = False empty nullables and nil are not serialized at all.
|
|
MVCSerializeNulls:= true;
|
|
|
|
|
|
FDManager.Open;
|
|
CoInitialize(nil); // COM technologie (ODBC) potrebuje inicializaci ActiveX
|
|
|
|
|
|
dbgStep:= -1;
|
|
fZastavAPI:= false;
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
omniMonitor:= TOmniEventMonitor.Create(nil);
|
|
omniMonitor.OnTaskMessage:= ZpracujOmniZpravy;
|
|
{$ENDIF}
|
|
|
|
iCanStart:= true;
|
|
// testLicTimeout:= 60 + random(300); // test licence min 1 min, max kazdych 5 min
|
|
intGetDZTasks:= 0; // defaultne stahuj tasky kazdych x minut, default 0, nastavuje se v konfiguraku
|
|
|
|
|
|
logItem:= TLogItem.Create;
|
|
|
|
eServDLL:= false;
|
|
eServPath:= '';
|
|
|
|
apiPort:= 8080;
|
|
tblDZTExistuje:= false;
|
|
mamTabPrijataData:= false;
|
|
FGlobLicJeOK:= false;
|
|
|
|
|
|
bResp:= ReadConfig (sTemp);
|
|
if (bResp=false) then
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Sluzba nebude spustena, chyba konfigurace' + IfThen(sTemp<>'', sTemp, '???'));
|
|
{$ENDIF}
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Sluzba nebude spustena, chyba konfigurace' + IfThen(sTemp<>'', sTemp, '???'));
|
|
Started:= false;
|
|
ServiceStop (Sender, bResp);
|
|
Exit;
|
|
end;
|
|
|
|
initConnOK:= false;
|
|
InitConn (sTemp);
|
|
|
|
|
|
verText:= StringReplace(GetFileVersion2(GetModuleName(HInstance)),'.','',[rfReplaceAll]);
|
|
verText:= '0300' + MidStr(verText,3,8);
|
|
if Length(verText)=11 then
|
|
verText:= LeftStr(verText,8) + '0' + RightStr(verText,3);
|
|
// LogInfo(Quick.Logger.etInfo, 'Verze: ' + verText);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Computername: ' + GetEnvironmentVariable('COMPUTERNAME') + ' / Verze: ' + verText + ' / DMVCFramework: ' + DMVCFRAMEWORK_VERSION
|
|
+ ' / kompilace: ' + FormatDateTime('dd.mm.yyyy hh:nn', TTimeZone.Local.ToLocalTime(GetLinkerTimestamp)));
|
|
|
|
if (datMod.cfgComp='') or (datMod.cfgComp<>GetEnvironmentVariable('COMPUTERNAME')) then
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('!! KONFIGURACNI SOUBOR NENI URCEN PRO TENTO POCITAC !!');
|
|
{$ENDIF}
|
|
datMod.LogInfo (Quick.Logger.etInfo, '!! KONFIGURACNI SOUBOR NENI URCEN PRO TENTO POCITAC !!');
|
|
iCanStart:= false;
|
|
end;
|
|
|
|
|
|
if (datMod.chL) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby kontroly licence...');
|
|
licThr:= TKontrolaLicThread.Create(ThreadTerminated, heoLic);
|
|
licThr.MainThreadHandle:= GetCurrentThread;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end
|
|
else
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Kontrola licence je v DEBUG modu VYPNUTA.');
|
|
{$ENDIF}
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Kontrola licence je vypnuta...');
|
|
end;
|
|
|
|
|
|
{$IFDEF DEBUG}
|
|
WriteLn('HTTP/S API port: ' + apiPort.ToString + IfThen(jeSSL, ' (SSL)', '') + IfThen(jeLoginMod, ' - login mód', ''));
|
|
WriteLn('Verze: ' + verText + ' / DMVCFramework: ' + DMVCFRAMEWORK_VERSION + ' / kompilace: ' + FormatDateTime('dd.mm.yyyy hh:nn', TTimeZone.Local.ToLocalTime(GetLinkerTimestamp)));
|
|
{$ENDIF}
|
|
|
|
fServer:= TIdHTTPWebBrokerBridge.Create(nil);
|
|
// fServer.OnParseAuthentication := TMVCParseAuthentication.OnParseAuthentication;
|
|
sslPwds:= nil;
|
|
fServer.DefaultPort:= apiPort;
|
|
|
|
if (jeSSL) then
|
|
begin
|
|
sslPwds:= TSSLEventHandlers.Create;
|
|
|
|
sslHandler.OnGetPassword:= sslPwds.OnGetSSLPassword;
|
|
sslHandler.SSLOptions.CertFile:= sslCertFile;
|
|
sslHandler.SSLOptions.RootCertFile:= '';
|
|
sslHandler.SSLOptions.KeyFile:= sslKeyFile;
|
|
// sslHandler.SSLOptions.Mode:= sslmServer;
|
|
// sslHandler.SSLOptions.SSLVersions:= [sslvTLSv1_2, sslvTLSv1_2];
|
|
// sslHandler.SSLOptions.Method:= sslvTLSv1_2;
|
|
// sslHandler.SSLOptions.VerifyMode := [];
|
|
// sslHandler.SSLOptions.VerifyDepth:= 0;
|
|
|
|
fServer.IOHandler:= sslHandler;
|
|
{$IF CompilerVersion >= 33}
|
|
fServer.OnQuerySSLPort := sslPwds.OnQuerySSLPort;
|
|
{$ENDIF}
|
|
|
|
useHeoSSL:= false;
|
|
if not(CheckOPENSSLLibs (useHeoSSL)) then
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Nenalezeny pozadovane knihovny OpenSSL');
|
|
{$ENDIF}
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Nenalezeny pozadovane knihovny OpenSSL (libeay32.dll / ssleay32.dll)');
|
|
iCanStart:= false;
|
|
end;
|
|
|
|
{
|
|
libP:= '';
|
|
if (useHeoSSL) and (heoPath<>'') and (iCanStart) then
|
|
begin
|
|
libP:= ExcludeTrailingPathDelimiter(heoPath) + PathDelim + 'eServer\eServer\openssl\64';
|
|
IdOpenSSLSetLibPath (libP);
|
|
end;
|
|
|
|
if (heoPath<>'') and (iCanStart) and (sslLibPath<>'') then
|
|
begin
|
|
useHeoSSL:= true;
|
|
libP:= ExtractFilePath (ExcludeTrailingPathDelimiter (sslLibPath));
|
|
IdOpenSSLSetLibPath (libP);
|
|
end;
|
|
}
|
|
libP:= ExtractFilePath(ParamStr(0));
|
|
IdSSLOpenSSLHeaders.IdOpenSSLSetLibPath (libP);
|
|
|
|
|
|
if (libP<>'') then
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'SSL knihovny (libeay32.dll / ssleay32.dll) z adresare: ' + libP);
|
|
|
|
end;
|
|
|
|
|
|
if ((datMod.dbServer='') or (datMod.dbName='')) and (iCanStart) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Chyba spousteni: neni zadan server nebo jmeno databaze. Sluzba nebude spustena.');
|
|
iCanStart:= false;
|
|
end;
|
|
|
|
if not(datMod.sqlConn.Connected) and (iCanStart) then
|
|
try
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Pripojuji se do databaze...');
|
|
{$IFDEF DEBUG}
|
|
WriteLn('Pripojuji se do databaze...');
|
|
{$ENDIF}
|
|
datMod.ConnectServer;
|
|
if not(datMod.sqlConn.Connected) then
|
|
datMod.sqlConn.Open;
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Spojeni pooled: ' + IfThen(datMod.sqlConn.Params.Pooled, 'ano', 'ne'));
|
|
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
WriteLn('Spojeni pooled: ' + IfThen(datMod.sqlConn.Params.Pooled, 'ano', 'ne'));
|
|
url:= 'http' + IfThen(jeSSL, 's', '') + '://localhost:' + apiPort.ToString + '/swagger';
|
|
ShellExecute(0, 'open', PChar(url), nil, nil, SW_SHOWNORMAL);
|
|
{$ENDIF}
|
|
|
|
except on E:Exception do
|
|
begin
|
|
errMsg:= E.Message;
|
|
if (errMsg.Contains('ogin failed for us')) or (errMsg.Contains('ogin failed')) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, FDManager.FindConnection(sqlPoolName).Params.Text);
|
|
// datMod.LogInfo (Quick.Logger.etCritical, 'user: ' + datMod.dbUser + ' / pwd: ' + datMod.dbPwd);
|
|
// errMsg:= errMsg + ' (zadane pwd: ' + datMod.dbPwd + ' )';
|
|
end;
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Chyba spousteni: ' + errMsg + IfThen(dbgStep=0, '', ' - dbgStep ' + dbgStep.ToString));
|
|
dbgStep:= 0;
|
|
iCanStart:= false;
|
|
end;
|
|
end;
|
|
|
|
|
|
if not(iCanStart) and (dbgStep=0) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'FireDAC pool se nezdaril, zkousim bez nej...');
|
|
try
|
|
datMod.ConnectServer;
|
|
if not(datMod.sqlConn.Connected) then
|
|
datMod.sqlConn.Open;
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Connection pooled: ' + IfThen(datMod.sqlConn.Params.Pooled, 'ano', 'ne'));
|
|
|
|
{$IFDEF DEBUG}
|
|
WriteLn('OK');
|
|
url:= 'http' + IfThen(jeSSL, 's', '') + '://localhost:' + apiPort.ToString + '/swagger';
|
|
ShellExecute(0, 'open', PChar(url), nil, nil, SW_SHOWNORMAL);
|
|
{$ENDIF}
|
|
|
|
except on E:Exception do
|
|
begin
|
|
errMsg:= E.Message;
|
|
if (errMsg.Contains('ogin failed for us')) or (errMsg.Contains('ogin failed')) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, FDManager.FindConnection(sqlPoolName).Params.Text);
|
|
// datMod.LogInfo (Quick.Logger.etCritical, 'user: ' + datMod.dbUser + ' / pwd: ' + datMod.dbPwd);
|
|
// errMsg:= errMsg + ' (zadane pwd: ' + datMod.dbPwd + ' )';
|
|
end;
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Chyba spousteni: ' + errMsg + IfThen(dbgStep=0, '', ' - dbgStep ' + dbgStep.ToString));
|
|
dbgStep:= 0;
|
|
iCanStart:= false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
if (datMod.sqlConn.Connected) and (iCanStart) then
|
|
begin
|
|
try
|
|
try
|
|
fServer.Active:= true;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
OutputDebugString(PChar(E.ClassName + ' - ' + E.Message));
|
|
raise;
|
|
end;
|
|
on E: EIdCouldNotBindSocket do
|
|
begin
|
|
if E.InnerException is EIdSocketError then
|
|
OutputDebugString(PChar(
|
|
'WSAError: ' +
|
|
IntToStr(EIdSocketError(E.InnerException).LastError)
|
|
));
|
|
raise;
|
|
end;
|
|
end;
|
|
SQLKontroly;
|
|
|
|
mamTabPrijataData:= datMod.SQLTableExists(tblPrijataJsonData);
|
|
if (mamTabPrijataData) then
|
|
begin
|
|
{$IFDEF OMNIThreadLib}
|
|
tskZpracujJSON:= CreateTask (OmniZpracujJSON, 'HDCDZApi-OmniZpracujJSON').SetParameter('delay', 2);
|
|
tskZpracujJSON.CancelWith (cancelToken);
|
|
tskZpracujJSON.Enforced (false); // kdyz je task terminovan driv nez nastartuje, vubec ho nespoustej
|
|
tskZpracujJSON.OnTerminated (
|
|
procedure
|
|
begin
|
|
WriteLn('Konec sluzby zpracovani prijatych JSON zprav... OK');
|
|
tskZpracujJSON:= nil;
|
|
end);
|
|
tskZpracujJSON.Run;
|
|
{$ENDIF}
|
|
case DZTaksZapisTypCas of
|
|
0: sTemp:= 'sek';
|
|
1: sTemp:= 'min';
|
|
2: sTemp:= 'hod';
|
|
end;
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainSvcStart.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainSvcStart.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainSvcStart.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainSvcStart.inc}
|
|
{$ENDIF}
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby zpracovani prijatych JSON zprav (interval ' + intProcessDZTasksSec.ToString + ' ' + sTemp + ')');
|
|
zpracJsonThr:= THeoZpracujJSONThread.Create (ThreadTerminated);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
{$IFDEF DEBUG}
|
|
// WriteLn('Start sluzby zpracovani prijatych JSON zprav - pocet ' + datMod.SQLGetString('SELECT COUNT(ID) FROM ' + tblPrijataJsonData + ' WHERE DatZpracovani IS NULL') + '... OK');
|
|
WriteLn('Start sluzby zpracovani prijatych JSON zprav...');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if (intGetDZTasks>0) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby stahovani dat tasku DataZone (interval ' + intGetDZTasks.ToString + ' min)');
|
|
downThr:= TDownDZTasksThread.Create (ThreadTerminated);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
{$IFDEF DEBUG}
|
|
WriteLn(' OK');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
tblDZTExistuje:= datMod.SQLTableExists(tblDZTasky);
|
|
if (tblDZTExistuje) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby evidence DataZone tasku...');
|
|
zapisDZTasksThr:= THeoZapisDZTasksThread.Create (ThreadTerminated);
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end;
|
|
|
|
|
|
except on E:Exception do
|
|
begin
|
|
if (fServer<>nil) then
|
|
fServer.Free;
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Chyba spousteni: ' + E.Message + IfThen(dbgStep=0, '', ' - dbgStep ' + dbgStep.ToString));
|
|
iCanStart:= false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if not(iCanStart) then
|
|
begin
|
|
Started:= false;
|
|
ServiceStop (Sender, bResp);
|
|
datMod.LogInfo (Quick.Logger.etCritical, 'Sluzba NEBYLA spustena.');
|
|
end
|
|
else
|
|
Started:= true;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ThreadTerminated (Sender: TObject);
|
|
begin
|
|
ServiceThread.Terminate;
|
|
Controller(SERVICE_CONTROL_STOP);
|
|
if (Sender is TThread) then
|
|
(Sender as TThread).ForceQueue(nil, Sender.Free);
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure THDCDZApiService.ServiceStop (Sender: TService; var Stopped: Boolean);
|
|
|
|
begin
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Zastavuji hlavni sluzbu...');
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
if (omniMonitor<>nil) then
|
|
omniMonitor.Free;
|
|
if (tskZpracujJSON<>nil) then
|
|
tskZpracujJSON.Terminate (2000);
|
|
if (tskLicKontrola<>nil) then
|
|
tskLicKontrola.Terminate (2000);
|
|
if (tskZapisDZTasks<>nil) then
|
|
tskZapisDZTasks.Terminate (2000);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF OMNIThreadLib}
|
|
if (Assigned(tskLicKontrola)) then
|
|
begin
|
|
tskLicKontrola.Terminate;
|
|
tskLicKontrola:= nil;
|
|
end;
|
|
|
|
if (Assigned(tskZpracujJSON)) then
|
|
begin
|
|
tskZpracujJSON.Terminate;
|
|
tskZpracujJSON:= nil;
|
|
end;
|
|
|
|
if (Assigned(tskZapisDZTasks)) then
|
|
begin
|
|
tskZapisDZTasks.Terminate;
|
|
tskZapisDZTasks:= nil;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
if Assigned(zapisDZTasksThr) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Ukoncuji sluzbu evidence DataZone tasku...');
|
|
try
|
|
zapisDZTasksThr.ThreadTerminate;
|
|
FreeAndNil (zapisDZTasksThr);
|
|
except on E:Exception do
|
|
// add event in eventlog with reason why the service couldn't stop
|
|
LogMessage('Cannot stop service: ' + E.Message, EVENTLOG_ERROR_TYPE, 0, 1);
|
|
end;
|
|
// CoUninitialize;
|
|
// FDManager.Close;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end;
|
|
|
|
|
|
|
|
if Assigned(zpracJsonThr) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Ukoncuji sluzbu zpracovani JSON zprav...');
|
|
try
|
|
zpracJsonThr.ThreadTerminate;
|
|
FreeAndNil(zpracJsonThr);
|
|
except on E:Exception do
|
|
// add event in eventlog with reason why the service couldn't stop
|
|
LogMessage('Cannot stop service: ' + E.Message, EVENTLOG_ERROR_TYPE, 0, 1);
|
|
end;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end;
|
|
|
|
|
|
{$IFDEF CUSTOM_CTRL_Gornicky}
|
|
{$I ./_custom/Gornicky/winSvc/mainSvcStop.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Westra}
|
|
{$I ./_custom/Westra/winSvc/mainSvcStop.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_EMPolar}
|
|
{$I ./_custom/EMPolar/winSvc/mainSvcStop.inc}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CUSTOM_CTRL_Rootvin}
|
|
{$I ./_custom/Rootvin/winSvc/mainSvcStop.inc}
|
|
{$ENDIF}
|
|
|
|
if Assigned(licThr) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Ukoncuji sluzbu kontroly licence...');
|
|
try
|
|
licThr.ThreadTerminate;
|
|
FreeAndNil(licThr);
|
|
except on E:Exception do
|
|
// add event in eventlog with reason why the service couldn't stop
|
|
LogMessage('Cannot stop service: ' + E.Message, EVENTLOG_ERROR_TYPE, 0, 1);
|
|
end;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end;
|
|
|
|
|
|
|
|
|
|
if Assigned(downThr) then
|
|
begin
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Ukoncuji sluzbu stahovani dat tasku DataZone...');
|
|
try
|
|
downThr.ThreadTerminate;
|
|
FreeAndNil(downThr);
|
|
except on E:Exception do
|
|
// add event in eventlog with reason why the service couldn't stop
|
|
LogMessage('Cannot stop service: ' + E.Message, EVENTLOG_ERROR_TYPE, 0, 1);
|
|
end;
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'OK');
|
|
end;
|
|
|
|
|
|
|
|
|
|
if (Assigned(sslPwds)) then
|
|
sslPwds.Free;
|
|
|
|
if (Assigned(fServer)) then
|
|
fServer.Free;
|
|
|
|
if (datMod.sqlConn.Connected) then
|
|
datMod.sqlConn.Close;
|
|
if (FDManager.Active) then
|
|
FDManager.Close;
|
|
|
|
datMod.LogInfo (Quick.Logger.etInfo, 'Sluzba ' + Sender.Name + ' zastavena.');
|
|
|
|
if (Assigned(logItem)) then
|
|
logItem.Free;
|
|
|
|
if (Assigned(Logger)) then
|
|
Logger.Stop;
|
|
|
|
Stopped:= true;
|
|
|
|
end;
|
|
|
|
|
|
|
|
initialization
|
|
CoInitialize(nil);
|
|
|
|
|
|
finalization
|
|
CoUninitialize;
|
|
|
|
|
|
|
|
end.
|