BSOne.SFC/eCrmHE/EXE_eCrmHomeEdition/Thread/ThdEvent.pas

556 lines
16 KiB
Plaintext

{*******************************************************}
{ }
{ ThdEvent }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit ThdEvent;
interface
uses
Tocsg.Thread, System.SysUtils, System.Classes, IdHTTP, IdSSLOpenSSL,
IdIOHandler, System.Generics.Collections, Tocsg.StoredPacket, Winapi.Windows;
const
NAME_STORED_HEAD = 'BS1';
type
TThdEvent = class(TTgThread)
private
sSvrAddr_: String;
HTTP_: TIdHTTP;
SSL_: TIdSSLIOHandlerSocketOpenSSL;
qData_: TQueue<String>;
// 오프라인 로그 저장
StdPkt_: TTgStoredPacket;
bUseStored_,
bIsEndSession_: Boolean;
nMaxMB_, nSaveDays_: Integer;
dwChkDayTick_: DWORD;
function HttpPost(sDest, sRqType, sParam: String): String;
protected
procedure Execute; override;
public
Constructor Create(sSvrAddr: String = '');
Destructor Destroy; override;
procedure Push(sData: String);
property IsEndSession: Boolean write bIsEndSession_;
end;
implementation
uses
{$IFDEF _HE_}
ManagerService, ManagerModel, ManagerCampaign,
{$ENDIF}
Tocsg.Exception, Tocsg.Safe, Condition, Tocsg.Encrypt, Tocsg.Path,
GlobalDefine,
Tocsg.Files, System.DateUtils, IdMultipartFormData, superobject, Tocsg.DateTime, Tocsg.Delete,
Tocsg.Process, Tocsg.Convert;
{ TThreadEvent }
Constructor TThdEvent.Create(sSvrAddr: String);
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.BasicAuthentication := 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';
// Request.CustomHeaders.Values['Keep-Alive'] := 'timeout=300, max=100';
Request.Connection := 'close';
HTTPOptions := HTTPOptions - [hoKeepOrigProtocol];
HTTPOptions := HTTP_.HTTPOptions + [hoForceEncodeParams];
if CUSTOMER_TYPE = CUSTOMER_SHCD then
begin
// 신한카드 100초
ConnectTimeout := 100000;
ReadTimeout := 100000;
end else begin
ConnectTimeout := 20000;
ReadTimeout := 20000;
end;
end;
end;
begin
StdPkt_ := TTgStoredPacket.Create(GetRunExePathDir + DIR_LOG + NAME_STORED_HEAD, ekAes256cbc);
StdPkt_.SaveFileAttrHideSystem := true;
StdPkt_.IsBlockMaxSize := true;
StdPkt_.MaxSize := 1048576000; // 기본 1기가
qData_ := TQueue<String>.Create;
Inherited Create;
sSvrAddr_ := sSvrAddr;
bUseStored_ := false;
bIsEndSession_ := false;
nMaxMB_ := 0;
nSaveDays_ := 0;
dwChkDayTick_ := 0;
InitHttp;
end;
Destructor TThdEvent.Destroy;
begin
FreeAndNil(HTTP_);
FreeANDNil(SSL_);
Inherited;
FreeAndNil(qData_);
FreeAndNil(StdPkt_);
end;
function TThdEvent.HttpPost(sDest, sRqType, sParam: String): String;
var
ss: TStringStream;
begin
Result := '';
try
if HTTP_.Request.ContentType <> 'application/xml' then
HTTP_.Request.ContentType := 'application/xml';
Guard(ss, TStringStream.Create(sParam, TEncoding.UTF8));
HTTP_.Request.CustomHeaders.Values['requestType'] := sRqType;
Result := HTTP_.Post(sDest, ss);
if (Result = '') and (HTTP_.ResponseCode = 200) then
Result := 'true';
except
// on E: EIdHTTPProtocolException do
// ETgException.TraceException ``(Self, E, 'Fail .. HttpPost()');
{$IFDEF TRACE1}
on E: Exception do
ETgException.TraceException(Self, E, Format('Fail .. HttpPost(), RqType=%s', [sRqType]));
{$ENDIF}
end;
end;
procedure TThdEvent.Push(sData: String);
begin
Lock;
try
qData_.Enqueue(sData);
finally
Unlock;
end;
end;
procedure TThdEvent.Execute;
var
msResp: TMemoryStream;
sBoundary: String;
function CheckOverOffLogDays: Boolean;
var
sPath: String;
dtCreate, dtModify, dtAccess: TDateTime;
begin
Result := false;
sPath := StdPkt_.GetFirstStoredPath;
if FileExists(sPath) then
begin
if GetFileDateTime_Local(sPath, dtCreate, dtModify, dtAccess) then
Result := DaysBetween(Now, dtCreate) > nSaveDays_;
end;
end;
function SendFile(sData: String): Boolean;
var
sExt,
sPath, sTempPath: String;
Params: TIdMultiPartFormDataStream;
llSize: LONGLONG;
O: ISuperObject;
nOpenCnt, nMinMB, nLimitMB: Integer;
bSendBin,
bSuccess: Boolean;
Label
LB_TrySendFile,
LB_TryOpenFile;
begin
Result := true; // 실패해도... 일단 무시
try
bSendBin := false;
bSuccess := false;
nOpenCnt := 0;
sTempPath := '';
O := SO(sData);
if O = nil then
exit;
sPath := O.S['Path'];
if not FileExists(sPath) then
begin
_Trace('Fail .. SendFile() .. Not found file, Path=%s', [sPath]);
Result := true;
exit;
end;
llSize := GetFileSize_path(sPath);
if llSize = 0 then
_Trace('SendFile() .. size zero .. Path=%s', [sPath]);
nMinMB := O.I['MSize'];
nLimitMB := O.I['LSize'];
bSendBin := O.B['SB'];
if nLimitMB = 0 then
nLimitMB := 20; // 0이면 기본값으로 20MB 지정 24_0819 10:45:59 kku
if (llSize < (LONGLONG(nMinMB) * 1048576)) or (llSize > (LONGLONG(nLimitMB) * 1048576)) then
begin
_Trace('Ignore .. SendFile(), Min=%d (MB), Limit=%d (MB), Size=%d .. Path=%s', [nMinMB, nLimitMB, llSize, sPath]);
exit;
end;
// if llSize > 52428800{50MB} then
// begin
// _Trace('Ignore .. SendFile(), LargeSize=%d .. Path=%s', [llSize, sPath]);
// exit;
// end;
sExt := GetFileExt(sPath);
if sExt = '' then
sExt := 'unknown';
HTTP_.Request.CustomHeaders.Values['requestType'] := '';
if bSendBin then
begin
HTTP_.Request.ContentType := 'application/octet-stream';
var fs: TFileStream := nil;
LB_TryOpenFile :
try
fs := TFileStream.Create(sPath, fmOpenRead or fmShareDenyWrite);
try
msResp.Clear;
HTTP_.Post(gMgSvc.DestIPort + O.S['API'], fs, msResp);
if (sTempPath <> '') and FileExists(sTempPath) then
gMgSvc.ThdReact.AddEnt(crtDelete, sTempPath, 3); // 그냥 지우려고 하면 안지워짐 24_0122 16:26:36 kku
bSuccess := true;
finally
fs.Free;
end;
except
on E: EFOpenError do
begin
ETgException.TraceException(Self, E, 'Fail .. SendFile() .. FileOpen(SB)');
Inc(nOpenCnt);
end;
on E: Exception do
begin
ETgException.TraceException(Self, E, 'Fail .. SendFile() .. FileOpen(SB)');
Inc(nOpenCnt);
end;
end;
if not bSuccess then
begin
if nOpenCnt = 1 then
begin
sTempPath := 'C:\ProgramData\HE\Task\';
if ForceDirectories(sTempPath) then
begin
sTempPath := sTempPath + ExtractFileName(sPath);
if CopyFile(PChar(sPath), PChar(sTempPath), false) then
begin
sPath := sTempPath;
Params.Clear;
goto LB_TryOpenFile;
end;
end;
end;
end else
bSuccess := HTTP_.ResponseCode = 200;
end else begin
HTTP_.Request.ContentType := Format('multipart/form-data; boundary=%s; charset=utf-8', [sBoundary]);
Guard(Params, TIdMultiPartFormDataStream.Create);
LB_TrySendFile :
try
with Params.AddFile(O.S['CompId'],
sPath, Format('application/%s', [sExt])) do
begin
ContentTransfer := '';
HeaderEncoding := '8'; //8bit
HeaderCharSet := 'utf-8';
Charset := 'utf-8';
end;
bSuccess := true;
except
on E: EFOpenError do
begin
ETgException.TraceException(Self, E, 'Fail .. SendFile() .. FileOpen()');
Inc(nOpenCnt);
end;
on E: Exception do
begin
ETgException.TraceException(Self, E, 'Fail .. SendFile() .. FileOpen()');
Inc(nOpenCnt);
end;
end;
if not bSuccess and (nOpenCnt = 1) then
begin
sTempPath := 'C:\ProgramData\HE\Task\';
if ForceDirectories(sTempPath) then
begin
sTempPath := sTempPath + ExtractFileName(sPath);
if CopyFile(PChar(sPath), PChar(sTempPath), false) then
begin
sPath := sTempPath;
Params.Clear;
goto LB_TrySendFile;
end;
end;
end;
if bSuccess then
begin
Params.Position := 0;
msResp.Clear;
{$IFDEF _HE_}
HTTP_.Post(gMgSvc.DestIPort + O.S['API'], Params, msResp);
bSuccess := HTTP_.ResponseCode = 200;
if (sTempPath <> '') and FileExists(sTempPath) then
gMgSvc.ThdReact.AddEnt(crtDelete, sTempPath, 3);
// DeleteFile(PChar(sTempPath)); // 그냥 지우려고 하면 안지워짐 24_0122 16:26:36 kku
{$ELSE}
HTTP_.Post(sSvrAddr_ + O.S['API'], Params, msResp);
bSuccess := HTTP_.ResponseCode = 200;
{$ENDIF}
end;
end;
if bSuccess then
begin
_Trace('파일 전송 성공 .. Path="%s"', [sPath], 2);
Result := true;
end else
_Trace('파일 전송 실패 .. Path="%s"', [sPath], 2);
{$IFDEF _HE_}
// 아래 수정 시 ManagerService.pas 에 있는 대응도 함께 수정 해야함
if TCampnRespaction(O.I['AFW']) <> crtNone then
gMgSvc.ThdReact.AddEnt(TCampnRespaction(O.I['AFW']), sPath, O.I['DSec']);
{$ENDIF}
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Evt SendFile()');
end;
end;
var
sData: String;
bResult,
bStopStored,
bConnected,
bProcStored: Boolean;
sSvrAddr,
sSvrIport: String;
{$IFDEF _HE_}
OffLogKind: TOffLogKind;
{$ENDIF}
Label
LB_SaveLog;
begin
Guard(msResp, TMemoryStream.Create);
sBoundary := Format('%X', [GetLocalIncUtcMin * 6000]);
sSvrAddr := sSvrAddr_;
bProcStored := false;
bStopStored := false;
bConnected := true;
while not Terminated and not GetWorkStop do
begin
try
{$IFDEF _HE_}
bConnected := gMgSvc.Connected;
// if not gMgSvc.Connected then
// begin
// Sleep(1000);
// continue;
// end;
sSvrAddr := gMgSvc.DestServerUrl;
sSvrIport := gMgSvc.DestIPort;
{$ELSE}
sSvrIport := sSvrAddr;
{$ENDIF}
if bProcStored and bConnected then
begin
sData := StdPkt_.PopPacketStr;
if sData = '' then
begin
bProcStored := false;
continue;
end;
end else begin
if qData_.Count = 0 then
begin
Sleep(500);
continue;
end;
Lock;
try
sData := qData_.Dequeue;
finally
Unlock;
end;
if sData = '' then
continue;
end;
if bConnected then
begin
if sData.Contains('KEY_SCAN_ID') then
bResult := HttpPost(sSvrAddr, '123121', sData) <> ''
else if sData.Contains('KEY_SCAN_FILENAME') then
bResult := HttpPost(sSvrAddr, '123122', sData) <> ''
else if sData.Contains('KEY_APP_AGENT_ID') then
bResult := HttpPost(sSvrAddr, '123123', sData) <> ''
else if sData.Contains('CAMPAIGN_STATUS') then
bResult := HttpPost(sSvrIport + 'campaignLog.do', '{}', sData) <> ''
else if sData.Contains('@(!)_CAMPN') then
bResult := HttpPost(sSvrIport + 'campaignResultLog.do', '1', sData) <> ''
else if sData.Contains('@(!)_IC_P') then
bResult := HttpPost(sSvrIport + 'eventIncident.do', 'prevent', sData) <> ''
else if sData.Contains('@(!)_IC_M') then
bResult := HttpPost(sSvrIport + 'eventIncident.do', 'monitor', sData) <> ''
else if sData.Contains('@(!)_REQ_TMAP_1') then // TMAP 예외 신청, USB
begin
bResult := HttpPost(sSvrIport + 'eventRequest.do', '1', sData) <> '';
_Trace('Post .. eventRequest.do - 1 .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end
else if sData.Contains('@(!)_REQ_TMAP_6') then // TMAP 예외 신청, DRM
begin
bResult := HttpPost(sSvrIport + 'eventRequest.do', '6', sData) <> '';
_Trace('Post .. eventRequest.do - 6 .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end
else if sData.Contains('@(!)_REQ_TMAP_7') then // TMAP 예외 신청, Print Water
begin
bResult := HttpPost(sSvrIport + 'eventRequest.do', '7', sData) <> '';
_Trace('Post .. eventRequest.do - 7 .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end
else if sData.Contains('@(!)_REQ_EXPT_PI') then // 개인정보 검출 문서 예외
begin
bResult := HttpPost(sSvrIport + 'eventRequest.do', '8', sData) <> '';
_Trace('Post .. eventRequest.do - 8 .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end
else if sData.Contains('@(!)_REQ') then
begin
bResult := HttpPost(sSvrIport + 'eventRequest.do', 'request', sData) <> '';
_Trace('Post .. eventRequest.do - * .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end
else if sData.Contains('@(!)_LOG1') then
begin
bResult := HttpPost(sSvrIport + 'eventLog.do', '1', sData) <> '';
_Trace('Post .. eventLog.do, req=1 - * .. %s', [BooleanToStr(bResult, 'Success', 'Fail')], 3);
end else
if sData.Contains('@(!)_SF') then
bResult := SendFile(sData)
else
bResult := HttpPost(sSvrAddr, '123119', sData) <> '';
if not bResult then
begin
if bIsEndSession_ then
goto LB_SaveLog;
// 실패하면 다시 처리? 22_0503 13:50:30 kku
Push(sData);
end;
end else begin
// 상태정보, 시그널 무시
// 음.. 여기로 올일이 없다 23_0516 09:50:02 kku
// if sData.Contains('mwAKey_LOCATION') then
// continue;
LB_SaveLog :
{$IFDEF _HE_}
if gMgSvc <> nil then
begin
try
OffLogKind := gMgSvc.PrefModel.OffLogKind;
if OffLogKind = olkNone then
continue;
if gMgSvc.PrefModel.UseOffLogMaxMB and (nMaxMB_ <> gMgSvc.PrefModel.OffLogMaxMB) then
begin
nMaxMB_ := gMgSvc.PrefModel.OffLogMaxMB;
StdPkt_.MaxSize := nMaxMB_ * 1048576;
end;
if gMgSvc.PrefModel.UseOffLogDay and (nSaveDays_ <> gMgSvc.PrefModel.OffLogDays) then
begin
nSaveDays_ := gMgSvc.PrefModel.OffLogDays;
dwChkDayTick_ := 0;
bStopStored := false;
end;
if (nSaveDays_ > 0) and
((dwChkDayTick_ = 0) or ((GetTickCount - dwChkDayTick_) > 3600000{1시간})) then
begin
dwChkDayTick_ := GetTickCount;
if CheckOverOffLogDays then
bStopStored := true;
end;
if bStopStored then
continue;
// todo : OR, AND 조건 구현?
// if bStopStored and (OffLogKind <> olkColAND) then
// continue;
except
on E: Exception do
begin
ETgException.TraceException(Self, E, 'Fail .. ProcessOffLogPolicy()');
continue;
end;
end;
end;
if not bProcStored then
bProcStored := true;
StdPkt_.PushPacket(UTF8String(sData));
{$ENDIF}
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Execute()');
end;
end;
end;
end.