RSS订阅 | 匿名投稿
您的位置:网站首页 > 键盘 > 正文

Delphi 键盘勾子DLL演示代码

作者:admin 来源:未知 日期:2010/5/9 14:44:28 人气: 标签:

DLL代码:
-----------------------------------------------------------

unit UnitDll;

interface

uses Windows;

const BUFFER_SIZE = 16 * 1024;
const HOOK_MEM_FILENAME = 'MEM_FILE';
const HOOK_MUTEX_NAME = 'MUTEX_NAME';
type
  TShared = record
    Keys: array[0..BUFFER_SIZE] of Char;
    KeyCount: Integer;
  end;
  PShared = ^TShared;
var
  MemFile, HookMutex: THandle;
  hOldKeyHook: HHook;
  Shared: PShared;

implementation

function KeyHookProc(iCode: Integer; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall; export;
const
  KeyPressMask = $80000000;
begin
  if iCode < 0 then
    Result := CallNextHookEx(hOldKeyHook,
      iCode,
      wParam,
      lParam)
  else begin
    if ((lParam and KeyPressMask) = 0) then
    begin
      Shared^.Keys[Shared^.KeyCount] := Char(wParam and $00FF);
      Inc(Shared^.KeyCount);
      if Shared^.KeyCount >= BUFFER_SIZE - 1 then Shared^.KeyCount := 0;
    end;
    result:=0;
  end;
end;


function EnableKeyHook: BOOL; export;

begin
  Shared^.KeyCount := 0;
  if hOldKeyHook = 0 then
  begin
    hOldKeyHook := SetWindowsHookEx(WH_KEYBOARD,
      KeyHookProc,
      HInstance,
      0);
  end;
  Result := (hOldKeyHook <> 0);
end;

{撤消钩子过滤函数}
function DisableKeyHook: BOOL; export;
begin
  if hOldKeyHook <> 0 then
  begin
    UnHookWindowsHookEx(hOldKeyHook);
    hOldKeyHook := 0;
    Shared^.KeyCount := 0;
  end;
  Result := (hOldKeyHook = 0);
end;

function GetKeyCount: Integer; export;
begin
  Result := Shared^.KeyCount;
end;


function GetKey(index: Integer): Char; export;
begin
  Result := Shared^.Keys[index];
end;

procedure ClearKeyString; export;
begin
  Shared^.KeyCount := 0;
end;

exports
  EnableKeyHook,
  DisableKeyHook,
  GetKeyCount,
  ClearKeyString,
  GetKey;

initialization
        HookMutex := CreateMutex(nil,
          True,
          HOOK_MUTEX_NAME);
        MemFile := OpenFileMapping(FILE_MAP_WRITE,
          False,
          HOOK_MEM_FILENAME);
        if MemFile = 0 then
          MemFile := CreateFileMapping($FFFFFFFF,
            nil,
            PAGE_READWRITE,
            0,
            SizeOf(TShared),
            HOOK_MEM_FILENAME);
        Shared := MapViewOfFile(MemFile,
          File_MAP_WRITE,
          0,
          0,
          0);
        ReleaseMutex(HookMutex);
        CloseHandle(HookMutex);
finalization
        if hOldKeyHook <> 0 then DisableKeyHook;
        UnMapViewOfFile(Shared);
        CloseHandle(MemFile);
end.

主程序代码:
-------------------------------------------------

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    bSetHook: TButton;
    bCancelHook: TButton;
    bReadKeys: TButton;
    bClearKeys: TButton;
    Panel2: TPanel;
    procedure bSetHookClick(Sender: TObject);
    procedure bCancelHookClick(Sender: TObject);
    procedure bReadKeysClick(Sender: TObject);
    procedure bClearKeysClick(Sender: TObject);
  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}
function EnableKeyHook: BOOL; external 'KEYHOOK.DLL';
function DisableKeyHook: BOOL; external 'KEYHOOK.DLL';
function GetKeyCount: Integer; external 'KEYHOOK.DLL';
function GetKey(idx: Integer): Char; external 'KEYHOOK.DLL';
procedure ClearKeyString; external 'KEYHOOK.DLL';

procedure TForm1.bSetHookClick(Sender: TObject);
begin
  EnableKeyHook;
  bSetHook.Enabled := False;
  bCancelHook.Enabled := True;
  bReadKeys.Enabled := True;
  bClearKeys.Enabled := True;
  Panel2.Caption := ' 键盘钩子已经设置';
end;

procedure TForm1.bCancelHookClick(Sender: TObject);
begin
  DisableKeyHook;
  bSetHook.Enabled := True;
  bCancelHook.Enabled := False;
  bReadKeys.Enabled := False;
  bClearKeys.Enabled := False;
  Panel2.Caption := ' 键盘钩子没有设置';
end;

procedure TForm1.bReadKeysClick(Sender: TObject);
var
   i: Integer;
begin
  Memo1.Lines.Clear;{在Memo1中显示击键历史记录}
  for i := 0 to GetKeyCount - 1 do
    Memo1.Text := Memo1.Text + GetKey(i);

end;

procedure TForm1.bClearKeysClick(Sender: TObject);
begin
  Memo1.Clear;
  ClearKeyString;
end;

end.


读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址:
下一篇:Delphi AllocMem