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.