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 = '' + '' + ' ' + ' ' + ' LicenseString' + ' HDCDZApi' + ' ' + ' ' + ''; 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ůž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; dbName, dbServer, dbUser, dbPwd, heoLic, apiLic, dataZoneKlic, heoPath, sslLibPath: string; dbPort, intGetDZTasks: integer; intProcessDZTasksSec: integer; jeSSL, jeLoginMod: boolean; rbsTemp: RawByteString; sqlDefinice: TArray; {$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, 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('')) then begin kodResp:= Trim(MidStr(resp, Pos('', 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)='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.