BSOne.SFC/eCrmHE/Utils/EXE_MakeLogStress/DMkLogStressMain.pas

401 lines
11 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit DMkLogStressMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, VirtualTrees,
Tocsg.Controls, ThdEvent, System.Generics.Collections, ManagerService;
type
PPrevnEnt = ^TPrevnEnt;
TPrevnEnt = record
sCaption: String;
dwCode: DWORD;
end;
TDlgMkLogStress = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
edDestUrl: TEdit;
edEmpNo: TEdit;
edAgentId: TEdit;
edIP: TEdit;
edMAC: TEdit;
edHostName: TEdit;
btnSvrTest: TSpeedButton;
GroupBox2: TGroupBox;
vtList: TVirtualStringTree;
Label7: TLabel;
edSendCnt: TEdit;
btnSendLog: TSpeedButton;
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure btnSvrTestClick(Sender: TObject);
procedure btnSendLogClick(Sender: TObject);
private
{ Private declarations }
MgCtrls_: TManagerInputControlsData;
MgSvc_: TManagerService;
ThdEvent_: TThdEvent;
CodeList_: TList<DWORD>;
procedure RefreshPreventList;
procedure SendEventLog(sUri, sMsg: String; dwCode: DWORD);
function CheckConnectAble: Boolean;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
end;
var
DlgMkLogStress: TDlgMkLogStress;
implementation
uses
superobject, Tocsg.Path, Tocsg.VirtualTreeViewUtil,
IdHTTP, IdSSLOpenSSL, IdIOHandler, Tocsg.Safe, Tocsg.Exception, Tocsg.Network,
Tocsg.WinInfo, Tocsg.WTS;
{$R *.dfm}
Constructor TDlgMkLogStress.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
edIP.Text := GetHostIP;
edMAC.Text := GetMACAddrUsing;
edHostName.Text := GetComName + '\' + WTS_GetCurrentUserName;
MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
MgCtrls_.RegInputCtrl(edDestUrl);
MgCtrls_.RegInputCtrl(edEmpNo);
MgCtrls_.RegInputCtrl(edAgentId);
MgCtrls_.RegInputCtrl(edIP);
MgCtrls_.RegInputCtrl(edMAC);
MgCtrls_.RegInputCtrl(edHostName);
MgCtrls_.Load;
CodeList_ := TList<DWORD>.Create;
MgSvc_ := TManagerService.Create;
ThdEvent_ := TThdEvent.Create;
ThdEvent_.StartThread;
RefreshPreventList;
end;
Destructor TDlgMkLogStress.Destroy;
begin
FreeAndNil(ThdEvent_);
FreeAndNil(MgSvc_);
FreeAndNil(CodeList_);
FreeAndNil(MgCtrls_);
Inherited;
end;
function TDlgMkLogStress.CheckConnectAble: Boolean;
var
HTTP: TIdHTTP;
SSL: TIdSSLIOHandlerSocketOpenSSL;
ss: TStringStream;
O: ISuperObject;
sResult: String;
begin
Result := false;
edDestUrl.Text := Trim(edDestUrl.Text);
if edDestUrl.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'),
PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
Guard(SSL, TIdSSLIOHandlerSocketOpenSSL.Create(nil));
SSL.SSLOptions.Method := sslvSSLv23;
SSL.SSLOptions.SSLVersions := [sslvTLSv1_2, sslvTLSv1_1, sslvTLSv1];
Guard(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';
Request.Connection := 'Keep-Alive';
HTTPOptions := HTTP.HTTPOptions + [hoForceEncodeParams];
ConnectTimeout := 5000;
ReadTimeout := 5000;
end;
try
Guard(ss, TStringStream.Create('{"Request : ConnectionCheck"}', TEncoding.UTF8));
HTTP.Request.CustomHeaders.Values['requestType'] := '123000';
sResult := HTTP.Post(edDestUrl.Text, ss);
if (sResult = '') and (HTTP.ResponseCode = 200) then
sResult := 'true';
Result := sResult <> '';
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. btnSvrTestClick()');
end;
end;
procedure TDlgMkLogStress.btnSendLogClick(Sender: TObject);
const
URI_USER_ACTION = 'UserBehavior';
var
pNode: PVirtualNode;
pData: PPrevnEnt;
nSendCnt: Integer;
dwCode: DWORD;
sMsg: String;
begin
MgSvc_.IsConnStatus := CheckConnectAble;
if not MgSvc_.IsConnStatus then
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
MgSvc_.DestServerUrl := edDestUrl.Text;
edEmpNo.Text := Trim(edEmpNo.Text);
edAgentId.Text := Trim(edAgentId.Text);
edIP.Text := Trim(edIP.Text);
edMAC.Text := Trim(edMAC.Text);
edHostName.Text := Trim(edHostName.Text);
edSendCnt.Text := Trim(edSendCnt.Text);
if edEmpNo.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edEmpNo.SetFocus;
exit;
end;
if edAgentId.Text = '' then
begin
MessageBox(Handle, PChar('AgentID<49><44> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edAgentId.SetFocus;
exit;
end;
if edIP.Text = '' then
begin
MessageBox(Handle, PChar('IP <20>ּҸ<D6BC> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edIP.SetFocus;
exit;
end;
if edMAC.Text = '' then
begin
MessageBox(Handle, PChar('MAC <20>ּҸ<D6BC> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edMAC.SetFocus;
exit;
end;
if edHostName.Text = '' then
begin
MessageBox(Handle, PChar('ȣ<><C8A3>Ʈ <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edHostName.SetFocus;
exit;
end;
nSendCnt := StrToIntDef(edSendCnt.Text, 0);
if nSendCnt = 0 then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> Ƚ<><C8BD><EFBFBD><EFBFBD> 1<>̻<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edSendCnt.SetFocus;
exit;
end;
MgCtrls_.Save;
CodeList_.Clear;
vtList.BeginUpdate;
try
pNode := vtList.GetFirstChecked;
if pNode = nil then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD> <20>α׸<CEB1> <20>ϳ<EFBFBD> <20>̻<EFBFBD> üũ<C3BC><C5A9><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
while pNode <> nil do
begin
pData := vtList.GetNodeData(pNode);
CodeList_.Add(pData.dwCode);
pNode := vtList.GetNextChecked(pNode);
end;
finally
vtList.EndUpdate;
end;
ASSERT(CodeList_.Count > 0);
Randomize;
while nSendCnt > 0 do
begin
Dec(nSendCnt);
dwCode := CodeList_[Random(CodeList_.Count - 1)];
case dwCode of
50006 : sMsg := '[MakeLog] Printer : PDF, Document : DCS';
50028 : sMsg := '[MakeLog] Printer : PDF, Document : DCS';
50007 : sMsg := '[MakeLog] Clipboard Blocked : notepad.exe';
50009 : sMsg := '[MakeLog] <eCrmPath>C:\TEST.DOCX</eCrmPath>';
50010 : sMsg := '[MakeLog] Port Blocked';
50011 : sMsg := '[MakeLog] Network Refreshed';
50013 : sMsg := '[MakeLog] Disconnected : "notepad.exe" not launched';
50014 : sMsg := '[MakeLog] "notepad.exe" Installed';
50017 : sMsg := '[MakeLog] Connected : ToCSG';
50027 : sMsg := '[MakeLog] Block : ToCSG';
50019 : sMsg := '[MakeLog] <eCrmPath>C:\TEST.DOCX</eCrmPath>';
50020 : sMsg := '[MakeLog] Water marked : C:\TEST.jpg';
50022 : sMsg := '[MakeLog] Software Blocked : notepad.exe';
// 50023 : sMsg := '[MakeLog] ';
50025 : sMsg := '[MakeLog] Screen Locked';
50026 : sMsg := '[MakeLog] <eCrmPath>C:\TEST.DOCX</eCrmPath>';
50029 : sMsg := '[MakeLog] USB Blocked';
50030 : sMsg := '[MakeLog] Routing table Prevented';
// 50031 : sMsg := '[MakeLog] ';
50032 : sMsg := '[MakeLog] Domain : naver.com';
50035 : sMsg := '[MakeLog] Name : MTP, Desc : M12, Serial : MS';
50036 : sMsg := '[MakeLog] Name : MTP, Desc : M12, Serial : MS';
50033 : sMsg := '[MakeLog] Name : <20><><EFBFBD><EFBFBD>, Type : <20><>, Address : <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
50034 : sMsg := '[MakeLog] Name : <20><><EFBFBD><EFBFBD>, Type : <20><>, Address : <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
end;
SendEventLog(URI_USER_ACTION, sMsg, dwCode);
end;
MessageBox(Handle, PChar(edSendCnt.Text + '<27><> <20>α<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>û<EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgMkLogStress.btnSvrTestClick(Sender: TObject);
begin
edDestUrl.Text := Trim(edDestUrl.Text);
if edDestUrl.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'),
PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
if CheckConnectAble then
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.'), PChar(Caption), MB_ICONQUESTION or MB_OK)
else
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
end;
procedure TDlgMkLogStress.RefreshPreventList;
procedure AddEnt(sCaption: String; dwCode: DWORD);
var
pNode: PVirtualNode;
pData: PPrevnEnt;
begin
pData := VT_AddChildDataN(vtList, pNode);
pNode.CheckType := ctCheckBox;
pNode.CheckState := csCheckedNormal;
pData.sCaption := sCaption;
pData.dwCode := dwCode;
end;
begin
vtList.BeginUpdate;
try
VT_Clear(vtList);
AddEnt('<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD><EFBFBD>', 50006);
AddEnt('<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD><EFBFBD>', 50028);
AddEnt('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50007);
AddEnt('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50009);
AddEnt('<27><>Ʈ <20><><EFBFBD><EFBFBD>', 50010);
AddEnt('<27><>Ʈ<EFBFBD><C6AE>ũ <20><><EFBFBD>ΰ<EFBFBD>ħ', 50011);
AddEnt('<27>ʼ<EFBFBD> APP <20><><EFBFBD><EFBFBD>', 50013);
AddEnt('<27><><EFBFBD>α׷<CEB1> <20><>ġ', 50014);
AddEnt('WIFI <20><><EFBFBD><EFBFBD>', 50017);
AddEnt('WIFI <20><><EFBFBD><EFBFBD>', 50027);
AddEnt('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>ŷ', 50019);
AddEnt('<27>̹<EFBFBD><CCB9><EFBFBD> <20><><EFBFBD>͸<EFBFBD>ũ', 50020);
AddEnt('APP <20><><EFBFBD><EFBFBD>', 50022);
// AddEnt('USB <20><>ü <20><><EFBFBD><EFBFBD> ', 50023);
AddEnt('ȭ<><C8AD> <20><><EFBFBD><EFBFBD>', 50025);
AddEnt('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50026);
AddEnt('USB <20><><EFBFBD><EFBFBD>', 50029);
AddEnt('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>̺<EFBFBD> <20><><EFBFBD><EFBFBD>', 50030);
// AddEnt('', 50031);
AddEnt('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50032);
AddEnt('MTP <20><><EFBFBD><EFBFBD>', 50035);
AddEnt('MTP <20><><EFBFBD><EFBFBD>', 50036);
AddEnt('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50033);
AddEnt('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>', 50034);
finally
vtList.EndUpdate;
end;
end;
procedure TDlgMkLogStress.SendEventLog(sUri, sMsg: String; dwCode: DWORD);
var
O: ISuperObject;
begin
try
O := SO;
O.S['MODEL_ID'] := edAgentId.Text;
O.S['TOCSG_LA_IFNAME'] := sUri;
O.S['TOCSG_LA_ID'] := edAgentId.Text;
O.S['TOCSG_LA_EMPID'] := edEmpNo.Text;
O.S['TOCSG_LA_CODE'] := IntToStr(dwCode);
O.S['TOCSG_LA_DATA'] := sMsg;
O.S['TOCSG_LA_HOSTNAME'] := edHostName.Text;
O.S['TOCSG_LA_LASTCONNDATE'] := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
O.S['TOCSG_LA_MACADDR'] := edIP.Text;
O.S['TOCSG_LA_REMOTEIP'] := edMAC.Text;
ThdEvent_.Push(O.AsString);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. SendEventLog()');
end;
end;
procedure TDlgMkLogStress.vtListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PPrevnEnt;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgMkLogStress.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TPrevnEnt);
end;
procedure TDlgMkLogStress.vtListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PPrevnEnt;
begin
if Column = 0 then
begin
pData := Sender.GetNodeData(Node);
CellText := pData.sCaption;
end;
end;
end.