constructor THeoRTNZapisObjMatThread.Create (AOnTerminate: TNotifyEvent; AService: TService); begin inherited Create (false); // Create thread in NOT suspended mode FMainService:= AService; FLock:= TCriticalSection.Create; FRunning:= false; FTermEvent:= TEvent.Create (nil, False, False, ''); // OnTerminate:= AOnTerminate; // FreeOnTerminate:= true; FreeOnTerminate:= false; // Ensure manual freeing of thread resources end; destructor THeoRTNZapisObjMatThread.Destroy; begin {$IFDEF DEBUG} Write('Ukoncuji thread RTN Zapis objednavka materialu do ExpPr...'); {$ENDIF} if (FTimer<>0) then CloseHandle (FTimer); FTermEvent.Free; FRunning:= false; FMainService:= nil; Terminate; FLock.Free; inherited; {$IFDEF DEBUG} WriteLn('OK'); {$ENDIF} end; procedure THeoRTNZapisObjMatThread.TerminatedSet; begin FTermEvent.SetEvent; end; procedure THeoRTNZapisObjMatThread.ThreadTerminate; begin Terminate; WaitFor; end; procedure THeoRTNZapisObjMatThread.Execute; const _Second = 10_000_000; var lSQL, errMsg, url, outData, fName, loopCasTyp: string; lLoop, idDigiFile, cnt, idx: Integer; lLoopMax, koefProCas: integer; logRunCnt, intTemp: integer; Msg: TMsg; firstRun, inProg, inDL: boolean; lQry: TFDQuery; sqlConnX: TFDConnection; lBusy: LongInt; liDueTime: LARGE_INTEGER; cfgFile: string; specCfgXML: XML.XmlIntf.IXMLDocument; n1: XML.XmlIntf.IXMLNode; attribs: IXMLNodeList; attrIdx: integer; begin lLoop:= 0; idDigiFile:= 0; logRunCnt:= 1; lLoopMax:= 3; // v minutach !!!! try try CoInitialize(nil); cfgFile:= ExtractFilePath(ParamStr(0)) + 'hdcDZApiCfg.xml'; if (FileExists(cfgFile)) then begin specCfgXML:= Xml.XMLDoc.TXMLDocument.Create(nil); specCfgXML.LoadFromFile (cfgFile); specCfgXML.Active:= true; if not(specCfgXML.IsEmptyDoc) then begin if (specCfgXML.DocumentElement<>nil) then begin n1:= specCfgXML.DocumentElement; if (n1.NodeName='config') then begin attribs:= n1.AttributeNodes; attrIdx:= attribs.IndexOf('zapisObjMatExpPrIntMins'); if (attrIdx>-1) then if TryStrToInt(VarToStr(attribs.Get(attrIdx).NodeValue), intTemp) then lLoopMax:= intTemp; end; // n1 = config end; // specCfgXML.DocumentElement<>nil end; // not specCfgXML.IsEmptyDoc end; // FileExists(cfgFile) except on E: Exception do datMod.LogInfo (Quick.Logger.etError, 'Chyba cteni konfigu THeoRTNZapisObjMatThread: ' + E.Message); end; finally begin if (specCfgXML<>nil) then specCfgXML := nil; CoUninitialize; end; end; datMod.LogInfo (Quick.Logger.etInfo, 'Zapis Objednavek materialu do ExpPr - interval: ' + lLoopMax.ToString + ' min.'); lLoopMax := lLoopMax * 60; // minuty na vteriny firstRun := true; inProg := false; FRunning := true; if (1=1) then // pro rychle vypnuti begin FTimer := CreateWaitableTimer (nil, true, 'RTNZapisObjMatExpPrWaitableTimer'); liDueTime.QuadPart := -1*_Second; while not(Terminated) and FRunning do begin if (HDCDZApiService<>nil) then if (HDCDZApiService.Terminated) then begin Terminate; FRunning:= false; end; PeekMessage (&Msg, 0, 0, 0, PM_NOREMOVE); { Create message queue } if (lLoop=lLoopMax) or (firstRun) then // pri startu a pak kazdou minutu begin sqlConnX := TFDConnection.Create (nil); try sqlConnX.Params.SetStrings (datMod.sqlConnParams); lQry := TFDQuery.Create(nil); try lQry.Connection := sqlConnX; idDigiFile:= 0; firstRun:= false; if (logRunCnt<4) then datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky materialu do ExpPr c.' + logRunCnt.toString + '...'); if (logRunCnt=4) then datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim zapis Objednavky - bezi, ale dal neloguju'); try if not(inProg) then // nebezi uz ? begin if (1=1) then // pro rychle vypnuti begin sqlConnX.Open; if (sqlConnX.Connected) then begin inProg:= true; lSQL:= 'DECLARE @errMsg NVARCHAR(500)=N''''' + CRLF +'IF OBJECT_ID(N''dbo.ep_Vyroba_GenObjednavkuMatDoVyrobyNew'', N''P'') IS NOT NULL' + CRLF + ' EXEC dbo.ep_Vyroba_GenObjednavkuMatDoVyrobyNew @errMsg OUT' + CRLF + 'SELECT @errMsg AS ErrMsg'; lQry.Open(lSQL); if (lQry.RecordCount>0) then begin lQry.First; errMsg:= lQry.FieldByName('ErrMsg').AsString; if (errMsg<>'') then begin datMod.LogInfo (Quick.Logger.etInfo, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); {$IFDEF DEBUG} WriteLn('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); {$ENDIF} end; end; inProg:= false; end; // sql Connected end; // 1=1 end; except on E:Exception do begin inProg:= false; errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString; if (mamTabPrijataData) then begin datMod.LogInfo (Quick.Logger.etError, 'Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); {$IFDEF DEBUG} WriteLn('Zapis Objednavky materialu do ExpPr - chyba: ' + errMsg); {$ENDIF} end; end; end; finally lQry.Free; end; finally sqlConnX.Free; end; lLoop:= 0; if (logRunCnt<5) then Inc (logRunCnt); end; // if lLoop=lLoopMax... Inc (lLoop); if (FTimer<>0) then SetWaitableTimer (FTimer, TLargeInteger(liDueTime), 0, nil, nil, false); repeat lBusy:= MsgWaitForMultipleObjects (1, FTimer, false, INFINITE, QS_ALLINPUT); until lBusy = WAIT_OBJECT_0; // Sleep (998); end; // while not(Terminated) and FRunning if (FTimer<>0) then CloseHandle (FTimer); end; // 1=1 end;