500 lines
15 KiB
ObjectPascal
500 lines
15 KiB
ObjectPascal
// ###########################################################
|
|
// 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øí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;
|
|
|
|
|