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 { MapFileMemory }
  {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 { (hObjHandle = 0) };
  {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 { (lpHookRec = Nil) }
end; { MapFileMemory }


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


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


{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 { KeyBoardProc } 
  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 { (KeyUp <> false) }; 
      
      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 { (KeyUp <> false) }; 
          {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 { (KeyUp <> false) }; 
          {Swallow the keystroke} 
          Result := -1; 
          exit
        end; {VK_LEFT} 
      end { case wParam }; {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 }; {case code} 
  if (code < 0) then 
    {Call the next hook in the hook chain} 
    Result := CallNextHookEx (lpHookRec^.TheHookHandle, code, wParam, lParam)
end; { KeyBoardProc } 


procedure StartKeyBoardHook 
  stdcall; 
begin { StartKeyBoardHook } 
  {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 { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
end; { StartKeyBoardHook } 


procedure StopKeyBoardHook 
  stdcall; 
begin { StopKeyBoardHook } 
  {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 { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
    end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
end; { StopKeyBoardHook } 


procedure DllEntryPoint (dwReason: DWord); 
begin { DllEntryPoint } 
  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 { case dwReason }
end; { DllEntryPoint } 


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.