// ########################################################### // 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; 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.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řístupu (např. Permission Denied) a pokrač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;