2012년 11월 13일 화요일

KeyBoard Hook win32 (DLL)

library TheHook;
uses
  Windows,
  Messages,
  SysUtils;
{ Define a record for recording and passing information process wide }
type
  PHookRec = ^THookRec;
  THookRec = packed record
    TheHookHandle: HHOOK;
    TheAppWinHandle: HWND;
    TheCtrlWinHandle: HWND;
    TheKeyCount: DWORD;
  end;
var
  hObjHandle: THandle; { Variable for the file mapping object }
  lpHookRec: PHookRec; { Pointer to our hook record }

procedure MapFileMemory(dwAllocSize: DWORD);
begin
  { Create a process wide memory mapped variable }
  hObjHandle := CreateFileMapping($FFFFFFFF, NIL, PAGE_READWRITE, 0, dwAllocSize, 'HookRecMemBlock');
  if (hObjHandle = 0) then begin
    MessageBox(0, 'Hook DLL', 'Could not create file map object', MB_OK);
    exit;
  end;
  { Get a pointer to our process wide memory mapped variable }
  lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
  if (lpHookRec = NIL) then begin
    CloseHandle(hObjHandle);
    MessageBox(0, 'Hook DLL', 'Could not map file', MB_OK);
    exit;
  end;
end;

procedure UnMapFileMemory;
begin
  { Delete our process wide memory mapped variable }
  if (lpHookRec <> NIL) then begin
    UnMapViewOfFile(lpHookRec);
    lpHookRec := NIL;
  end;
  if (hObjHandle > 0) then begin
    CloseHandle(hObjHandle);
    hObjHandle := 0;
  end;
end;

function GetHookRecPointer: pointer stdcall;
begin
  { Return a pointer to our process wide memory mapped variable }
  result := lpHookRec;
end;

{ The function that actually processes the keystrokes for our hook }
function KeyBoardProc(Code: integer; wParam: integer; lParam: integer): integer; stdcall;
var
  KeyUp: bool;
  { Remove comments for additional functionability
    IsAltPressed : bool;     IsCtrlPressed : bool;     IsShiftPressed : bool;   }
begin
  result := 0;
  case Code of
    HC_ACTION: begin { We trap the keystrokes here }
        { Is this a key up message? }
        KeyUp := ((lParam AND (1 shl 31)) <> 0);
        (* Remove comments for additional functionability
          {Is the Alt key pressed}
          if ((lParam AND (1 shl 29)) <> 0) then begin
          IsAltPressed := TRUE;
          end else begin
          IsAltPressed := FALSE;
          end;
          {Is the Control key pressed}
          if ((GetKeyState(VK_CONTROL) AND (1 shl 15)) <> 0) then begin
          IsCtrlPressed := TRUE;
          end else begin
          IsCtrlPressed := FALSE;
          end;
          {if the Shift key pressed}
          if ((GetKeyState(VK_SHIFT) AND (1 shl 15)) <> 0) then begin
          IsShiftPressed := TRUE;
          end else begin
          IsShiftPressed := FALSE;
          end;
        *)
        { If KeyUp then increment the key count }
        if (KeyUp <> FALSE) then begin
          Inc(lpHookRec^.TheKeyCount);
        end;
        case wParam of
          { Was the enter key pressed? }
          VK_RETURN: begin { if KeyUp }
              if (KeyUp <> FALSE) then begin
                { Post a bogus message to the window control in our app }
                PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
                PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0);
              end;
              { If you wanted to swallow the keystroke then return -1 }
              { else if you want to allow the keystroke then return 0 }
              result := 0;
              exit;
            end; { VK_RETURN }
          { If the left arrow key is pressed then lets play a joke! }
          VK_LEFT: begin { if KeyUp }
              if (KeyUp <> FALSE) then begin
                { Create a UpArrow keyboard event }
                keybd_event(VK_RIGHT, 0, 0, 0);
                keybd_event(VK_RIGHT, 0, KEYEVENTF_KEYUP, 0);
              end;
              { Swallow the keystroke }
              result := -1;
              exit;
            end; { VK_LEFT }
        end; { case wParam }
        { Allow the keystroke }
        result := 0;
      end; { HC_ACTION }
    HC_NOREMOVE:
      begin { This is a keystroke message, but the keystroke message } { has not been removed from the message queue, since an } { application has called PeekMessage() specifying PM_NOREMOVE }
        result := 0;
        exit;
      end;
  end; { case code }
  if (Code < 0) then
    { Call the next hook in the hook chain }
      result := CallNextHookEx(lpHookRec^.TheHookHandle, Code, wParam, lParam);
end;

procedure StartKeyBoardHook stdcall;
begin
  { If we have a process wide memory variable }
  { and the hook has not already been set... }
  if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle = 0)) then begin
    { Set the hook and remember our hook handle }
    lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyBoardProc, hInstance, 0);
  end;
end;

procedure StopKeyBoardHook stdcall;
begin
  { If we have a process wide memory variable }
  { and the hook has already been set... }
  if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle <> 0)) then begin
    { Remove our hook and clear our hook handle }
    if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> FALSE) then begin
      lpHookRec^.TheHookHandle := 0;
    end;
  end;
end;

procedure DllEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    Dll_Process_Attach:
      begin { If we are getting mapped into a process, then get } { a pointer to our process wide memory mapped variable }
        hObjHandle := 0;
        lpHookRec := NIL;
        MapFileMemory(sizeof(lpHookRec^));
      end;
    Dll_Process_Detach:
      begin { If we are getting unmapped from a process then, remove } { the pointer to our process wide memory mapped variable }
        UnMapFileMemory;
      end;
  end;
end;

exports
  KeyBoardProc name 'KEYBOARDPROC',
  GetHookRecPointer name 'GETHOOKRECPOINTER',
  StartKeyBoardHook name 'STARTKEYBOARDHOOK',
  StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
  { Set our Dll's main entry point }
  DLLProc := @DllEntryPoint;
  { Call our Dll's main entry point }
  DllEntryPoint(Dll_Process_Attach);
end.

댓글 없음:

tensorflow gpu 사용하기에서

 tensorflow 설치시 주의해야 한다. # Anything above 2.10 is not supported on the GPU on Windows Native python - m pip install "tensorflow<2.11...