500 lines
15 KiB
PHP
500 lines
15 KiB
PHP
// ###########################################################
|
||
// 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;
|
||
|
||
|