2968 lines
84 KiB
ObjectPascal
2968 lines
84 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.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;
|
||
|
||
|
||
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 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<><6D>ete p<>idat dal<61><6C> <20>daje, kter<65> 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;
|
||
|
||
dbName, dbServer, dbUser, dbPwd, heoLic, apiLic, dataZoneKlic, heoPath, sslLibPath: string;
|
||
dbPort, 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, uDataMod;
|
||
{$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: 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 (sqlConnX.Connected) then
|
||
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''''';
|
||
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);
|
||
try
|
||
lQry.Connection:= sqlConnX;
|
||
lQry.Open(lSQL);
|
||
lQry.First;
|
||
|
||
inProg:= true;
|
||
|
||
while not(lQry.EOF) do
|
||
begin
|
||
idTask:= lQry.FieldByName('ID').asInteger;
|
||
canCont:= true;
|
||
|
||
lQry2:= TFDQuery.Create(nil);
|
||
lQry2.Connection:= sqlConnX;
|
||
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;
|
||
FreeAndNil(lQry2);
|
||
if (cnt>3) then
|
||
canCont:= false;
|
||
|
||
|
||
if (canCont) then
|
||
begin
|
||
|
||
sqlConnX.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
|
||
sqlConnX.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}
|
||
sqlConnX.ExecSQL(lSQL);
|
||
sqlConnX.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}
|
||
sqlConnX.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;
|
||
sqlConnX.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Blokovano=0 WHERE ID=' + idTask.ToString);
|
||
end;
|
||
lQry.Next;
|
||
end;
|
||
finally
|
||
lQry.Close;
|
||
FreeAndNil (lQry);
|
||
end;
|
||
|
||
inProg:= false;
|
||
end; // sql Connected
|
||
sqlConnX.Close;
|
||
FreeAndNil (sqlConnX);
|
||
|
||
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<61>ch DZ Task<73> / 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<64>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<6F>d<EFBFBD> v<>robn<62> operaci'', DatZpracovani=GETDATE() WHERE ID=' + idTask.ToString);
|
||
if (errMsg.Contains('2000742')) then
|
||
sqlConnX2.ExecSQL('UPDATE ' + tblDZTasky + ' SET PosledniChyba=N''(2000742) Nen<65> zad<61>n zam<61>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;
|
||
|
||
|
||
|
||
|
||
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.chL:= true; // check licenci
|
||
intGetDZTasks:= 0;
|
||
intProcessDZTasksSec:= 120; // default pro zapis tasku do Heliosu (zpracovani tabulky dbo._hdc_ph_PrijataJsonData)
|
||
DZTaksZapisTypCas:= 0; // sek
|
||
datMod.dbEncConn:= false;
|
||
webAuth:= 'https://forum.helios.eu/HeliosStoreWS/wsHeliosStore.asmx';
|
||
urlDZTaskyDown:= 'http://manager.datazone.cloud/api/task/PH2';
|
||
|
||
|
||
|
||
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
|
||
datMod.dbServer:= attribs.Get(i).NodeValue;
|
||
{$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;
|
||
end;
|
||
|
||
i:= attribs.IndexOf(sName);
|
||
if (i>-1) then
|
||
if (attribs.Get(i).NodeValue<>null) then
|
||
datMod.dbName:= attribs.Get(i).NodeValue;
|
||
{$IFDEF DEBUG}
|
||
Writeln('DB: ' + datMod.dbName);
|
||
{$ENDIF}
|
||
i:= attribs.IndexOf(sUser);
|
||
if (i>-1) then
|
||
if (attribs.Get(i).NodeValue<>null) then
|
||
datMod.dbUser:= ReturnDecrypted(attribs.Get(i).NodeValue);
|
||
|
||
i:= attribs.IndexOf(sPwd);
|
||
if (i>-1) then
|
||
if (attribs.Get(i).NodeValue<>null) then
|
||
datMod.dbPwd:= ReturnDecrypted(attribs.Get(i).NodeValue);
|
||
|
||
|
||
i:= attribs.IndexOf(sEncConn);
|
||
if (i>-1) then
|
||
if (attribs.Get(i).NodeValue<>null) then
|
||
if (attribs.Get(i).NodeValue='1') then
|
||
datMod.dbEncConn:= true;
|
||
|
||
|
||
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;
|
||
|
||
|
||
|
||
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.
|