Dalsi zmeny
This commit is contained in:
3
_custom/Westra/customDefs.inc
Normal file
3
_custom/Westra/customDefs.inc
Normal file
@ -0,0 +1,3 @@
|
||||
,uHeOObj_Custom in '_custom\Westra\uHeOObj_Custom.pas'
|
||||
,uCtrlCustom in '_custom\Westra\uCtrlCustom.pas'
|
||||
,uSvcCustom in '_custom\Westra\uSvcCustom.pas'
|
||||
1
_custom/Westra/sqlDefs.inc
Normal file
1
_custom/Westra/sqlDefs.inc
Normal file
@ -0,0 +1 @@
|
||||
// arrDefs.Add('ep_HDCDZApi_ZpracujPrijataData');
|
||||
106
_custom/Westra/uCtrlCustom.pas
Normal file
106
_custom/Westra/uCtrlCustom.pas
Normal file
@ -0,0 +1,106 @@
|
||||
unit uCtrlCustom;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCframework,
|
||||
MVCframework.Commons,
|
||||
MVCframework.Serializer.Commons,
|
||||
// MVCframework.Serializer.Intf,
|
||||
System.Generics.Collections, // kvuli TDictionary
|
||||
System.RegularExpressions,
|
||||
// JsonDataObjects,
|
||||
uCommons, // kvuli EServiceException
|
||||
uCtrlBase,
|
||||
// uSvc_Base,
|
||||
helTabsBIDs,
|
||||
uHeOObj_Base,
|
||||
uHeOObj_Custom,
|
||||
uSvcCustom,
|
||||
MVCFramework.Swagger.Commons; // kvuli dokumentaci
|
||||
|
||||
type
|
||||
|
||||
[MVCPath('/westra')]
|
||||
TWestraController = class(TBaseController)
|
||||
{
|
||||
strict private
|
||||
FSelfSvc: TWestraService;
|
||||
strict protected
|
||||
function GetWestraService: TWestraService;
|
||||
}
|
||||
public
|
||||
destructor Destroy; override;
|
||||
|
||||
// [MVCDoc('Pomoc<6F> POST zap<61><70>e obecn<63> json data do Heliosu')]
|
||||
[MVCPath('/zapisjson')] // zapis obecnych json data do Heliosu
|
||||
[MVCHTTPMethod([httpPOST])]
|
||||
[MVCSwagSummary('MBM Westra', 'Z<>pis JSON dat do db Heliosu', 'GORZapisJSONDoHeliosu')]
|
||||
[MVCConsumes(TMVCMediaType.APPLICATION_JSON)]
|
||||
procedure ZapisJSONDoHeliosu (CTX: TWebContext);
|
||||
|
||||
[MVCPath('/nactiurl')] // zapis obecnych json data do Heliosu
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCSwagSummary('MBM Westra', 'Na<4E>te data ze zadan<61> URL adresy', 'GORNacteniDatURL')]
|
||||
[MVCSwagParam(plQuery, 'url', 'URL adresa', ptString, true)]
|
||||
procedure NactiDataZURL ([MVCFromQueryString('url', '')] sURL: string=''
|
||||
);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
FireDAC.Stan.Option,
|
||||
FireDAC.Comp.Client,
|
||||
FireDAC.Stan.Param,
|
||||
MVCFramework.FireDAC.Utils,
|
||||
MVCFramework.DataSet.Utils,
|
||||
System.StrUtils,
|
||||
System.SysUtils,
|
||||
System.JSON,
|
||||
JsonDataObjects,
|
||||
Winapi.ActiveX,
|
||||
uDataMod,
|
||||
Quick.Logger;
|
||||
|
||||
const
|
||||
selSloupce = '';
|
||||
|
||||
|
||||
|
||||
|
||||
{ TWestraController }
|
||||
destructor TWestraController.Destroy;
|
||||
begin
|
||||
// FSelfSvc.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TWestraController.ZapisJSONDoHeliosu (CTX: TWebContext);
|
||||
var respData, jsonData: string;
|
||||
// o: System.JSON.TJSONObject;
|
||||
begin
|
||||
respData:= '';
|
||||
try
|
||||
jsonData:= CTX.Request.Body.Trim;
|
||||
if (jsonData<>'') then
|
||||
GetWestraService.ZapisJsonDoHeliosu (jsonData, respData);
|
||||
ResponseStatus(HTTP_STATUS.OK, 'OK');
|
||||
Render(respData);
|
||||
except
|
||||
RenderStatusMessage (200);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TWestraController.NactiDataZURL (sURL: string = '');
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
7
_custom/Westra/uHeOObj_Custom.pas
Normal file
7
_custom/Westra/uHeOObj_Custom.pas
Normal file
@ -0,0 +1,7 @@
|
||||
unit uHeOObj_Custom;
|
||||
{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) FIELDS([vcPrivate, vcProtected, vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}
|
||||
|
||||
|
||||
interface
|
||||
implementation
|
||||
end.
|
||||
140
_custom/Westra/uSvcCustom.pas
Normal file
140
_custom/Westra/uSvcCustom.pas
Normal file
@ -0,0 +1,140 @@
|
||||
unit uSvcCustom;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Classes,
|
||||
System.JSON,
|
||||
System.Generics.Collections,
|
||||
Winapi.ActiveX,
|
||||
System.DateUtils,
|
||||
System.SysUtils,
|
||||
JsonDataObjects,
|
||||
uSvc_Base,
|
||||
uCommons, // kvuli EServiceException
|
||||
helTabsBIDs,
|
||||
uHeoObj_Base,
|
||||
uHeOObj_Custom,
|
||||
uHeoObj_Vyroba,
|
||||
uSvc_ObehZbozi,
|
||||
uSvc_Vyroba;
|
||||
|
||||
|
||||
const
|
||||
CRLF = #13#10;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TWestraService = class(TServiceBase)
|
||||
public
|
||||
procedure ZapisJsonDoHeliosu (jsonData: string; var respString: string);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
System.StrUtils,
|
||||
FireDAC.Stan.Option,
|
||||
FireDAC.Comp.Client,
|
||||
FireDAC.Stan.Param,
|
||||
MVCFramework.FireDAC.Utils,
|
||||
MVCFramework.DataSet.Utils,
|
||||
MVCFramework.Serializer.Commons;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TWestraService }
|
||||
|
||||
procedure TWestraService.ZapisJsonDoHeliosu (jsonData: string; var respString: string);
|
||||
var lSQL, taskStr, strTmp, strTmp2, code, rs, guidIdent: string;
|
||||
guid: TGuid;
|
||||
akce: string;
|
||||
j, t, a, v: JsonDataObjects.TJSONObject;
|
||||
i, ii, taskDZId, taskId, intTemp, idJSON: integer;
|
||||
jeOld: boolean;
|
||||
lQry: TFDQuery;
|
||||
w: TStreamWriter;
|
||||
jo: System.JSON.TJsonObject;
|
||||
begin
|
||||
idJSON:= 0;
|
||||
respString:= '[';
|
||||
|
||||
jo:= System.JSON.TJsonObject.Create;
|
||||
|
||||
jsonData:= jsonData.Trim;
|
||||
if (jsonData<>'') then
|
||||
begin
|
||||
lQry:= TFDQuery.Create(nil);
|
||||
try
|
||||
lQry.Connection:= FDM.sqlConn;
|
||||
try
|
||||
CoCreateGuid(guid);
|
||||
if (System.SysUtils.CreateGUID(guid)=S_OK) then
|
||||
guidIdent:= System.SysUtils.GUIDToString(guid)
|
||||
else
|
||||
guidIdent:= self.NewUUID32;
|
||||
lSQL:= 'INSERT ' + tblPrijataJsonData + ' (IdPHIdent, GUIDIdent, JSONData) SELECT 0, CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + '), N' + jsonData.QuotedString;
|
||||
FDM.sqlConn.ExecSQL(lSQL);
|
||||
lSQL:= 'SELECT ID FROM ' + tblPrijataJsonData + ' WHERE GUIDIdent=CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + ')';
|
||||
lQry.Open(lSQL);
|
||||
if (lQry.RecordCount=1) then
|
||||
begin
|
||||
idJSON:= lQry.FieldByName('ID').AsInteger;
|
||||
respString:= 'OK';
|
||||
jo.AddPair('heliosid', idJSON.ToString);
|
||||
end;
|
||||
except on E:Exception do
|
||||
begin
|
||||
respString:= 'NOT OK';
|
||||
raise EServiceException.Create('Chyba zápisu JSON dat: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(lQry);
|
||||
end;
|
||||
|
||||
|
||||
CoInitialize(nil);
|
||||
j:= TJsonObject.Parse(jsonData) as JsonDataObjects.TJsonObject;
|
||||
try
|
||||
if (j<>nil) then
|
||||
if (j.Contains('akce')) then
|
||||
begin
|
||||
akce:= j.S['akce'].Trim;
|
||||
if (idJSON>0) and (akce<>'') then
|
||||
FDM.sqlConn.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Akce=N' + akce.QuotedString + ' WHERE ID=' + idJSON.ToString);
|
||||
{
|
||||
for i:=0 to j['tasks'].Count-1 do
|
||||
begin
|
||||
try
|
||||
t:= j['tasks'].Items[i];
|
||||
taskDZId:= t.I['id']; // j['tasks'].Items[i].I['id'];
|
||||
taskStr:= j['tasks'].Items[i].ObjectValue.ToString;
|
||||
except on E:Exception do
|
||||
end;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
finally
|
||||
j.Free;
|
||||
end;
|
||||
CoUninitialize;
|
||||
|
||||
end
|
||||
else
|
||||
respString:= 'NO input data';
|
||||
|
||||
jo.AddPair('status', respString);
|
||||
respString:= '[' +respString + ']';
|
||||
|
||||
respString:= jo.ToString;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
2
_custom/Westra/uWebModCustom.inc
Normal file
2
_custom/Westra/uWebModCustom.inc
Normal file
@ -0,0 +1,2 @@
|
||||
FEngine.AddController (TWestraController);
|
||||
|
||||
2
_custom/Westra/westraDP.xml
Normal file
2
_custom/Westra/westraDP.xml
Normal file
@ -0,0 +1,2 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<config fileScanIntervalMin="10" pathToScan="C:\_zakaznici\pluginy_obecne\HDCApi2\_custom\Westra\test"/>
|
||||
0
_custom/Westra/winSvc/consts.inc
Normal file
0
_custom/Westra/winSvc/consts.inc
Normal file
499
_custom/Westra/winSvc/impl.inc
Normal file
499
_custom/Westra/winSvc/impl.inc
Normal file
@ -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;
|
||||
|
||||
|
||||
1
_custom/Westra/winSvc/mainPrivs.inc
Normal file
1
_custom/Westra/winSvc/mainPrivs.inc
Normal file
@ -0,0 +1 @@
|
||||
westraDataPumpFileThr: THeoWestraDataPumpFileThread;
|
||||
3
_custom/Westra/winSvc/mainSvcCont.inc
Normal file
3
_custom/Westra/winSvc/mainSvcCont.inc
Normal file
@ -0,0 +1,3 @@
|
||||
if (westraDataPumpFileThr<>nil) then
|
||||
if (westraDataPumpFileThr.Suspended) then
|
||||
westraDataPumpFileThr.Resume;
|
||||
6
_custom/Westra/winSvc/mainSvcExec.inc
Normal file
6
_custom/Westra/winSvc/mainSvcExec.inc
Normal file
@ -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;
|
||||
3
_custom/Westra/winSvc/mainSvcPause.inc
Normal file
3
_custom/Westra/winSvc/mainSvcPause.inc
Normal file
@ -0,0 +1,3 @@
|
||||
if (westraDataPumpFileThr<>nil) then
|
||||
if not(westraDataPumpFileThr.Suspended) then
|
||||
westraDataPumpFileThr.Suspend;
|
||||
12
_custom/Westra/winSvc/mainSvcStart.inc
Normal file
12
_custom/Westra/winSvc/mainSvcStart.inc
Normal file
@ -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;
|
||||
18
_custom/Westra/winSvc/mainSvcStop.inc
Normal file
18
_custom/Westra/winSvc/mainSvcStop.inc
Normal file
@ -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;
|
||||
3
_custom/Westra/winSvc/readCfg.inc
Normal file
3
_custom/Westra/winSvc/readCfg.inc
Normal file
@ -0,0 +1,3 @@
|
||||
|
||||
|
||||
fileScanIntervalMin
|
||||
48
_custom/Westra/winSvc/types.inc
Normal file
48
_custom/Westra/winSvc/types.inc
Normal file
@ -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;
|
||||
0
_custom/Westra/winSvc/uses.inc
Normal file
0
_custom/Westra/winSvc/uses.inc
Normal file
1
_custom/Westra/winSvc/usesTop.inc
Normal file
1
_custom/Westra/winSvc/usesTop.inc
Normal file
@ -0,0 +1 @@
|
||||
System.Net.HttpClient, System.Threading, System.Types,
|
||||
1
_custom/Westra/winSvc/vars.inc
Normal file
1
_custom/Westra/winSvc/vars.inc
Normal file
@ -0,0 +1 @@
|
||||
intervalFileScan: integer;
|
||||
BIN
_custom/Westra/zdroje.RES
Normal file
BIN
_custom/Westra/zdroje.RES
Normal file
Binary file not shown.
0
_custom/Westra/zdroje.rc
Normal file
0
_custom/Westra/zdroje.rc
Normal file
Reference in New Issue
Block a user