Dalsi zmeny

_custom/Westra/winSvc/impl.inc

@@ -0,0 +1,499 @@
+// ###########################################################
+// TQTXNetworkPath
+// ###########################################################
+
+
+ procedure TQTXNetworkPath.Disconnect (const aForce: Boolean);
+  var mRes: Integer;
+      mCount: Integer;
+  begin
+// Close network connection if connected
+   if (FConnected=True) and (FOwned=True) then
+    begin
+ 
+// Attempt to close the connection
+     mRes:= WNetCancelConnection (@FUNCData,aForce);
+ 
+/*
+ Since files can be open temporarily, we try to
+ wait a little before we re-try to close again.
+ A maximum of 100 attempts is set
+*/
+     if (mRes=ERROR_OPEN_FILES) then
+      begin
+       mCount:=0;
+       while (mRes=ERROR_OPEN_FILES) do
+        begin
+         Inc (mCount);
+         if (mCount=100) then
+          Break;
+         Sleep(100);
+         mRes:= WNetCancelConnection (@FUNCData,aForce);
+        end;
+      end;
+ 
+     FConnected:=False;
+     FOwned:=False;
+     SetLength (FHostName,0);
+     SetLength (FRemotePath,0);
+     SetLength (FUser,0);
+     SetLength (FPassword,0);
+     SetLength (FURI,0);
+    end;
+  end;
+ 
+
+
+
+ procedure TQTXNetworkPath.ClearLastError;
+  begin
+   FFailed:= false;
+   SetLength (FLastError,0);
+  end;
+
+
+
+
+ procedure TQTXNetworkPath.setLastError (aValue:String);
+  begin
+   FLastError:= Trim (aValue);
+   FFailed:= Length(FLastError)>0;
+  end;
+ 
+
+
+
+ function TQTXNetworkPath.getRelativePath (aFilename:String):String;
+  begin
+   if (FConnected) then
+     result:= FURI + aFilename
+    else
+     result:= aFilename;
+  end;
+
+
+
+
+ destructor TQTXNetworkPath.Destroy;
+  begin
+   if (FConnected) then
+    Disconnect(True);
+   inherited;
+  end;
+
+
+
+// ###########################################################
+// THeoWestraDataPumpFileThread
+// ###########################################################
+
+ constructor THeoWestraDataPumpFileThread.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 THeoWestraDataPumpFileThread.Destroy;
+  begin
+{$IFDEF DEBUG}
+   Write('Ukoncuji thread WESTRA file...');
+{$ENDIF}
+   if (FTimer<>0) then
+    CloseHandle (FTimer);
+   FTermEvent.Free;
+   FRunning:= false;
+   FMainService:= nil;
+   Terminate;
+   FLock.Free;
+   inherited;
+{$IFDEF DEBUG}
+   WriteLn('OK');
+{$ENDIF}
+  end;
+
+
+
+ procedure THeoWestraDataPumpFileThread.TerminatedSet;
+  begin
+   FTermEvent.SetEvent;
+  end;
+
+
+
+ procedure THeoWestraDataPumpFileThread.ThreadTerminate;
+  begin
+   Terminate;
+   WaitFor;
+  end;
+
+
+
+ procedure THeoWestraDataPumpFileThread.Execute;
+  const _Second = 10_000_000;
+  var lSQL, errMsg, url, outData, scanPath, fName, fNameP1, fNameP2, fNameP3, fNameP4, fNameP5, loopCasTyp: string;
+      cisloZak, skp, selFile, fileExt: string;
+      idKmen: integer;
+      seznamNazvu: TList<string>;
+      fNames, castiName: TStringDynArray;
+      srchPatterns: array[0..2] of string;
+      srchPattern: string;
+
+      lLoop, idDigiFile, i, cnt, idx, fCount: Integer;
+      lLoopMax, koefProCas: integer;
+      logRunCnt: integer;
+      Msg: TMsg;
+      firstRun, inProg, inDL: boolean;
+      lQry: TFDQuery;
+      sqlConnX, sqlConnX2: TFDConnection;
+      sqlTrans: IFDPhysTransaction;
+
+      lBusy: LongInt;
+      liDueTime: LARGE_INTEGER;
+
+      cfgFile: string;
+      specCfgXML: XML.XmlIntf.IXMLDocument;
+      n1: XML.XmlIntf.IXMLNode;
+      attribs: IXMLNodeList;
+      attrIdx: integer;
+
+      netPath: TQTXNetworkPath;
+
+    function RemoveAlphas (const S: string): string;
+     begin
+      SetLength(result, S.Length);
+      var ResChr:= PChar(result);
+      var LActualLength:= 0;
+      for var i:=1 to S.Length do
+       if (CharInSet(s[i], ['0'..'9'])) then
+        begin
+         Inc(LActualLength);
+         ResChr^:= s[i];
+         Inc(ResChr);
+        end;
+      SetLength(result, LActualLength);
+     end;
+
+
+  begin
+   lLoop:= 0;
+   idDigiFile:= 0;
+   logRunCnt:= 1;
+
+{
+   koefProCas:= 0; // default vteriny
+   loopCasTyp:= '???';
+   case DZTaksZapisTypCas of
+    0: koefProCas:= 1;
+    1: koefProCas:= 60;
+    2: koefProCas:= 3600;
+   end;
+   lLoopMax:= koefProCas * intProcessDZTasksSec;
+   case DZTaksZapisTypCas of
+    0: loopCasTyp:= 'sek';
+    1: loopCasTyp:= 'min';
+    2: loopCasTyp:= 'hod';
+   end;
+}
+
+   lLoopMax:= 10; // v minutach !!!!
+
+   scanPath:= 'Z:\';
+   srchPatterns[0]:= '*.stp';
+   srchPatterns[1]:= '*.step';
+   srchPatterns[2]:= '*.dxf';
+
+   try
+     try
+       CoInitialize(nil);
+       cfgFile:= ExtractFilePath(ParamStr(0)) + 'westraDP.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('fileScanIntervalMin');
+               if (attrIdx>-1) then
+                if (attribs.Get(attrIdx).NodeValue<>null) then
+                 lLoopMax:= attribs.Get(attrIdx).NodeValue;
+
+               attrIdx:= attribs.IndexOf('pathToScan');
+               if (attrIdx>-1) then
+                if (attribs.Get(attrIdx).NodeValue<>null) then
+                 scanPath:= attribs.Get(attrIdx).NodeValue;
+
+              end; // n1 = config
+            end; // specCfgXML.DocumentElement<>nil
+          end; // not specCfgXML.IsEmptyDoc
+        end; // FileExists(cfgFile)
+      except
+     end;
+    finally
+     begin
+      if (specCfgXML<>nil) then
+       specCfgXML:= nil;
+      CoUninitialize;
+     end;
+   end;
+
+   datMod.LogInfo (Quick.Logger.etInfo, 'Westra DataPumpFile interval: ' + lLoopMax.ToString + ' min');
+   lLoopMax:= lLoopMax * 60; // minuty na vteriny
+
+
+   firstRun:= true;
+   inProg:= false;
+   FRunning:= true;
+
+   try
+//     netPath:= TQTXNetworkPath.Create(nil);
+//     netPath.Connect();
+    except
+   end;
+
+
+   if (1=1) then // pro rychle vypnuti
+    begin
+     FTimer:= CreateWaitableTimer (nil, true, 'WestraDataPumpFileWaitableTimer');
+     liDueTime.QuadPart:= -1*_Second;
+
+
+     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); { Create message queue }
+
+        if (lLoop=lLoopMax) or (firstRun) then  // pri startu a pak kazdou minutu
+         begin
+          firstRun:= false;
+
+          if (logRunCnt<4) then
+           datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim scan ' + logRunCnt.toString + '...');
+          if (logRunCnt=4) then
+           datMod.LogInfo (Quick.Logger.etInfo, 'Spoustim Scan - bezi ale dal neloguju');
+
+          try
+            if not(inProg) then // nebezi uz ?
+             begin
+
+              if (1=1) then // pro rychle vypnuti
+               begin
+                seznamNazvu:= TList<string>.Create;
+                try
+                  try
+                    for srchPattern in srchPatterns do
+                     begin
+                      if not(Terminated) then
+                       begin
+                        fNames:= TDirectory.GetFiles (scanPath, srchPattern, TSearchOption.soAllDirectories);
+                        seznamNazvu.AddRange (fNames);
+                       end; // Terminated
+                     end; // srchPattern
+                   except // Ignorujeme chyby p<><70>stupu (nap<61>. Permission Denied) a pokra<72>ujeme
+                    on E: EAccessViolation do ;
+                    on E: EInOutError do ;
+                  end;
+                  fNames:= seznamNazvu.ToArray;
+                 finally
+                  seznamNazvu.Free;
+                end;
+
+                if (fNames<>nil) then
+                 if (Length(fNames)>0) then
+                  begin
+                   sqlConnX:= TFDConnection.Create (nil);
+                   try
+
+                     sqlConnX.Params.SetStrings (datMod.sqlConnParams);
+  //                sqlConnX.TxOptions.AutoCommit:= false;
+                     sqlConnX.Open;
+                     lQry:= TFDQuery.Create(nil);
+                     lQry.Connection:= sqlConnX;
+
+                     for fName in fNames do
+                      begin
+                       if (Terminated) then
+                        Break;
+                       fNameP1:= fName.Replace(scanPath,'');
+                       if (LeftStr(fNameP1,1)='\') then
+                        fNameP1:= MidStr(fNameP1, 2, Length(fNameP1));
+
+                       SetLength(castiName,0);
+                       if (fNameP1.IndexOf('\')>-1) then
+                        castiName:= System.StrUtils.SplitString (fNameP1, '\');
+
+                       fNameP2:= '';
+                       cisloZak:= '';
+                       fNameP3:= '';
+                       idKmen:= 0;
+                       selFile:= '';
+                       fNameP4:= '';
+                       fNameP5:= '';
+
+                       if (Length(castiName)>0) then
+                         begin
+                          fNameP2:= castiName[0]; // zakazka W....
+                          if (Length(castiName)>1) then
+                           fNameP3:= castiName[1]; // dilec ???  (03.100.1546)
+                          if (Length(castiName)>2) then
+                           fNameP4:= castiName[2]; // adresar DFX ???
+                          if (Length(castiName)>3) then
+                           fNameP5:= castiName[3];
+                         end
+                        else
+                         begin
+                          fNameP2:= ''; // zakazka W.....
+                          if (fNameP1.IndexOf(' ')>-1) then
+                            fNameP2:= LeftStr(fNameP1, fNameP1.IndexOf(' '))
+                           else
+                            if (fNameP1.IndexOf('\')>-1) then
+                             fNameP2:= LeftStr(fNameP1, fNameP1.IndexOf('\'));
+                         end;
+
+                       if (fNameP2<>'') then
+                        begin
+                         if (fNameP2.IndexOf(' ')>-1) then
+                          fNameP2:= LeftStr(fNameP2, fNameP2.IndexOf(' '));
+                         lQry.Open ('SELECT CisloZakazky FROM ' + tblZak + ' WHERE Nazev=N' + ('W'+fNameP2).QuotedString);
+                         if (lQry.RecordCount=1) then
+                          cisloZak:= lQry.FieldByName('CisloZakazky').AsString;
+
+                         if (cisloZak<>'') and (fNameP3<>'') then
+                          begin
+                           if (Length(fNameP3)-Length(fNameP3.Replace('.',''))=2) then
+                            begin
+                             lSQL:= 'SELECT ID FROM ' + tblKZ + ' WHERE SkupZbo LIKE N''V%'' AND ISNULL(SKP,N'''')=N' + fNameP3.QuotedString;
+                             lQry.Open(lSQL);
+                             if (lQry.RecordCount=1) then
+                              idKmen:= lQry.FieldByName('ID').asInteger;
+                            end;
+
+                           if (idKmen>0) then
+                            begin
+                             if (fNameP4<>'') then
+                              for srchPattern in srchPatterns do
+                               if (fNameP4.IndexOf(srchPattern.Replace('*',''))>-1) then
+                                selFile:= fNameP4;
+                             if (selFile='') and (fNameP5<>'') then
+                              for srchPattern in srchPatterns do
+                               if (fNameP5.IndexOf(srchPattern.Replace('*',''))>-1) then
+                                selFile:= fNameP5;
+
+                             if (selFile<>'') then
+                              begin
+                               lSQL:= 'SELECT 1 FROM ' + tblDokumVaz + ' v WITH(NOLOCK) JOIN ' + tblDokum + ' d WITH(NOLOCK) ON (d.ID=v.IdDok) WHERE v.IdentVazby=8'
+                                    + ' AND v.IdTab=' + idKmen.ToString + ' AND d.Popis=N' + selFile.QuotedString + ' AND d.JmenoACesta=N' + fName.QuotedString;
+                               lQry.Open (lSQL);
+                               if (lQry.RecordCount=0) then
+                                begin
+                                 lSQL:= 'DECLARE @d INT' + CRLF + 'INSERT ' + tblDokum + ' (Popis, JmenoACesta) SELECT N' + selFile.QuotedString + ', N' + fName.QuotedString + CRLF
+                                      + 'SET @d=SCOPE_IDENTITY()' + CRLF + 'INSERT ' + tblDokumVaz + ' (IdentVazby, IdTab, IdDok) SELECT 8, ' + idKmen.ToString + ', @d';
+                                 try
+                                   sqlConnX.ExecSQL (lSQL);
+                                  except
+                                 end;
+                                end; // nemam vazbu, zaloz ji
+                              end; // selFile<>''
+                            end; // idKmen>0
+                          end; // cisloZak<>''
+
+                        end; // fNameP2<>''
+
+                      end; // for fName in fNames
+                    finally
+                    end;
+                  end;
+
+
+                if (sqlConnX.Connected) then
+                 inProg:= false;
+                if (lQry<>nil) then
+                 begin
+                  lQry.Close;
+                  FreeAndNil (lQry);
+                 end;
+                sqlConnX.Close;
+                FreeAndNil (sqlConnX);
+//                sqlConnX.Free;
+//                sqlConnX:= nil;
+
+//                datMod.LogInfo (Quick.Logger.etInfo, 'Zrusena SQL connection - downloadPDF id ' + idDigiFile.ToString);
+               end;
+             end; // not(inProg)
+
+           except on E:Exception do
+            begin
+             inProg:= false;
+             if (lQry<>nil) then
+              begin
+               lQry.Close;
+               FreeAndNil (lQry);
+              end;
+             if (sqlConnX<>nil) then
+              begin
+               if (sqlConnX.InTransaction) then
+                sqlConnX.Rollback;
+               sqlConnX.Close;
+               FreeAndNil (sqlConnX);
+//               sqlConnX.Free;
+//               sqlConnX:= nil;
+              end;
+             errMsg:= E.Message; // datMod.sqlQry11.FieldByName('ErrMsg').AsString;
+            end;
+          end;
+
+
+          lLoop:= 0;
+          if (logRunCnt<5) then
+           Inc (logRunCnt);
+         end;
+        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;
+     finally
+     end;
+
+    end;
+
+   if (sqlConnX2<>nil) then
+    begin
+     if (sqlConnX2.Connected) then
+      sqlConnX2.Close;
+     FreeAndNil (sqlConnX2);
+    end;
+
+  end;
+
+

_custom/Westra/winSvc/mainPrivs.inc

@@ -0,0 +1 @@
+    westraDataPumpFileThr: THeoWestraDataPumpFileThread;

_custom/Westra/winSvc/mainSvcCont.inc

@@ -0,0 +1,3 @@
+   if (westraDataPumpFileThr<>nil) then
+    if (westraDataPumpFileThr.Suspended) then
+     westraDataPumpFileThr.Resume;

_custom/Westra/winSvc/mainSvcExec.inc

@@ -0,0 +1,6 @@
+     if (westraDataPumpFileThr<>nil) then
+      if not(westraDataPumpFileThr.Started) then
+       begin
+        westraDataPumpFileThr.Start;
+        datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby WESTRA DataPump file');
+       end;

_custom/Westra/winSvc/mainSvcPause.inc

@@ -0,0 +1,3 @@
+   if (westraDataPumpFileThr<>nil) then
+    if not(westraDataPumpFileThr.Suspended) then
+     westraDataPumpFileThr.Suspend;

_custom/Westra/winSvc/mainSvcStart.inc

@@ -0,0 +1,12 @@
+         datMod.LogInfo (Quick.Logger.etInfo, 'Start sluzby WESTRA DataPump File - interval 10 minut...');
+{$IFDEF DEBUG}
+         WriteLn ('Start sluzby WESTRA DataPump File - inverval 10 minut...');
+{$ENDIF}
+         westraDataPumpFileThr:= THeoWestraDataPumpFileThread.Create (ThreadTerminated, self);
+         if (westraDataPumpFileThr.Started) then
+          begin
+           datMod.LogInfo (Quick.Logger.etInfo, '  OK');
+{$IFDEF DEBUG}
+           WriteLn ('  OK');
+{$ENDIF}
+          end;

_custom/Westra/winSvc/mainSvcStop.inc

@@ -0,0 +1,18 @@
+   if Assigned(westraDataPumpFileThr) then
+    begin
+{$IFDEF DEBUG}
+     WriteLn ('Ukoncuji sluzbu WESTRA DataPump File...');
+{$ENDIF}
+     datMod.LogInfo (Quick.Logger.etInfo, 'Ukoncuji sluzbu WESTRA DataPump File...');
+     try
+       westraDataPumpFileThr.ThreadTerminate;
+       FreeAndNil (westraDataPumpFileThr);
+      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');
+{$IFDEF DEBUG}
+     WriteLn ('  OK');
+{$ENDIF}
+    end;

_custom/Westra/winSvc/readCfg.inc

@@ -0,0 +1,3 @@
+
+
+fileScanIntervalMin

_custom/Westra/winSvc/types.inc

@@ -0,0 +1,48 @@
+  THeoWestraDataPumpFileThread = class(TThread)
+   private
+    FMainService: TService;
+    FLock: TCriticalSection;
+    FTermEvent: TEvent;
+    FRunning: boolean;
+    FTimer: THandle;
+   protected
+    procedure Execute; override;
+    procedure TerminatedSet; override; // XE2+ only *
+   public
+    constructor Create (AOnTerminate: TNotifyEvent; AService: TService);
+    destructor  Destroy; override;
+    procedure ThreadTerminate;
+  end;
+
+
+  TQTXNetworkPath = class(TObject)
+   private
+    FHostName:    String;
+    FRemotePath:  String;
+    FUser:        String;
+    FPassword:    String;
+    FConnected:   Boolean;
+    FOwned:       Boolean;
+    FLastError:   String;
+    FFailed:      Boolean;
+    FUNCData:     packed array[0..4096] of char;
+    FURI:         String;
+   protected
+    procedure     ClearLastError;
+    procedure     setLastError (aValue:String);
+   public
+    property      Active:Boolean read FConnected;
+    property      HostName:String read FHostName;
+    property      NetworkPath:String read FRemotePath;
+    property      LastError:String read FLastError;
+    property      Failed:Boolean read FFailed;
+ 
+    function      getRelativePath (aFilename:String): string;
+ 
+    function      Connect (aHostName:String;
+                           aNetworkPath:String;
+                           const aUsername:String='';
+                           const aPassword:String=''): boolean;
+    procedure     Disconnect (const aForce:Boolean=False);
+    destructor    Destroy;override;
+  end;

_custom/Westra/winSvc/usesTop.inc

@@ -0,0 +1 @@
+   System.Net.HttpClient, System.Threading, System.Types,

_custom/Westra/winSvc/vars.inc

@@ -0,0 +1 @@
+  intervalFileScan: integer;