HDCApi/_custom/Rootvin/winSvc/impl.inc

 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;