351 lines
10 KiB
Plaintext
351 lines
10 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ ThdSendFiles }
|
|
{ }
|
|
{ Copyright (C) 2022 kku }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit ThdSendFiles;
|
|
|
|
interface
|
|
|
|
uses
|
|
Tocsg.Thread, System.SysUtils, System.Classes, Winapi.Windows,
|
|
IdHTTP, IdSSLOpenSSL, IdIOHandler;
|
|
|
|
type
|
|
TThdSendFilesFromDir = class(TTgThread)
|
|
protected
|
|
HTTP_: TIdHTTP;
|
|
SSL_: TIdSSLIOHandlerSocketOpenSSL;
|
|
sTgDir_,
|
|
sTaskId_: String;
|
|
bIncSubDir_: Boolean;
|
|
procedure Execute; override;
|
|
public
|
|
Constructor Create(sTgDir: String; bIncSubDir: Boolean);
|
|
Destructor Destroy; override;
|
|
|
|
property WorkState: TTgThreadState read GetWorkState;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Tocsg.Files, Tocsg.Exception, Tocsg.Safe, ManagerService, IdMultipartFormData,
|
|
Tocsg.Path, Tocsg.DateTime, superobject, ManagerModel, Tocsg.Strings,
|
|
Condition, GlobalDefine;
|
|
|
|
{ TThdSendFiles }
|
|
|
|
Constructor TThdSendFilesFromDir.Create(sTgDir: String; bIncSubDir: Boolean);
|
|
|
|
procedure InitHttp;
|
|
begin
|
|
SSL_ := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
|
SSL_.SSLOptions.Method := sslvSSLv23;
|
|
SSL_.SSLOptions.SSLVersions := [sslvTLSv1_2, sslvTLSv1_1, sslvTLSv1];
|
|
|
|
HTTP_ := TIdHTTP.Create(nil);
|
|
HTTP_.IOHandler := SSL_;
|
|
with HTTP_ do
|
|
begin
|
|
{
|
|
HandleRedirects := true;
|
|
Request.Clear;
|
|
Request.UserAgent := 'Mozilla/5.0';
|
|
Request.ContentType := 'application/xml';
|
|
Request.AcceptCharSet := 'UTF-8'; //'application/json; charset=utf-8';
|
|
Request.Connection := 'Keep-Alive';
|
|
HTTPOptions := HTTP_.HTTPOptions + [hoForceEncodeParams];
|
|
ConnectTimeout := 2000;
|
|
ReadTimeout := 2000;
|
|
}
|
|
HandleRedirects := true;
|
|
Request.Clear;
|
|
Request.UserAgent := 'Mozilla/5.0';
|
|
Request.ContentType := 'application/xml';
|
|
// Request.Accept := 'application/json; charset=utf-8';
|
|
// Request.Charset := 'utf-8';
|
|
Request.AcceptCharSet := 'UTF-8'; //'application/json; charset=utf-8';
|
|
// Request.CacheControl := 'no-store';
|
|
// Request.Connection := 'Keep-Alive';
|
|
// Request.CustomHeaders.Values['Keep-Alive'] := 'timeout=300, max=100';
|
|
Request.Connection := 'close';
|
|
HTTPOptions := HTTPOptions - [hoKeepOrigProtocol];
|
|
HTTPOptions := HTTP_.HTTPOptions + [hoForceEncodeParams];
|
|
ConnectTimeout := 2000;
|
|
ReadTimeout := 2000;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Inherited Create;
|
|
sTgDir_ := sTgDir;
|
|
bIncSubDir_ := bIncSubDir;
|
|
InitHttp;
|
|
end;
|
|
|
|
Destructor TThdSendFilesFromDir.Destroy;
|
|
begin
|
|
FreeAndNil(HTTP_);
|
|
FreeANDNil(SSL_);
|
|
Inherited;
|
|
end;
|
|
|
|
procedure TThdSendFilesFromDir.Execute;
|
|
var
|
|
sDestInfoUrl,
|
|
sDestFileUrl,
|
|
sBoundary: String;
|
|
msResp: TMemoryStream;
|
|
ss: TStringStream;
|
|
nSendCnt,
|
|
nSendSuccessCnt: Integer;
|
|
CollectKind: TFileCollectKind;
|
|
KwdList: TStringList;
|
|
|
|
procedure SendEventLog(sStatus: String);
|
|
var
|
|
O: ISuperObject;
|
|
begin
|
|
try
|
|
O := SO;
|
|
O.S['MODEL_ID'] := gMgSvc.AgentModel.AgentId;
|
|
O.S['TOCSG_LA_IFNAME'] := URI_USER_ACTION;
|
|
O.S['TOCSG_LA_ID'] := gMgSvc.AgentModel.AgentId;
|
|
O.S['TOCSG_LA_EMPID'] := gMgSvc.EmpNo;
|
|
O.S['TOCSG_LA_CODE'] := SYSEVT_FILE_COLLECT;
|
|
O.S['TOCSG_LA_DATA'] := Format('FileCnt:%d|FileSuccess:%d|Idx:%s|Status:%s',
|
|
[nSendCnt, nSendSuccessCnt, sTaskId_, sStatus]);
|
|
if IsUseHostNameOnly then
|
|
O.S['TOCSG_LA_HOSTNAME'] := gMgSvc.ComName
|
|
else
|
|
O.S['TOCSG_LA_HOSTNAME'] := gMgSvc.UserName;
|
|
|
|
O.S['TOCSG_LA_LASTCONNDATE'] := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
|
|
O.S['TOCSG_LA_MACADDR'] := gMgSvc.NicService.GetIP;
|
|
O.S['TOCSG_LA_REMOTEIP'] := gMgSvc.NicService.GetMAC;
|
|
|
|
ss.Clear;
|
|
ss.WriteString(O.AsString);
|
|
HTTP_.Request.CustomHeaders.Values['requestType'] := '123119';
|
|
HTTP_.Request.ContentType := '';
|
|
HTTP_.Post(sDestInfoUrl, ss);
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. SendEventLog()');
|
|
end;
|
|
end;
|
|
|
|
function SendFile(sPath: String): Boolean;
|
|
var
|
|
sExt,
|
|
sDpName,
|
|
sFName: String;
|
|
Params: TIdMultiPartFormDataStream;
|
|
llSize: LONGLONG;
|
|
O: ISuperObject;
|
|
begin
|
|
Result := false;
|
|
|
|
try
|
|
if not FileExists(sPath) then
|
|
begin
|
|
_Trace('Fail .. Not found file, Path=%s', [sPath]);
|
|
exit;
|
|
end;
|
|
|
|
llSize := GetFileSize_path(sPath);
|
|
if llSize > 52428800{50MB} then
|
|
begin
|
|
_Trace('Ignore .. SendFile(), LargeSize=%d .. Path=%s', [llSize, sPath]);
|
|
exit;
|
|
end;
|
|
|
|
sFName := ExtractFileName(sPath);
|
|
O := SO;
|
|
O.S['KEY_AGENT_ID'] := gMgSvc.AgentModel.AgentId;
|
|
O.S['KEY_HOSTNAME'] := gMgSvc.UserName;
|
|
O.S['KEY_EMP_ID'] := gMgSvc.EmpNo;
|
|
O.S['KEY_FILEPATH'] := ExtractFilePath(sPath);
|
|
O.S['KEY_FILENAME'] := sFName;
|
|
// O.S['KEY_FILEGUARD'] := 'true';
|
|
O.S['KEY_IDX'] := sTaskId_;
|
|
O.S['KEY_COLLECTTIME'] := FormatDateTime('YYYY-MM-DD HH_NN_SS', Now);
|
|
ss.Clear;
|
|
ss.WriteString(O.AsString);
|
|
HTTP_.Request.CustomHeaders.Values['requestType'] := '123124';
|
|
HTTP_.Request.ContentType := 'application/xml';
|
|
HTTP_.Post(sDestInfoUrl, ss);
|
|
if HTTP_.ResponseCode <> 200 then
|
|
begin
|
|
_Trace('Fail .. SendFileInfo(), Path=%s', [sPath]);
|
|
exit;
|
|
end;
|
|
|
|
sExt := GetFileExt(sFName);
|
|
if sExt = '' then
|
|
sExt := 'unknown';
|
|
|
|
sDpName := StringReplace(sPath, sTgDir_, '', [rfReplaceAll]);
|
|
if sDpName <> '' then
|
|
sDpName := StringReplace(sDpName, '\', '-;T;_', [rfReplaceAll])
|
|
else
|
|
sDpName := sFName;
|
|
|
|
// sDpName := Format('%s-TOCSG_kku-%s', [sTaskId_, sDpName]);
|
|
sDpName := Format('%s-TOCSG_%s', [sTaskId_, sDpName]);
|
|
HTTP_.Request.CustomHeaders.Values['requestType'] := '';
|
|
HTTP_.Request.ContentType := Format('multipart/form-data; boundary=%s; charset=utf-8', [sBoundary]);
|
|
Guard(Params, TIdMultiPartFormDataStream.Create);
|
|
|
|
with Params.AddFile(sDpName,
|
|
sPath, Format('application/%s', [sExt])) do
|
|
begin
|
|
ContentTransfer := '';
|
|
HeaderEncoding := '8'; //8bit
|
|
HeaderCharSet := 'utf-8';
|
|
Charset := 'utf-8';
|
|
end;
|
|
|
|
Params.Position := 0;
|
|
|
|
msResp.Clear;
|
|
HTTP_.Post(sDestFileUrl, Params, msResp);
|
|
Result := HTTP_.ResponseCode = 200;
|
|
|
|
if Result then
|
|
_Trace('파일 전송 성공 .. Path="%s"', [sPath], 2)
|
|
else
|
|
_Trace('파일 전송 실패 .. Path="%s"', [sPath], 2);
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. SendFile()');
|
|
end;
|
|
end;
|
|
|
|
procedure ExtrFilesFromDir(sDir: String; aList: TStrings);
|
|
var
|
|
wfd: TWin32FindData;
|
|
hSc: THandle;
|
|
sChk,
|
|
sPath: String;
|
|
i: Integer;
|
|
begin
|
|
sDir := IncludeTrailingPathDelimiter(sDir);
|
|
sPath := sDir + '*.*';
|
|
|
|
hSc := FindFirstFile(PChar(sPath), wfd);
|
|
if hSc = INVALID_HANDLE_VALUE then
|
|
exit;
|
|
|
|
try
|
|
Repeat
|
|
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
|
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
|
begin
|
|
if CollectKind = fckFolderIncSub then
|
|
ExtrFilesFromDir(sDir + wfd.cFileName, aList);
|
|
end else begin
|
|
if CollectKind = fckFolderFKwd then
|
|
begin
|
|
sChk := UpperCase(wfd.cFileName);
|
|
for i := 0 to KwdList.Count - 1 do
|
|
begin
|
|
if Pos(KwdList[0], sChk) > 0 then
|
|
begin
|
|
aList.Add(sDir + wfd.cFileName);
|
|
break;
|
|
end;
|
|
end;
|
|
end else
|
|
aList.Add(sDir + wfd.cFileName);
|
|
end;
|
|
Until not FindNextFile(hSc, wfd);
|
|
finally
|
|
WinApi.Windows.FindClose(hSc);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
FList: TStringList;
|
|
i: Integer;
|
|
begin
|
|
try
|
|
CollectKind := gMgSvc.PrefModel.FileCollectKind;
|
|
Guard(KwdList, TStringList.Create);
|
|
if CollectKind = fckFolderFKwd then
|
|
SplitString(UpperCase(gMgSvc.PrefModel.TgFileCollectKwd), '|', KwdList);
|
|
|
|
Guard(FList, TStringList.Create);
|
|
if FileExists(sTgDir_) then
|
|
begin
|
|
// 대상이 단일 파일일 수 있다 22_1107 13:48:43 kku
|
|
FList.Add(sTgDir_);
|
|
end else begin
|
|
sTgDir_ := IncludeTrailingPathDelimiter(sTgDir_);
|
|
if not DirectoryExists(sTgDir_) then
|
|
begin
|
|
_Trace('Fail .. Not found dir, Dir=%s', [sTgDir_]);
|
|
SetWorkState(tsFail);
|
|
exit;
|
|
end;
|
|
ExtrFilesFromDir(sTgDir_, FList);
|
|
end;
|
|
|
|
nSendCnt := FList.Count;
|
|
nSendSuccessCnt := 0;
|
|
if nSendCnt = 0 then
|
|
begin
|
|
_Trace('Fail .. Not found file, Dir=%s', [sTgDir_]);
|
|
SetWorkState(tsFail);
|
|
exit;
|
|
end;
|
|
|
|
sTaskId_ := FormatDateTime('hhnnss', Now) + StringReplace(gMgSvc.UserName, '\', '', [rfReplaceAll]);
|
|
if Length(sTaskId_) > 24 then
|
|
SetLength(sTaskId_, 24);
|
|
|
|
SetWorkState(tsWorking);
|
|
|
|
sDestInfoUrl := gMgSvc.DestServerUrl;
|
|
sDestFileUrl := StringReplace(gMgSvc.DestServerUrl, 'agentLogRequest.do', 'agentFileCollect.do', [rfReplaceAll]);
|
|
sDestFileUrl := StringReplace(sDestFileUrl, 'agentLogRequests.do', 'agentFileCollect.do', [rfReplaceAll]);
|
|
sBoundary := Format('%X', [GetLocalIncUtcMin * 6000]);
|
|
// HTTP_.Request.ContentType := Format('multipart/form-data; boundary=%s; charset=utf-8', [sBoundary]);
|
|
|
|
Guard(ss, TStringStream.Create('', TEncoding.UTF8));
|
|
SendEventLog('Start');
|
|
|
|
Guard(msResp, TMemoryStream.Create);
|
|
for i := 0 to FList.Count - 1 do
|
|
begin
|
|
if Terminated or GetWorkStop then
|
|
begin
|
|
_Trace('Stop .. send file, %d / %d', [i, FList.Count]);
|
|
SendEventLog('Fail');
|
|
SetWorkState(tsStop);
|
|
exit;
|
|
end;
|
|
|
|
if SendFile(FList[i]) then
|
|
Inc(nSendSuccessCnt);
|
|
end;
|
|
|
|
SendEventLog('Complete');
|
|
SetWorkState(tsCompleted);
|
|
_Trace('Completed .. Collect files from folder="%s"', [sTgDir_], 1);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
SetWorkState(tsFail);
|
|
ETgException.TraceException(Self, E, 'Fail .. Execute()');
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
end.
|