BSOne.SFC/Tocsg.Module/AppCtrl/EXE_AppCtrl/DAppCtrlMain.pas

628 lines
17 KiB
Plaintext

unit DAppCtrlMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Tocsg.CommonData, Vcl.ExtCtrls, Vcl.Buttons, Tocsg.Win32, Tocsg.Controls,
Tocsg.Process, AppCtrlServer, Tocsg.Trace, GlobalDefine,
VirtualTrees, System.Generics.Collections, Tocsg.WndUtil, AppCtrlDefine;
const
START_HOOK_APPS = 'msedgewebview2.exe'; // 'RuntimeBroker.exe'; //'PhotosApp.exe|PhotosService.exe'; // 'msedgewebview2.exe'; // 'spoolsv.exe'; //'splwow64.exe';;
{$IFDEF WIN64}
DLL_APIHOOK = 'AppCtrl.dll';
LOG_FILE = 'AppCtrl.log';
{$ELSE}
DLL_APIHOOK = 'AppCtrl32.dll';
//{$IFDEF DEBUG}
// DLL_APIHOOK = 'AppCtrl.dll';
//{$ELSE}
// DLL_APIHOOK = 'AppCtrl32.dll';
//{$ENDIF}
LOG_FILE = 'AppCtrl32.log';
{$ENDIF}
MAP_FILENAME_APIHOOK = 'Global\AppCtrl64';
HOOK_MUTEX = 'Global\Mtx@220915&AppCtrl';
APP_MUTEX = 'Global\Mtx@220915APP';
WM_CATCH_DROPFILES = WM_USER + 7894;
TXT_DROPINFO = '$DrpFle.txt';
type
TInstallPrintHook = function: Integer; stdcall;
TUninstallPrintHook = function: Integer; stdcall;
PAppCtrlEnt = ^TAppCtrlEnt;
TAppCtrlEnt = record
MdInfo: TCMEnt;
end;
PAppInfoEnt = ^TAppInfoEnt;
TAppInfoEnt = record
dwPid: DWORD;
hMain: HWND;
end;
TDcAppInfo = TDictionary<String,PAppInfoEnt>;
TDlgAppCtrlMain = class(TForm)
tMtx: TTimer;
pnTop: TPanel;
pnClient: TPanel;
btnHook: TButton;
Button2: TButton;
GroupBox2: TGroupBox;
mmTgApp: TMemo;
btnTestMsg: TButton;
vtList: TVirtualStringTree;
procedure btnHookClick(Sender: TObject);
procedure tMtxTimer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure btnTestMsgClick(Sender: TObject);
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
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);
private
{ Private declarations }
sHlpExe_,
sDllPath_: String;
bIsWow64_: Boolean;
MgCtrls_: TManagerInputControlsData;
TgAppList_,
TgAppList2_: TStringList;
ThdAppMon_: TThdProcessWatch;
ThdWndMon_: TThdActiveWndMon;
ProcList_: TProcessEntList;
PidList_: TProcessIdList;
bActive_: Boolean;
Server_: TAppCtrlServer;
Trace_: TTgTrace;
DcNode_: TDictionary<THandle,PVirtualNode>;
DcApp_: TDcAppInfo;
DefCtrlOpt_: TAppCtrlOpt;
procedure OnAppInfoNotify(Sender: TObject; const Item: PAppInfoEnt; Action: TCollectionNotification);
procedure OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
procedure OnWndNotify(aSender: TObject; hActiveWnd: HWND);
procedure FreeMon;
procedure ClearHook(bMore: Boolean = false);
procedure SafeFreeClient;
function StartHookWatch: Boolean;
function StopHookWatch: Boolean;
function GetCtrlOpt(sPName: String): TAppCtrlOpt;
procedure OnSendCtrlOpt(pEnt: PCMEnt);
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_NOTIFY_CONNECT_MODULE(var msg: TMessage); Message WM_NOTIFY_CONNECT_MODULE;
end;
var
DlgAppCtrlMain: TDlgAppCtrlMain;
implementation
uses
Tocsg.Path, Tocsg.Safe, Vcl.Imaging.pngimage, Tocsg.WinInfo, Tocsg.Network,
Tocsg.Shell, Tocsg.Param, Winapi.TlHelp32, Tocsg.Exception,
Tocsg.Capture, Tocsg.Strings, Tocsg.User32, Tocsg.Packet, Tocsg.VTUtil,
Tocsg.Json, Condition;
{$R *.dfm}
Constructor TDlgAppCtrlMain.Create(aOwner: TComponent);
var
param: TTgParam;
sLogPath: String;
begin
Inherited Create(aOwner);
CUSTOMER_TYPE := CUSTOMER_DEV;
{$IFDEF Win64}
Caption := Caption + '64';
{$ELSE}
Caption := Caption + '32';
{$ENDIF}
sLogPath := GetRunExePathDir + LOG_FILE;
DeleteFile(PChar(sLogPath));
Trace_ := TTgTrace.Create(ExtractFilePath(sLogPath), ExtractFileName(sLogPath));
Server_ := nil;
MgCtrls_ := nil;
Guard(param, TTgParam.Create);
MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
MgCtrls_.RegInputCtrl(mmTgApp);
MgCtrls_.Load;
sDllPath_ := GetRunExePathDir + DLL_APIHOOK;
bIsWow64_ := IsWow64;
DcApp_ := TDcAppInfo.Create;
DcApp_.OnValueNotify := OnAppInfoNotify;
DcNode_ := TDictionary<THandle,PVirtualNode>.Create;
TgAppList_ := TStringList.Create;
TgAppList_.CaseSensitive := false;
TgAppList2_ := TStringList.Create;
TgAppList2_.CaseSensitive := false;
SplitString(START_HOOK_APPS, '|', TgAppList2_);
ThdAppMon_ := nil;
ThdWndMon_ := nil;
ProcList_ := TProcessEntList.Create;;
ProcList_.DetailInfo := false;
PidList_ := TProcessIdList.Create;
bActive_ := false;
sHlpExe_ := CutFileExt(GetRunExePath) + '32.exe';
if mmTgApp.Text = '' then
mmTgApp.Text := 'chrome.exe|msedge.exe';
ChangeWindowMessageFilter(WM_CATCH_DROPFILES, MSGFLT_ADD);
ZeroMemory(@DefCtrlOpt_, SizeOf(DefCtrlOpt_));
DefCtrlOpt_.sTaskDir := GetRunExePathDir + 'Task\';
DefCtrlOpt_.sUName := '김경덕'; //'김구진';
DefCtrlOpt_.sEmpNo := 'kdkim'; //'kjkim';
DefCtrlOpt_.sDeptName := 'BS솔루션부';
// DefCtrlOpt_.DrmAccessKind := dakAll;
DefCtrlOpt_.sDrmPass := GetMK(false);
DefCtrlOpt_.dwCustomerType := CUSTOMER_TYPE;
DefCtrlOpt_.nFontSize := 175;
DefCtrlOpt_.nLineCount := 4;
// DefCtrlOpt_.sTextOutApp := 'C:\taskToCSG\eCrmHE\OUT_Release - Win64\conf\BSWmcr.exe';
DefCtrlOpt_.sPrintWaterTxt := '이것은 워터마크입니다. This is watermark';
DefCtrlOpt_.sPrintWaterImg := 'C:\taskToCSG\Tocsg.Module\AppCtrl\OUT_Debug - Win64\LS 아이티씨 로고2.png';
// DefCtrlOpt_.nPrintWaterAlpha := 125;
// 워터마크 관련
// DefCtrlOpt_.sPrtEmfOutDir := 'C:\Users\kku\Desktop\TEST\_ColTest\';
// DefCtrlOpt_.bPrintSecu := true;
// DefCtrlOpt_.bPrintWater := true;
// DefCtrlOpt_.bDrmAttachAble := true;
// 파일 차단 관련
DefCtrlOpt_.FileUseBlock := fubBlock;
DefCtrlOpt_.bReadBlock := true;
DefCtrlOpt_.bWriteBlock := true;
// DefCtrlOpt_.bMtpWB := true;
ForceDirectories(DefCtrlOpt_.sTaskDir);
// ForceDirectories(DefCtrlOpt_.sTextOutDir);
{$IFDEF DEBUG}
// Button2.Enabled := true;
// Button2.Visible := true;
{$ENDIF}
end;
Destructor TDlgAppCtrlMain.Destroy;
begin
StopHookWatch;
FreeAndNil(MgCtrls_);
FreeAndNil(TgAppList2_);
FreeAndNil(TgAppList_);
FreeAndNil(DcNode_);
FreeAndNil(DcApp_);
FreeAndNil(PidList_);
FreeAndNil(ProcList_);
if Server_ <> nil then
FreeAndNil(Server_);
FreeAndNil(Trace_);
Inherited;
end;
procedure TDlgAppCtrlMain.FreeMon;
begin
if ThdAppMon_ <> nil then
begin
ThdAppMon_.OnProcessWatchNotify := nil;
FreeAndNil(ThdAppMon_);
end;
if ThdWndMon_ <> nil then
begin
ThdWndMon_.OnActiveWndNotify := nil;
FreeAndNil(ThdWndMon_);
end;
PidList_.Clear;
DcApp_.Clear;
end;
procedure TDlgAppCtrlMain.OnAppInfoNotify(Sender: TObject; const Item: PAppInfoEnt; Action: TCollectionNotification);
begin
if Action = cnRemoved then
Dispose(Item);
end;
procedure TDlgAppCtrlMain.OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
var
nIdx: Integer;
begin
case aKind of
pwkUnknown : {$IFDEF DEBUG} ASSERT(false) {$ENDIF};
pwkInit,
pwkExecute :
begin
if TgAppList2_.IndexOf(pEnt.sPName) = -1 then
exit;
if (GetProcessNameByPid(pEnt.dwPPid).ToUpper <> 'MS-TEAMS.EXE') and
(GetProcessNameByPid(pEnt.dwPPid).ToUpper <> 'OLK.EXE') then
exit;
if InjectModule(pEnt.dwPid, sDllPath_, @bIsWow64_) > 0 then
begin
TTgTrace.T('InjectModule() .. PName="%s", PID=%d, PPID=%d', [pEnt.sPName, pEnt.dwPid, pEnt.dwPPid]);
end else begin
{$IFDEF WIN64}
if FileExists(sHlpExe_) then
ExecutePath(sHlpExe_, Format('-hook %d', [pEnt.dwPid]));
{$ENDIF}
TTgTrace.T('Fail .. InjectModule() .. PName="%s"', [pEnt.sPName]);
end;
end;
pwkTerminated :
begin
nIdx := PidList_.IndexOf(pEnt.dwPid);
if nIdx <> -1 then
begin
PidList_.Delete(nIdx);
Trace_.T('종료됨 .. PName=%s', [pEnt.sPName]);
end;
if DcApp_.ContainsKey(UpperCase(pEnt.sPName)) then
DcApp_.Remove(UpperCase(pEnt.sPName));
end;
end;
end;
procedure TDlgAppCtrlMain.OnWndNotify(aSender: TObject; hActiveWnd: HWND);
var
dwPid: DWORD;
sPName: String;
pEnt: PProcessEntInfo;
pApp: PAppInfoEnt;
begin
try
dwPid := GetProcessPIDFromWndHandle(hActiveWnd);
if dwPid = 0 then
exit;
if PidList_.IndexOf(dwPid) <> -1 then
exit;
ProcList_.UpdateProcessList;
pEnt := ProcList_.GetProcInfoByPid(dwPid);
if pEnt <> nil then
begin
sPName := ExtractFileName(pEnt.sModuleFileName);
if TgAppList_.IndexOf(sPName) = -1 then
begin
// PidList_.Add(dwPid);
exit;
end;
case GetExeFileArchitectFromePath(pEnt.sModuleFileName) of
eakNoExe :
begin
if InjectModule(dwPid, sDllPath_, @bIsWow64_) > 0 then
begin
{$IFDEF DEBUG}
TTgTrace.T('InjectModule() .. PName="%s"', [sPName]);
{$ENDIF}
PidList_.Add(dwPid);
end else begin
if FileExists(sHlpExe_) then
begin
{$IFDEF DEBUG}
TTgTrace.T('InjectModule32() .. PName="%s"', [sPName]);
{$ENDIF}
ExecutePath(sHlpExe_, Format('-hook %d', [dwPid]));
PidList_.Add(dwPid);
end;
{$IFDEF DEBUG}
TTgTrace.T('Fail .. InjectModule() .. PName="%s"', [sPName]);
{$ENDIF}
end;
end;
eak32 :
begin
if FileExists(sHlpExe_) then
begin
{$IFDEF DEBUG}
TTgTrace.T('InjectModule32() ... PName="%s"', [sPName]);
{$ENDIF}
ExecutePath(sHlpExe_, Format('-hook %d', [dwPid]));
PidList_.Add(dwPid);
end else
TTgTrace.T('Fail .. Not found exe .. HlpExe="%s"', [sHlpExe_]);
end;
eak64 :
if InjectModule(dwPid, sDllPath_, @bIsWow64_) > 0 then
begin
{$IFDEF DEBUG}
TTgTrace.T('InjectModule() .. PName="%s"', [sPName]);
{$ENDIF}
PidList_.Add(dwPid);
end else
TTgTrace.T('Fail .. InjectModule() ... PName="%s"', [sPName]);
end;
if not DcApp_.ContainsKey(UpperCase(pEnt.sModuleBaseName)) then
begin
New(pApp);
pApp.dwPid := pEnt.dwPid;
pApp.hMain := hActiveWnd;
DcApp_.Add(UpperCase(pEnt.sModuleBaseName), pApp);
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. OnWndNotify()');
end;
end;
procedure TDlgAppCtrlMain.ClearHook(bMore: Boolean = false);
begin
//exit;
if FileExists(sHlpExe_) then
ExecutePath_hide(sHlpExe_, '-clearhook');
EjectModuleFromPath2(sDllPath_, 'msedgewebview2.exe');
if bMore then
begin
Sleep(1000);
EjectModuleFromPath2(sDllPath_, 'msedgewebview2.exe');
end;
end;
procedure TDlgAppCtrlMain.SafeFreeClient;
var
nTO: Integer;
begin
if Server_ <> nil then
begin
// 안전 제거를 위해 종료를 미리 알림 23_0315 14:02:46 kku
// Server_.SendPacket(TTgPacket.Create(ACC_SAFE_TERMINATE_CLIENT));
//
// nTO := 0;
// while (Server_.CountEnt > 0) and (nTO < 10) do
// begin
// Inc(nTO);
// Sleep(500);
// Application.ProcessMessages;
// end;
FreeAndNil(Server_);
end;
end;
function TDlgAppCtrlMain.StartHookWatch: Boolean;
begin
Result := false;
try
if (ThdAppMon_ <> nil) and (ThdWndMon_ <> nil) then
exit;
if Server_ <> nil then
FreeAndNil(Server_);
Server_ := TAppCtrlServer.Create(Handle);
Server_.OnSendCtrlOpt := OnSendCtrlOpt;
if Server_.ActiveNp('NpAppCtrl', true) then
Server_.ConnectNp;
FreeMon;
ClearHook;
ThdAppMon_ := TThdProcessWatch.Create(false);
ThdAppMon_.OnProcessWatchNotify := OnAppNotify;
ThdAppMon_.StartThread;
ThdWndMon_ := TThdActiveWndMon.Create(false);
ThdWndMon_.OnActiveWndNotify := OnWndNotify;
ThdWndMon_.StartThread;
// EjectModuleFromPath(sDllPath_);
SplitString(mmTgApp.Text, '|', TgAppList_);
bActive_ := true;
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StartHookWatch()');
end;
end;
function TDlgAppCtrlMain.StopHookWatch: Boolean;
begin
Result := false;
try
if (ThdAppMon_ = nil) and (ThdWndMon_ = nil) then
exit;
FreeMon;
SafeFreeClient;
ClearHook(true);
bActive_ := false;
VT_Clear(vtList);
DcNode_.Clear;
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StopHookWatch()');
end;
end;
function TDlgAppCtrlMain.GetCtrlOpt(sPName: String): TAppCtrlOpt;
begin
sPName := UpperCase(sPName);
Result := DefCtrlOpt_;
if Server_ <> nil then
Result.hTagWnd := Server_.GetSelfWnd
else
Result.hTagWnd := 0;
// if DcApp_.ContainsKey(sPName) then
// Result.hCltWnd := DcApp_[sPName].hMain;
end;
procedure TDlgAppCtrlMain.OnSendCtrlOpt(pEnt: PCMEnt);
var
Send: ISendPacket;
begin
try
Send := TTgPacket.Create(ACC_SET_POLICY);
Send.Toss := pEnt.hPipe;
Send.O['Opt'] := TTgJson.ValueToJsonObject<TAppCtrlOpt>(GetCtrlOpt(pEnt.sPName));
Server_.SendPacket(Send);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. OnSendCtrlOpt()');
end;
end;
procedure TDlgAppCtrlMain.tMtxTimer(Sender: TObject);
begin
if not MutexExists(HOOK_MUTEX) then
Close;
end;
procedure TDlgAppCtrlMain.vtListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PAppCtrlEnt;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgAppCtrlMain.vtListGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtList.Text[Node, Column];
end;
procedure TDlgAppCtrlMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TAppCtrlEnt);
end;
procedure TDlgAppCtrlMain.vtListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PAppCtrlEnt;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := pData.MdInfo.sPName;
2 : CellText := IntToStr(pData.MdInfo.dwPid);
3 : CellText := pData.MdInfo.sPPath;
end;
end;
procedure TDlgAppCtrlMain.btnHookClick(Sender: TObject);
begin
if not bActive_ then
begin
mmTgApp.Text := Trim(mmTgApp.Text);
if mmTgApp.Text = '' then
begin
MessageBox(Handle, PChar('제어 대상 APP을 입력해 주십시오.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MgCtrls_.Save;
if not StartHookWatch then
begin
MessageBox(Handle, PChar('DLL을 로드하는 중 실패했습니다.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MessageBox(Handle, PChar('APP 제어가 시작 되었습니다.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end else begin
StopHookWatch;
MessageBox(Handle, PChar('APP 제어가 중지 되었습니다.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
if bActive_ then
begin
btnHook.Caption := 'APP 제어 중지';
end else begin
btnHook.Caption := 'APP 제어 시작';
end;
Application.ProcessMessages;
end;
procedure TDlgAppCtrlMain.btnTestMsgClick(Sender: TObject);
var
Send: ISendPacket;
begin
Send := TTgPacket.Create(ACC_TEST_LOG);
Send.S['Msg'] := '안녕하세요.';
Server_.SendPacket(Send);
end;
procedure TDlgAppCtrlMain.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK)));
end;
procedure TDlgAppCtrlMain.process_WM_NOTIFY_CONNECT_MODULE(var msg: TMessage);
var
pEnt: PCMEnt;
pNode: PVirtualNode;
pData: PAppCtrlEnt;
begin
try
vtList.BeginUpdate;
try
if msg.WParam = 1 then
begin
// 연결
pEnt := PCMEnt(msg.LParam);
ASSERT(not DcNode_.ContainsKey(pEnt.hPipe));
pData := VT_AddChildDataN(vtList, pNode);
pData.MdInfo := pEnt^;
DcNode_.Add(pData.MdInfo.hPipe, pNode);
end else begin
// 종료
if DcNode_.ContainsKey(msg.LParam) then
begin
pNode := DcNode_[msg.LParam];
DcNode_.Remove(msg.LParam);
vtList.DeleteNode(pNode);
end;
end;
finally
vtList.EndUpdate;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. process_WM_NOTIFY_CONNECT_MODULE()');
end;
end;
end.