{*******************************************************}
{                                                       }
{       ProcessKeyMon                                   }
{                                                       }
{       Copyright (C) 2022 sunk                         }
{                                                       }
{*******************************************************}

unit ProcessKeyMon;

interface

//{$DEFINE INCLUDE_MOUSE_CATCH} // 이거 작동시키면 로드중 멈추는 현상 있음. 원인파악은 안함 23_1013 08:13:49 kku

uses
  Winapi.Windows, System.Classes, System.SysUtils, Winapi.Messages,
  Tocsg.Obj, Tocsg.CommonData, DefineKeyMon;

{$DEFINE BLOCK_KEY}

const
  WM_CATCHKEY_NOTIFY   = WM_USER + 3948;
  WM_CATCHMOUSE_NOTIFY = WM_CATCHKEY_NOTIFY + 1;

type
  THookState = (hsFree, hsHooking, hsReload, hsFinish);
  PSharedData_KeyHook = ^TSharedData_KeyHook;
  TSharedData_KeyHook = packed record
    hRcvWnd: ULONGLONG;
    dwLastInputTick: DWORD;
    HookState: THookState;
  {$IFDEF BLOCK_KEY}
    DisESC,
    DisWin,
    DisAlt,
    DisCtrl: Boolean;

    DisEtcs: array [0..30] of Byte;
  {$ENDIF}
  end;

  TKeyMon = class(TTgObject)
  private
    dwPID_: DWORD;
    sMdPath_,
    sMdName_: String;
    SharedData_: TTgFileMapping<TSharedData_KeyHook>;
  {$IFDEF INCLUDE_MOUSE_CATCH}
    hMouseHook_,
  {$ENDIF}
    hKeyboardHook_: HHook;

    function InstallCatchKeyHook: Integer;
    function UnInstallCatchKeyHook: Integer;
    procedure UpdateLastInfput;
  public
    Constructor Create;
    Destructor Destroy; override;

    function SendKeyboardMsg(wParam: WPARAM; lParam: LPARAM): Boolean;
    procedure SendMouseMsg(wParam: WPARAM; lParam: LPARAM);
  end;

function process_WH_KEYBOARD(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function process_WH_KEYBOARD_LL(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

{$IFDEF INCLUDE_MOUSE_CATCH}
function process_WH_MOUSE(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
//function process_WH_MOUSE_LL(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
{$ENDIF}

function InstallCatchKeyHook: Integer; export; stdcall; // WH_KEYBOARD_LL 훅은 프로세스 하나에서만 걸어주면 된다.
function UnInstallCatchKeyHook: Integer; export; stdcall;

implementation

uses
  Tocsg.Trace;

var
  _KeyMon: TKeyMon = nil;

function process_WH_KEYBOARD(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  bPreDown,
  bKeyDown: Boolean;
begin
  try
    if Assigned(_KeyMon) then
    begin
      if nCode >= HC_ACTION then
      begin
        bPreDown := (lParam and $40000000) <> 0; // 키를 계속 누르고 있는 상태인가 아닌가
        bKeyDown := (lParam and $80000000) = 0;  // 키 다운인가 아닌가

      // 키가 다운되었을때, 그 상태로 계속 눌르고 있어도 한번만 보내도록 한다. 2012-06-12 sunk
        if not bPreDown and bKeyDown and _KeyMon.SharedData_.IsAvailable then
          with _KeyMon, _KeyMon.SharedData_.Data^ do
          begin
            _KeyMon.SendKeyboardMsg(wParam, lParam);
            UpdateLastInfput;
            TTgTrace.T('process_WH_KEYBOARD >> KEY DOWN..');
          end;
      end;
      Result := CallNextHookEx(_KeyMon.hKeyboardHook_, nCode, wParam, lParam);
    end;
  except
    Result := 0;
  end;
end;

function process_WH_KEYBOARD_LL(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  pInput: PKeybdInput;
begin
  try
    if Assigned(_KeyMon) then
    begin
    {$IFDEF BLOCK_KEY}
      var bBlock: Boolean := false;
      if (nCode >= HC_ACTION) then
      begin
        case wParam of
//          WM_KEYUP,
//          WM_SYSKEYUP,
          WM_KEYDOWN,
          WM_SYSKEYDOWN :
          begin
            pInput := PKeybdInput(lParam);
            with _KeyMon.SharedData_.Data^ do
            begin
              if DisESC and (pInput.wVk = VK_ESCAPE) then
              begin
                bBlock := true;
              end else
              if DisWin and ((pInput.wVk = VK_LWIN) or (pInput.wVk = VK_RWIN)) then
              begin
                bBlock := true;
              end else
              if DisAlt and ((pInput.wVk = VK_LMENU) or (pInput.wVk = VK_RMENU)) then
              begin
                bBlock := true;
              end else
              if DisCtrl and ((pInput.wVk = VK_LCONTROL) or (pInput.wVk = VK_RCONTROL)) then
              begin
                bBlock := true;
              end;

              if not bBlock then
              begin
                var i: Integer;
                for i := Low(DisEtcs) to High(DisEtcs) do
                begin
                  if DisEtcs[i] = 0 then
                    break;

                  bBlock := DisEtcs[i] = pInput.wVk;
                end;
              end;

              if bBlock then
              begin
                Result := 1;
                exit;
              end;
            end;
          end;
        end;
      end;
    {$ENDIF}

      if nCode >= HC_ACTION then
      begin
        case wParam of
//          WM_KEYUP : ;
          WM_KEYDOWN,
          WM_SYSKEYDOWN :
          begin
            pInput := PKeybdInput(lParam);
            case pInput.wVk of
              VK_LSHIFT,
              VK_RSHIFT,
              VK_LCONTROL,
              VK_RCONTROL,
              VK_LMENU,
              VK_RMENU : ;
              else
                with _KeyMon, _KeyMon.SharedData_.Data^ do
                begin
                  _Trace('[DLL] process_WH_KEYBOARD_LL (WM_KEYDOWN) - Wnd = %d', [hRcvWnd]);
                  if not SendKeyboardMsg(pInput.wVk, dwPID_) then
                  begin
                    Result := 1;
                    exit;
                  end;
                  UpdateLastInfput;
                end;
            end;
          end;
        end;
      end;
      Result := CallNextHookEx(_KeyMon.hKeyboardHook_, nCode, wParam, lParam);
    end;
  except
    Result := 0;
  end;
end;

{$IFDEF INCLUDE_MOUSE_CATCH}
function process_WH_MOUSE(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  try
    if Assigned(_KeyMon) then
    begin
      if nCode >= HC_ACTION then
        case wParam of
//          WM_MOUSEHOVER,
//          WM_MOUSELEAVE,
//          WM_MOUSEWHEEL,
//          WM_NCLBUTTONDOWN,
//          WM_NCRBUTTONDOWN,
//          WM_NCMBUTTONDOWN,
//          WM_LBUTTONDBLCLK,
//          WM_RBUTTONDBLCLK,
//          WM_MBUTTONDBLCLK,
        // 마우스 이벤트 위에꺼 제외 13_1106 14:37:08 sunk
          WM_LBUTTONDOWN,
          WM_RBUTTONDOWN,
          WM_MBUTTONDOWN :
            with _KeyMon, _KeyMon.SharedData_.Data^ do
            begin
              _KeyMon.SendMouseMsg(wParam, dwPID_);
              UpdateLastInfput;
            end;
        end;
      Result := CallNextHookEx(_KeyMon.hMouseHook_, nCode, wParam, lParam);
    end;
  except
    Result := 0;
  end;
end;
{$ENDIF}

function InstallCatchKeyHook: Integer;
begin
  Result := -1;

  if Assigned(_KeyMon) then
    Result := _KeyMon.InstallCatchKeyHook;
end;

function UnInstallCatchKeyHook: Integer;
begin
  Result := -1;

  if Assigned(_KeyMon) then
    Result := _KeyMon.UnInstallCatchKeyHook;
end;

{ TKeyMon }

Constructor TKeyMon.Create;

  procedure Init;
  var
    sPath: array [0..512] of Char;
    hm: HMODULE;
  begin
    dwPID_ := GetCurrentProcessId;
    GetModuleFileName(0, sPath, 512);
    sMdPath_ := sPath;
    sMdName_ := ExtractFileName(sPath);
  end;

begin
  Inherited Create;

  ASSERT(_KeyMon = nil);
  _KeyMon := Self;

  SharedData_ := TTgFileMapping<TSharedData_KeyHook>.Create(MAP_FILENAME_KM, SizeOf(TSharedData_KeyHook));
end;

Destructor TKeyMon.Destroy;
begin
  UnInstallCatchKeyHook;
  FreeAndNil(SharedData_);

  _KeyMon := nil;
  Inherited;
end;

function TKeyMon.SendKeyboardMsg(wParam: WPARAM; lParam: LPARAM): Boolean;
begin
  if SharedData_.IsAvailable then
  begin
    try
      Result := SendMessage(SharedData_.Data.hRcvWnd, WM_CATCHKEY_NOTIFY, wParam, lParam) = 0;
//      PostMessage(SharedData_.Data.hRcvWnd, WM_CATCHKEY_NOTIFY, wParam, lParam);
  //    OutLog('[%s] TWindowCatchWndMsg >> SendMsg() >> H = %d, M = %d', [sMdName_, SharedData_.Data.hRcvWnd, wState]);
    except
    //
    end;
  end;
end;

procedure TKeyMon.SendMouseMsg(wParam: WPARAM; lParam: LPARAM);
begin
  if SharedData_.IsAvailable then
  begin
    try
      PostMessage(SharedData_.Data.hRcvWnd, WM_CATCHMOUSE_NOTIFY, wParam, lParam);
  //    OutLog('[%s] TWindowCatchWndMsg >> SendMsg() >> H = %d, M = %d', [sMdName_, SharedData_.Data.hRcvWnd, wState]);
    except
    //
    end;
  end;
end;

function TKeyMon.InstallCatchKeyHook: Integer;
begin
  Result := 0;

  _Trace('[DLL] Wnd = %d', [Int64(SharedData_.Data.hRcvWnd)]);

//  hKeyboardHook_ := SetWindowsHookEx(WH_KEYBOARD, process_WH_KEYBOARD, HInstance, 0);
  hKeyboardHook_ := SetWindowsHookEx(WH_KEYBOARD_LL, process_WH_KEYBOARD_LL, HInstance, 0);
  if hKeyboardHook_ = 0 then
  begin
    _Trace('[%s] TKeyMon >> SetWindowsHookEx(WH_KEYBOARD) fail!!', [sMdName_]);
    Result := 1;
    exit;
  end;
  _Trace('[%s] TKeyMon >> SetWindowsHookEx(WH_KEYBOARD) Success.', [sMdName_]);

{$IFDEF INCLUDE_MOUSE_CATCH}
  hMouseHook_ := SetWindowsHookEx(WH_MOUSE, process_WH_MOUSE, HInstance, 0);
  if hMouseHook_ = 0 then
  begin
    _Trace('[%s] TKeyMon >> SetWindowsHookEx(WH_MOUSE) fail!!', [sMdName_]);
    Result := 2;
    exit;
  end;
  _Trace('[%s] TKeyMon >> SetWindowsHookEx(WH_MOUSE) Success.', [sMdName_]);
{$ENDIF}
end;

function TKeyMon.UnInstallCatchKeyHook: Integer;
begin
  Result := 0;

{$IFDEF INCLUDE_MOUSE_CATCH}
  if hMouseHook_ <> 0 then
  begin
    _Trace('[%s] TKeyMon >> UnhookWindowsHookEx(hMouseHook_) fail!!', [sMdName_]);
    UnhookWindowsHookEx(hMouseHook_);
    hKeyboardHook_ := 0;
  end;
  _Trace('[%s] TKeyMon >> UnhookWindowsHookEx(hMouseHook_) Success', [sMdName_]);
{$ENDIF}

  if hKeyboardHook_ <> 0 then
  begin
    _Trace('[%s] TKeyMon >> UnhookWindowsHookEx(hKeybordHook_) fail!!', [sMdName_]);
    UnhookWindowsHookEx(hKeyboardHook_);
    hKeyboardHook_ := 0;
  end;
  _Trace('[%s] TKeyMon >> UnhookWindowsHookEx(hKeybordHook_) Success', [sMdName_]);
end;

procedure TKeyMon.UpdateLastInfput;
begin
  if SharedData_.IsAvailable then
    SharedData_.Data.dwLastInputTick := GetTickCount;
end;

exports
  InstallCatchKeyHook, UnInstallCatchKeyHook;

end.