381 lines
10 KiB
Plaintext
381 lines
10 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ 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.
|