BSOne.SFC/eCrmHE/EXE_eCrmHomeEdition/ContentSearch/DProgCttSchTask.pas

780 lines
21 KiB
Plaintext

unit DProgCttSchTask;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
Tocsg.Thread, Vcl.ExtCtrls, IdHTTP, IdSSLOpenSSL,
System.Generics.Collections;
type
TCsRstTaskKind = (cstkEnc, cstkDelete, cstkExcept, cstkQuarantine, cstkCampExcept, cstkPerDelete);
TRstEntState = (resWait, resVul, resEnc, resDel, resExcept, resQuarantine);
PRstEnt = ^TRstEnt;
TRstEnt = record
sSchId,
sSchName,
sExt,
sFName,
sFrName,
sDir,
sFoundStr: String;
llSize: LONGLONG;
dtCreate,
dtModify,
dtAccess: TDateTime;
nHits,
nImgIdx,
nNodeIdx: Integer;
State: TRstEntState;
end;
TRstEntList = TList<PRstEnt>;
TThdCsRstTask = class(TTgThread)
protected
TaskKind_: TCsRstTaskKind;
EntList_,
FailList_: TRstEntList;
llProc_,
llFail_,
llTotal_: LONGLONG;
sProcFile_: String;
HTTP_: TIdHTTP;
SSL_: TIdSSLIOHandlerSocketOpenSSL;
procedure InitHttp;
procedure ProcessRstEnc;
procedure ProcessRstDelete(bDetail: Boolean);
procedure ProcessRstExcept;
procedure ProcessRstCampExcept;
procedure ProcessRstQuarantine;
procedure Execute; override;
public
Constructor Create(aKind: TCsRstTaskKind; aEntList: TRstEntList);
Destructor Destroy; override;
property WorkState: TTgThreadState read GetWorkState;
end;
TDlgProgCttSchTask = class(TForm)
lbMsg: TLabel;
pg: TProgressBar;
lbProg: TLabel;
btnStop: TButton;
tProg: TTimer;
procedure tProgTimer(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
ThdCsRstTask_: TThdCsRstTask;
llTotal_: LONGLONG;
public
{ Public declarations }
Constructor Create(aOwner: TComponent; aKind: TCsRstTaskKind; aEntList: TRstEntList);
procedure CreateParams(var Params: TCreateParams); override; // 작업표시줄에 표시
Destructor Destroy; override;
end;
var
DlgProgCttSchTask: TDlgProgCttSchTask;
implementation
uses
Tocsg.Encrypt, GlobalDefine, Tocsg.Exception, Tocsg.Safe, Tocsg.DRM.Encrypt,
ManagerService, Condition, Tocsg.Files, DFailFileList, superobject,
IdMultipartFormData, Tocsg.DateTime, Tocsg.Path, Tocsg.Delete, ManagerModel,
Tocsg.FileInfo, Tocsg.Trace, Tocsg.AIP, Tocsg.Fasoo, Tocsg.Convert,
Tocsg.Strings, Tocsg.Disk;
resourcestring
RS_MsgProcDrm = 'DRM을 적용 합니다.';
RS_MsgDelete = '파일을 완전삭제 합니다.';
RS_Q_Stop = '작업을 중지 하시겠습니까?';
RS_Success = '성공';
RS_Fail = '실패';
RS_MsgFailWork = '작업을 실패했습니다. Error=%d';
RS_Close = '닫기';
{$R *.dfm}
{ TThdCsRstTask }
Constructor TThdCsRstTask.Create(aKind: TCsRstTaskKind; aEntList: TRstEntList);
begin
Inherited Create;
TaskKind_ := aKind;
EntList_ := aEntList;
FailList_ := TRstEntList.Create;
HTTP_ := nil;
SSL_ := nil;
llProc_ := 0;
llFail_ := 0;
llTotal_ := EntList_.Count;
end;
Destructor TThdCsRstTask.Destroy;
begin
FreeAndNil(FailList_);
if HTTP_ <> nil then
FreeAndNil(HTTP_);
if SSL_ <> nil then
FreeAndNil(SSL_);
Inherited;
end;
procedure TThdCsRstTask.InitHttp;
begin
if (HTTP_ = nil) and (SSL_ = nil) then
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.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;
end;
procedure TThdCsRstTask.ProcessRstEnc;
var
i, nResult: Integer;
sEmpNo,
sHost,
sDept,
sPoName,
sPath,
sPass,
sTemp,
sTaskDir,
sTgEncPath: String;
enc: TTgDrmEnc;
bSuccess: Boolean;
fas: TTgFasoo;
begin
try
sEmpNo := gMgSvc.EmpNo;
sHost := gMgSvc.UserName;
sDept := gMgSvc.DeptName;
if sDept = '' then
sDept := gMgSvc.PrefModel.DeptName;
sPoName := gMgSvc.PrefModel.PolicyName;
sTaskDir := 'C:\ProgramData\HE\EncTask\';
sPass := GetMK;
if not ForceDirectories(sTaskDir) then
begin
nLastError_ := 1;
SetWorkState(tsFail);
_Trace('Fail .. CreateTaskDir()');
exit;
end;
if CUSTOMER_TYPE = CUSTOMER_LOTTEMART then
begin
SetDSD_CODE(DSD_CODE_LOTTEMART);
var sFsDir: String := GetRunExePathDir + 'fsdinit';
if not DirectoryExists(sFsDir) then
sFsDir := GetRunExePathDir + DIR_CONF + 'fsdinit';
fas := TTgFasoo.Create(sFsDir);
end else
fas := nil;
try
for i := 0 to EntList_.Count - 1 do
begin
if Terminated or GetWorkStop then
begin
SetWorkState(tsStop);
exit;
end;
Inc(llProc_);
try
sPath := EntList_[i].sDir + EntList_[i].sFName;
sProcFile_ := EntList_[i].sFName;
sTgEncPath := GetSameFileNameInc(sTaskDir + '$Tmp' + ExtractFileName(sPath));
if FileExists(sPath) then
begin
if IsAipEncryted(sPath) then
begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
continue;
end;
bSuccess := false;
if fas <> nil then
begin
nResult := fas.GetFileType(sPath);
case nResult of
29 : ;
103, 106 :
begin
EntList_[i].State := resEnc;
continue;
end;
else begin
// 29 = 일반파일이 아니면 넘김 25_0108 11:18:18 kku
_Trace('Fail .. FASOO DRM .. Unknown Type=%d', [nResult]);
continue;
end;
end;
if not MoveFile_wait(sPath, sTgEncPath, 3) then
begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
continue;
end;
SaveStrToFile(sTgEncPath + '.i', sPath, TEncoding.UTF8);
nResult := -1;
if fas.DoPackagingFsn2(sTgEncPath, sPath, @nResult) then
begin
DeleteFile(PChar(sTgEncPath));
DeleteFile(PChar(sTgEncPath + '.i'));
EntList_[i].State := resEnc;
bSuccess := true;
end else begin
_Trace('Fail .. FASOO DRM .. Code=%d', [nResult]);
MoveFile_wait(sTgEncPath, sPath, 3);
DeleteFile(PChar(sTgEncPath + '.i'));
Inc(llFail_);
end;
end else begin
if TTgEncrypt.CheckSign(sPath, SIG_DRM) then
begin
EntList_[i].State := resEnc;
continue;
end;
if not MoveFile_wait(sPath, sTgEncPath, 3) then
begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
continue;
end;
SaveStrToFile(sTgEncPath + '.i', sPath, TEncoding.UTF8);
enc := TTgDrmEnc.Create(sPath);
try
enc.SetHaed(PASS_DRM_HEAD, SIG_DRM, sEmpNo, sHost, sDept, sPoName, CUSTOMER_TYPE);
if enc.EncryptFromFile(sPass, sTgEncPath) then
begin
DeleteFile(PChar(sTgEncPath));
DeleteFile(PChar(sTgEncPath + '.i'));
EntList_[i].State := resEnc;
bSuccess := true;
end;
finally
FreeAndNil(enc);
end;
if not bSuccess then
begin
MoveFile_wait(sTgEncPath, sPath, 3);
DeleteFile(PChar(sTgEncPath + '.i'));
Inc(llFail_);
end;
end;
if bSuccess then
begin
if gMgSvc.IsNewApi then
begin
var LogInfo: TLogInfo;
ZeroMemory(@LogInfo, SizeOf(LogInfo));
LogInfo.sCode := PREVENT_DRM_ENCRYPT;
LogInfo.sPath := sPath;
LogInfo.sSummary := BooleanToStr(CUSTOMER_TYPE = CUSTOMER_LOTTEMART, '[FASOO DRM] ', '[DRM] ') + ExtractFileName(sPath);
gMgSvc.SendEventLogEx(@LogInfo, false);
end else
gMgSvc.SendEventLog(URI_USER_ACTION, PREVENT_DRM_ENCRYPT, sPath);
end else begin
// 실패 시 복구 추가 24_0827 13:48:21 kku
MoveFile_wait(sTgEncPath, sPath, 3);
DeleteFile(PChar(sTgEncPath + '.i'));
TTgTrace.T('Fail .. ProcessRstEnc.EncFile(), Path=%s', [sPath]);
end;
end else
EntList_[i].State := resDel;
except
on E: Exception do
begin
ETgException.TraceException(Self, E, 'Fail .. ProcessEnc()');
FailList_.Add(EntList_[i]);
Inc(llFail_);
end;
end;
end;
finally
if fas <> nil then
FreeAndNil(fas);
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRstEnc()');
end;
end;
procedure TThdCsRstTask.ProcessRstDelete(bDetail: Boolean);
var
i: Integer;
sPath, sTmpDirName: String;
enc: TTgDrmEnc;
begin
try
if bDetail then
sTmpDirName := '@TmpPd\'
else
sTmpDirName := '';
for i := 0 to EntList_.Count - 1 do
begin
if Terminated or GetWorkStop then
begin
SetWorkState(tsStop);
exit;
end;
Inc(llProc_);
sPath := EntList_[i].sDir + EntList_[i].sFName;
sProcFile_ := EntList_[i].sFName;
if FileExists(sPath) then
begin
if not PerfectDeleteFile(sPath, 3, bDetail, sTmpDirName) then
begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
end else
EntList_[i].State := resDel;
end else
EntList_[i].State := resDel;
end;
if bDetail and (sTmpDirName <> '') then
begin
var dwMask: DWORD := GetLogicalDrives;
var ucDrive: Byte;
var cDrive: Char;
for ucDrive := 0 to 31 do
if (dwMask and (1 shl ucDrive)) > 0 then
begin
cDrive := Char(ucDrive + 65);
sPath := cDrive + ':\' + sTmpDirName;
if DirectoryExists(sPath) then
DeleteDir(sPath);
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRstEnc()');
end;
end;
procedure TThdCsRstTask.ProcessRstExcept;
var
i: Integer;
sPath: String;
enc: TTgDrmEnc;
begin
try
for i := 0 to EntList_.Count - 1 do
begin
if Terminated or GetWorkStop then
begin
SetWorkState(tsStop);
exit;
end;
Inc(llProc_);
sPath := EntList_[i].sDir + EntList_[i].sFName;
sProcFile_ := EntList_[i].sFName;
if FileExists(sPath) then
begin
if not gMgSvc.MgCttSchExp.AddFileHash(sPath) then
begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
end else
EntList_[i].State := resExcept;
end else
EntList_[i].State := resDel;
end;
gMgSvc.MgCttSchExp.Save;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRstEnc()');
end;
end;
procedure TThdCsRstTask.ProcessRstCampExcept;
var
i: Integer;
sPath: String;
enc: TTgDrmEnc;
MgCampExpt: TManagerCampExcept;
begin
try
Guard(MgCampExpt, TManagerCampExcept.Create);
for i := 0 to EntList_.Count - 1 do
begin
if Terminated or GetWorkStop then
begin
SetWorkState(tsStop);
exit;
end;
Inc(llProc_);
sPath := EntList_[i].sDir + EntList_[i].sFName;
sProcFile_ := EntList_[i].sFName;
if FileExists(sPath) and not MgCampExpt.IsExceptFile(sPath) then
begin
MgCampExpt.AddFile(sPath);
EntList_[i].State := resExcept;
end else
EntList_[i].State := resDel;
end;
MgCampExpt.Save;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRstEnc()');
end;
end;
procedure TThdCsRstTask.ProcessRstQuarantine;
var
// nTaskLenMax,
i, nSendCnt, nSendSuccessCnt: Integer;
sTaskId, sPath, sDestFileUrl, sDestInfoUrl, sBoundary: String;
ss: TStringStream;
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(sTaskId, sPath: String; sBoundary: String = ''; sTgDir: String = ''): Boolean;
var
sExt,
sDpName,
sFName: String;
Params: TIdMultiPartFormDataStream;
llSize: LONGLONG;
O: ISuperObject;
msResp: TMemoryStream;
begin
Result := false;
try
if not FileExists(sPath) then
begin
_Trace('SendFile() .. Fail .. Not found file, Path=%s', [sPath]);
exit;
end;
llSize := GetFileSize_path(sPath);
if llSize > 52428800{50MB} then
begin
_Trace('SendFile() .. Ignore .. 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('SendFile() .. Fail .. Path=%s', [sPath]);
exit;
end;
sExt := GetFileExt(sFName);
if sExt = '' then
sExt := 'unknown';
sDpName := sFName;
if sTgDir <> '' then
begin
sDpName := StringReplace(sPath, sTgDir, '', [rfReplaceAll]);
if sDpName <> '' then
sDpName := StringReplace(sDpName, '\', '-;T;_', [rfReplaceAll]);
end;
sDpName := Format('%s-BS1_%s', [sTaskId, sDpName]);
HTTP_.Request.CustomHeaders.Values['requestType'] := '';
if sBoundary <> '' then
HTTP_.Request.ContentType := Format('multipart/form-data; boundary=%s; charset=utf-8', [sBoundary])
else
HTTP_.Request.ContentType := 'multipart/form-data; charset=utf-8';
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;
Guard(msResp, TMemoryStream.Create);
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(E, 'Fail .. SendFile()');
end;
end;
begin
InitHttp;
try
// if IsCampaignTaskIdLong then
// sTaskId := FormatDateTime('yymmddhhnnss', Now) + StringReplace(gMgSvc.UserName, '\', '', [rfReplaceAll])
// else
// sTaskId := FormatDateTime('hhnnss', Now) + StringReplace(gMgSvc.UserName, '\', '', [rfReplaceAll]);
//
// if gMgSvc.IsNewApi then
// begin
// if IsCampaignTaskIdLong then
// nTaskLenMax := 64
// else
// nTaskLenMax := 32
// end else
// nTaskLenMax := 24;
//
// if Length(sTaskId) > nTaskLenMax then
// SetLength(sTaskId, nTaskLenMax);
sTaskId := FormatDateTime('hhnnss', Now) + StringReplace(gMgSvc.UserName, '\', '', [rfReplaceAll]);
if Length(sTaskId) > 24 then
SetLength(sTaskId, 24);
sDestInfoUrl := gMgSvc.DestServerUrl;
sDestFileUrl := StringReplace(sDestInfoUrl, 'agentLogRequest.do', 'agentFileCollect.do', [rfReplaceAll]);
sDestFileUrl := StringReplace(sDestFileUrl, 'agentLogRequests.do', 'agentFileCollect.do', [rfReplaceAll]);
Guard(ss, TStringStream.Create('', TEncoding.UTF8));
nSendSuccessCnt := 0;
nSendCnt := EntList_.Count;
SendEventLog('Start');
sBoundary := Format('%X', [GetLocalIncUtcMin * 6000]);
for i := 0 to nSendCnt - 1 do
begin
if Terminated or GetWorkStop then
begin
SetWorkState(tsStop);
exit;
end;
Inc(llProc_);
sPath := EntList_[i].sDir + EntList_[i].sFName;
sProcFile_ := EntList_[i].sFName;
if FileExists(sPath) then
begin
if SendFile(sTaskId, sPath, sBoundary) then
begin
Inc(nSendSuccessCnt);
EntList_[i].State := resQuarantine;
DeleteFileForce(sPath);
end else begin
FailList_.Add(EntList_[i]);
Inc(llFail_);
end;
end;
end;
SendEventLog('Complete');
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRstQuarantine()');
end;
end;
procedure TThdCsRstTask.Execute;
begin
SetWorkState(tsWorking);
case TaskKind_ of
cstkEnc : ProcessRstEnc;
cstkDelete : ProcessRstDelete(false);
cstkPerDelete : ProcessRstDelete(true);
cstkExcept : ProcessRstExcept;
cstkQuarantine : ProcessRstQuarantine;
cstkCampExcept : ProcessRstCampExcept;
end;
if not Terminated and not GetWorkStop then
SetWorkState(tsCompleted)
else
SetWorkState(tsStop);
end;
{ TDlgProgCttSchTask }
Constructor TDlgProgCttSchTask.Create(aOwner: TComponent; aKind: TCsRstTaskKind; aEntList: TRstEntList);
begin
Inherited Create(aOwner);
llTotal_ := aEntList.Count;
ThdCsRstTask_ := TThdCsRstTask.Create(aKind, aEntList);
ThdCsRstTask_.StartThread;
case aKind of
cstkEnc : Caption := RS_MsgProcDrm;
cstkDelete : Caption := RS_MsgDelete;
end;
tProg.Enabled := true;
end;
procedure TDlgProgCttSchTask.CreateParams(var Params: TCreateParams);
begin
Inherited CreateParams(Params);
Params.ExStyle := WS_EX_APPWINDOW;
end;
Destructor TDlgProgCttSchTask.Destroy;
begin
FreeAndNil(ThdCsRstTask_);
Inherited;
end;
procedure TDlgProgCttSchTask.btnStopClick(Sender: TObject);
begin
if not ThdCsRstTask_.WorkStop then
begin
if MessageBox(Handle, PChar(RS_Q_Stop),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
ThdCsRstTask_.StopThread;
end else Close;
end;
procedure TDlgProgCttSchTask.tProgTimer(Sender: TObject);
var
sFName: String;
llProc,
llFail: LONGLONG;
begin
if ThdCsRstTask_ = nil then
begin
tProg.Enabled := false;
exit;
end;
case ThdCsRstTask_.WorkState of
tsWorking :
begin
sFName := ThdCsRstTask_.sProcFile_;
if sFName <> '' then
lbMsg.Caption := sFName;
llProc := ThdCsRstTask_.llProc_;
llFail := ThdCsRstTask_.llFail_;
pg.Position := (llProc * 100) div llTotal_;
lbProg.Caption := Format('%d / %d, %s : %d, %s : %d',
[llProc, llTotal_, RS_Success, llProc - llFail, RS_Fail, llFail]);
end;
tsStop,
tsCompleted :
begin
tProg.Enabled := false;
pg.Position := pg.Max;
if ThdCsRstTask_.FailList_.Count > 0 then
begin
var dlg: TDlgFailFileList;
Guard(dlg, TDlgFailFileList.Create(Self, ThdCsRstTask_.FailList_));
dlg.ShowModal;
end;
Close;
end;
tsFail :
begin
tProg.Enabled := false;
lbMsg.Caption := Format(RS_MsgFailWork, [ThdCsRstTask_.LastError]);
btnStop.Caption := RS_Close;
end;
end;
Application.ProcessMessages;
end;
end.