急,Delphi中如何拦截键盘消息????给出代码,谢谢!

Question

如题,要实现这样的功能,就是监控某个按键(比如';'),';'键出现后,在一段时间(2秒)之后出现的'?'键失效,请问怎么做???

Answer 1

var
  st,et,ct: int64;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  QueryPerformanceCounter(et);
  QueryPerformanceFrequency(ct);
  if ((et-st)/ct<2.000) then
    key:=chr(0);
  st:=et;
end;

Answer 2

顶，1楼已经给说了。只要把Key值为#0就可以了。

Answer 3

如果是监控某个程序用2楼的可以，如果是监控全局则要使用钩子，下面是一个监控键盘的钩子代码：unit KeyboardHook;interfaceuses
  Windows, Messages, Classes, IdleConst;const
  DEFDLLNAME = 'IdleKeyboard.dll';type
  TEnableKeyboardHook = function(hWindow: HWND): BOOL; stdcall;  TDisableKeyboardHook = function: BOOL; stdcall;  TKeyDownNotify = procedure(const KeyCode: Integer) of object;  TKeyUpNotify = procedure(const KeyCode: Integer) of object;  TKeyboardHookBase = class
  private
    FDLLName: string;
    FDLLLoaded: BOOL;
    FListenerHandle: HWND;
    FActive: BOOL;
    hMappingFile: THandle;
    pMapMem: PKeyboardMappingMem;
    procedure WndProc(var Message: TMessage);
    procedure SetDLLName(const Value: string);
  protected
    MSG_KEYDOWN: UINT;
    MSG_KEYUP: UINT;
    procedure ProcessMessage(var Message: TMessage); virtual; abstract;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Start: BOOL; virtual;
    procedure Stop; virtual;
    property DLLLoaded: BOOL read FDLLLoaded;
    property Active: BOOL read FActive;
  published
    property DLLName: string read FDLLName write SetDLLName;
  end;  TKeyboardHook = class(TKeyboardHookBase)
  private
    FOnKeyDown: TKeyDownNotify;
    FOnKeyUp: TKeyUpNotify;
    procedure DoKeyDown(const KeyCode: Integer);
    procedure DoKeyUp(const KeyCode: Integer);
  protected
    procedure ProcessMessage(var Message: TMessage); override;
  public  published
    property DLLName;
    property OnKeyDown: TKeyDownNotify read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyUpNotify read FOnKeyUp write FOnKeyUp;
  end;var
  DLLLoaded: BOOL = False;  StartKeyboardHook: TEnableKeyboardHook;
  StopKeyboardHook: TDisableKeyboardHook;implementationvar
  DLLHandle: HMODULE;procedure UnloadDLL;
begin
  DLLLoaded := False;  if DLLHandle <> 0 then
  begin
    FreeLibrary(DLLHandle);
    DLLHandle := 0;
    @StartKeyboardHook := nil;
    @StopKeyboardHook := nil;
  end;
end;function LoadDLL(const FileName: string): Integer;
begin
  Result := 0;  if DLLLoaded then
    Exit;  DLLHandle := LoadLibraryEx(PChar(FileName), 0, 0);
  if DLLHandle <> 0 then
  begin
    DLLLoaded := True;    @StartKeyboardHook := GetProcAddress(DLLHandle, 'EnableKeyboardHook');
    @StopKeyboardHook := GetProcAddress(DLLHandle, 'DisableKeyboardHook');    if (@StartKeyboardHook = nil) or (@StopKeyboardHook = nil) then
    begin
      Result := 0;
      UnloadDLL;
      Exit;
    end;    Result := 1;
  end
  else
    MessageBox(0, PChar(DEFDLLNAME + ' library could not be loaded !'),
      'Error', MB_ICONERROR);
end;{ TInputHook }constructor TKeyboardHookBase.Create;
begin
  pMapMem := nil;
  hMappingFile := 0;
  FDLLName := DEFDLLNAME;
  MSG_KEYDOWN := RegisterWindowMessage(MSGKEYDOWN);
  MSG_KEYUP := RegisterWindowMessage(MSGKEYUP);
end;destructor TKeyboardHookBase.Destroy;
begin
  Stop;
  inherited;
end;procedure TKeyboardHookBase.WndProc(var Message: TMessage);
begin
  if pMapMem = nil then
  begin
    hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, KeyboardMappingFileName);
    if hMappingFile = 0 then
      MessageBox(0, 'cannot create share memory!', 'Error', MB_OK or MB_ICONERROR);
    pMapMem := MapViewOfFile(hMappingFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
    if pMapMem = nil then
    begin
      CloseHandle(hMappingFile);
      MessageBox(0, 'cannot map share memory!', 'Error', MB_OK or MB_ICONERROR);
    end;
  end;
  if pMapMem = nil then
    Exit;  if (Message.Msg = MSG_KEYDOWN) or (Message.Msg = MSG_KEYUP) then
  begin
    Message.WParam := pMapMem.KeyCode;
    ProcessMessage(Message);
  end
  else
    Message.Result := DefWindowProc(FListenerHandle, Message.Msg, Message.wParam,
      Message.lParam);
end;function TKeyboardHookBase.Start: BOOL;
var
  hookRes: Integer;
begin
  Result := False;
  if (not FActive) and (not FDLLLoaded) then
  begin
    if FDLLName = '' then
    begin
      Result := False;
      Exit;
    end
    else
    begin
      hookRes := LoadDLL(FDLLName);
      if hookRes = 0 then
      begin
        Result := False;
        Exit;
      end
      else
      begin
        FListenerHandle := AllocateHWnd(WndProc);
        if FListenerHandle = 0 then
        begin
          Result := False;
          Exit;
        end
        else
        begin
          if StartKeyboardHook(FListenerHandle) then
          begin
            Result := True;
            FDLLLoaded := True;
            FActive := True;
          end
          else
          begin
            Result := False;
            Exit;
          end;
        end;
      end;
    end;
  end;
end;procedure TKeyboardHookBase.Stop;
begin
  if FActive then
  begin
    if FListenerHandle <> 0 then
    begin
      pMapMem := nil;
      if hMappingFile <> 0 then
      begin
        CloseHandle(hMappingFile);
        hMappingFile := 0;
      end;
      DeallocateHWnd(FListenerHandle);
      StopKeyboardHook;
      FListenerHandle := 0;
    end;
    UnloadDLL;
    FActive := False;
    FDLLLoaded := False;
  end;
end;procedure TKeyboardHookBase.SetDLLName(const Value: string);
begin
  if FActive then
    MessageBox(0, 'Cannot activate hook because DLL name is not set.',
      'Info', MB_OK + MB_ICONERROR)
  else
    FDLLName := Value;
end;{ TKeyboardHook }procedure TKeyboardHook.DoKeyDown(const KeyCode: Integer);
begin
  if Assigned(FOnKeyDown) then
    FOnKeyDown(KeyCode);
end;procedure TKeyboardHook.DoKeyUp(const KeyCode: Integer);
begin
  if Assigned(FOnKeyUp) then
    FOnKeyUp(KeyCode);
end;procedure TKeyboardHook.ProcessMessage(var Message: TMessage);
begin
  if Message.Msg = MSG_KEYDOWN then
  begin
    DoKeyDown(Message.WParam);
  end
  else if Message.Msg = MSG_KEYUP then
  begin
    DoKeyUp(Message.WParam);
  end;
end;end.

Answer 4

发错代码了，待会把键盘HOOK的代码奉上。

Answer 5

我是个初级者,Dll文件也可以给我发一个吗?请问如何使用?
我的程序是要监控所有软件的,如何调用你的程序的呢?谢谢!

Answer 6

Bear_hx:我是个初级者,Dll文件也可以给我发一个吗?请问如何使用? 
我的程序是要监控所有软件的,如何调用你的程序的呢?谢谢!

Answer 7

这个是我DLL的所有代码，发给你，你看一下，初学者建议还是搞懂原理，再来做，否则不利于你将来的发展。library IdleKeyboard;uses
  Windows,
  Messages,
  IdleConst in 'IdleConst.pas';var
  MSG_KEYDOWN: UINT;
  MSG_KEYUP: UINT;
  hMappingFile: THandle;
  pMapMem: PKeyboardMappingMem;
  khook: HHook;function KeyboardHookProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall
begin
  if iCode >= HC_ACTION then
  begin
    pMapMem^.KeyCode := wParam;
    case ((lParam shr 30) and $F) of
      0:                                // Key down
        begin
          pMapMem^.MsgID := MSG_KEYDOWN;
          SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
        end;
      1:                                // key up
        begin
          pMapMem^.MsgID := MSG_KEYUP;
          SendMessage(pMapMem^.Handle, pMapMem^.MsgID, 0, 0);
        end;
    end;
  end;      
  Result := CallNextHookEx(khook, iCode, wParam, lParam);
end;function EnableKeyboardHook(hWindow: HWND): BOOL; stdcall;
begin
  Result := False;
  if khook <> 0 then
    Exit;
  pMapMem^.Handle := hWindow;
  khook := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookProc, HInstance, 0);
  Result := khook <> 0;
end;function DisableKeyboardHook: BOOL; stdcall;
begin
  if khook <> 0 then
  begin
    UnhookWindowshookEx(khook);
    khook := 0;
  end;
  Result := khook = 0;
end;procedure DllMain(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH:
      begin
        hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, KeyboardMappingFileName);
        if hMappingFile = 0 then
        begin
          hMappingFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
            0, SizeOf(TKeyboardMappingMem), KeyboardMappingFileName);
        end;
        if hMappingFile = 0 then
          MessageBox(0, 'cannot create share memory!', 'Error', MB_OK or MB_ICONERROR);        pMapMem := MapViewOfFile(hMappingFile, FILE_MAP_WRITE or FILE_MAP_READ,
          0, 0, 0);
        if pMapMem = nil then
        begin
          CloseHandle(hMappingFile);
          MessageBox(0, 'cannot map share memory!', 'Error', MB_OK or MB_ICONERROR);
        end;
        khook := 0;
        MSG_KEYDOWN := RegisterWindowMessage(MSGKEYDOWN);
        MSG_KEYUP := RegisterWindowMessage(MSGKEYUP);
      end;
    DLL_PROCESS_DETACH:
      begin
        UnMapViewOfFile(pMapMem);
        CloseHandle(hMappingFile);
        if khook <> 0 then
          DisableKeyboardHook;
      end;
    DLL_THREAD_ATTACH:
      begin
      end;
    DLL_THREAD_DETACH:
      begin
      end;
  end;
end;exports
  EnableKeyboardHook,
  DisableKeyboardHook;begin
  DisableThreadLibraryCalls(HInstance);
  DLLProc := @DLLMain;
  DLLMain(DLL_PROCESS_ATTACH);
end.

Answer 8

[Fatal Error] KeyboardHook.pas(6): File not found: 'IdleConst.dcu'
出错!!!!

Answer 9

IdleConst.pas源代码unit IdleConst;interface
  uses Windows;const
  MouseMappingFileName = 'Sample_MouseHookDLL_442C0DB1';
  KeyboardMappingFileName = 'Sample_KeyboardHookDLL_442C0DB1';
  MSGMOUSE: PChar = 'MSGMOUSE57D6A971-049B-45AF-A8CD-37E0B706E036';
  MSGKEYDOWN: PChar = 'MSGKEYDOWN57D6A971-049B-45AF-A8CD-37E0B706E036';
  MSGKEYUP: PChar = 'MSGKEYUP442C0DB1-3198-4C2B-A718-143F6E2D1760';type
  TMouseMappingMem = record
    Handle: DWORD;
    MsgID: DWORD;
    MouseStruct: TMOUSEHOOKSTRUCT;
  end;
  PMouseMappingMem = ^TMouseMappingMem;  TKeyboardMappingMem = record
    Handle: DWORD;
    MsgID: DWORD;
    KeyCode: DWORD;
  end;
  PKeyboardMappingMem = ^TKeyboardMappingMem;implementationend.