BSOne.SFC/Tocsg.Module/AppCtrl/DLL_AppCtrl/AppHookClient.pas

{*******************************************************}
{                                                       }
{       AppHookClient                                   }
{                                                       }
{       Copyright (C) 2023 kku                          }
{                                                       }
{*******************************************************}

unit AppHookClient;

interface

uses
  Tocsg.ClientBase, System.Classes, WinApi.Windows, Tocsg.Packet,
  System.SysUtils;

type
  TAppHookClient = class(TTgClientBase)
  protected
    dwPid_,
    dwLastSaveTick_: DWORD;
    sModulePath_: String;
    evDisconnected_: TNotifyEvent;
    procedure ConnectedEvent; override;
    procedure DisconnectedEvent; override;
    procedure ProcessRcvPacket(aRcv: IRcvPacket); override;
  public
    Constructor Create;

    property ModulePath: String write sModulePath_;
    property OnDisconnected: TNotifyEvent write evDisconnected_;
  end;

implementation

uses
{$IFDEF _BS1HP_}
  BS1Hook,
{$ELSE}
  AppHook,
{$ENDIF}
  Tocsg.Exception, superobject, GlobalDefine, Tocsg.Process, Tocsg.WndUtil,
  AppCtrlDefine, Tocsg.Json;

{ TAppHookClient }

Constructor TAppHookClient.Create;
begin
  Inherited Create('', -1);
  @evDisconnected_ := nil;
  dwPid_ := GetCurrentProcessId;
  dwLastSaveTick_ := 0;
end;

procedure TAppHookClient.ConnectedEvent;
var
  Send: ISendPacket;
begin
  try
//    Inherited;
    SetSendPauseState(false);
    _Trace('Connected.');

    Send := TTgPacket.Create(ACC_APP_INFO);
    Send.I['PID'] := dwPid_;
    Send.S['Path'] := sModulePath_;
    SendPacket(Send);
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()');
  end;
end;

procedure TAppHookClient.DisconnectedEvent;
begin
  try
    Inherited;
    QSendPacket_.Clear;

    if Assigned(evDisconnected_) then
      evDisconnected_(Self);

    _Trace('Disconnected');
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()');
  end;
end;

procedure TAppHookClient.ProcessRcvPacket(aRcv: IRcvPacket);
var
  Send: ISendPacket;

  procedure process_ACC_TEST_LOG;
  begin
    _Trace(aRcv.S['Msg']);

    Send := TTgPacket.Create(aRcv);
    Send.S['Msg'] := aRcv.S['Msg'] + ' 하하하';
    SendPacket(Send);
  end;

  procedure process_ACC_SET_POLICY;
  var
    Opt: TAppCtrlOpt;
  begin
    try
      if aRcv.O['Opt'] = nil then
        exit;

      ZeroMemory(@Opt, SizeOf(Opt));
      with aRcv.O['Opt'] do
      begin
        Opt.sTaskDir := S['sTaskDir'];
        Opt.dwCustomerType := I['dwCustomerType'];
        Opt.hMainWnd := I['hMainWnd'];

      // DRM
        Opt.DrmAccessKind := TDrmAccessKind(I['DrmAccessKind']);
        Opt.DrmModifyKind := TDrmAccessKind(I['DrmModifyKind']);
        Opt.bDrmAttachAble := B['bDrmAttachAble'];
        Opt.sDrmPass := S['sDrmPass'];
        Opt.sUName := S['sUName'];
        Opt.sEmpNo := S['sEmpNo'];
        Opt.sDeptName := S['sDeptName'];
        Opt.sIpAddr := S['sIpAddr'];

      // Print
        Opt.nFontSize := I['nFontSize'];
        Opt.nLineCount := I['nLineCount'];
//        Opt.sTextOutApp := S['sTextOutApp'];
//        Opt.sTextOutDir := S['sTextOutDir'];
        Opt.sPrtEmfOutDir := S['sPrtEmfOutDir'];
        Opt.sPrintWaterImg := S['sPrintWaterImg'];
        Opt.nPrintWaterAlpha := I['nPrintWaterAlpha'];
//        Opt.sPrintWaterTxt := S['sPrintWaterTxt'];
        Opt.bPrintSecu := B['bPrintSecu'];
        Opt.bPrintWater := B['bPrintWater'];
        Opt.bPrtCollect := B['bPrtCollect'];
        Opt.sPrintWaterExp := S['sPrintWaterExp'];
        Opt.fWmTran := D['fWmTran'];
//        Opt.bPrintMasking := B['bPrintMasking'];
        try
          Opt.PrtWaterCfg := TTgJson.GetDataAsType<TPrtWaterCfg>(O['PrtWaterCfg']);
        except
          ZeroMemory(@Opt.PrtWaterCfg, SizeOf(Opt.PrtWaterCfg));
        end;

      // File
        Opt.FileUseBlock := TFileUseBlock(I['FileUseBlock']);
        Opt.bCheckUrl := B['bCheckUrl'];
        Opt.bUseContentFilter := B['bUseContentFilter'];
        Opt.bReadBlock := B['bReadBlock'];
        Opt.bWriteBlock := B['bWriteBlock'];
        Opt.bFileApproval := B['bFileApproval'];
        Opt.bIgrNetPathAB := B['bIgrNetPathAB'];
        Opt.bOpenDetect := B['bOpenDetect'];
        if O['ShFileCrMon'] <> nil then
        begin
          Opt.ShFileCrMon.nKind := O['ShFileCrMon'].I['nKind'];
          Opt.ShFileCrMon.bBlkNoti := O['ShFileCrMon'].B['bBlkNoti'];
          Opt.ShFileCrMon.bMonNoti := O['ShFileCrMon'].B['bMonNoti'];
          Opt.ShFileCrMon.sExpLst := O['ShFileCrMon'].S['sExpLst'];
        end else
          Opt.ShFileCrMon.nKind := 0;

      // Noti
        Opt.hRcvWnd := I['hRcvWnd'];
        Opt.hTagWnd := I['hTagWnd'];
        Opt.hCltWnd := I['hCltWnd'];

      // ETC
        Opt.sAcName := S['sAcName'];
        Opt.sAcSSid := S['sAcSSid'];
        Opt.sAipPath := S['sAipPath'];
        Opt.bMtpWB := B['bMtpWB'];
        Opt.sMtpRoExp := S['sMtpRoExp'];
        Opt.bIsTest := B['bIsTest'];
      end;
//      Opt := TTgJson.GetDataAsType<TAppCtrlOpt>(aRcv.O['Opt']);

      gAppHook.ProcessAppCtrlOpt(Opt);
    except
    //
    end;
  end;

  procedure process_ACC_SAFE_TERMINATE_CLIENT;
  begin
    gAppHook.DoInterceptRemove;
    Disconnect;
    Sleep(3000);
//    StopThread;
  end;

  procedure process_ACC_SET_CAPTURE_BLOCK;
  begin
  {$IFDEF _BS1HP_}
    if gAppHook <> nil then
    begin
      if aRcv.B['Block'] then
        gAppHook.AddCapBlockWnd(aRcv.I['Wnd'])
      else
        gAppHook.DelCapBlockWnd(aRcv.I['Wnd']);
    end;
  {$ENDIF}
  end;

begin
  try
    case aRcv.Command of
      ACC_TEST_LOG              : process_ACC_TEST_LOG;
      ACC_SET_POLICY            : process_ACC_SET_POLICY;
      ACC_SAFE_TERMINATE_CLIENT : process_ACC_SAFE_TERMINATE_CLIENT;
      ACC_SET_CAPTURE_BLOCK     : process_ACC_SET_CAPTURE_BLOCK;
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [aRcv.Command]);
  end;
end;

end.