需要用DLL方式调用:
这是DLL的DPR文件:
library Hook32;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,Forms,
Classes,
myDLl in 'myDLl.pas' {Form1};
{$R *.res}
exports
HookOn,HookOff;
begin
{Application.Initialize;
Application.Run; }
end.
这是DLL的PAS文件:
unit myDLl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function HookProc(nCode:Integer;WParam: WPARAM;LParam:LPARAM):LRESULT;stdcall;
function HookOn(lpHwnd:HWND;lpType:Longint):Longint;stdcall;export;
function HookOff:Boolean;stdcall;export;
implementation
{type KeyboardBytes=record
kbArray:array[0..255] of byte;
end;}
var
hHk: HHOOK=0;
hMOUSEHk: HHOOK=0;
mhwnd:HWND=0;
bShow:Boolean=False;
myKey:Byte=VK_F7;
kbArray:TKeyboardState;
hThread: Cardinal;
hmod: Pointer; //Hinstance
hProcessId: Cardinal;
// KeyHookStruct:^THardwareHookStruct;
mMode:Integer;
{$R *.dfm}
function HookProc(nCode:Integer;WParam: WPARAM;LParam:LPARAM):LRESULT;stdcall;
begin
Result :=0;
if nCode<0 then
Result := CallNextHookEx(hHk,nCode,WParam,LParam)
else
begin
GetKeyboardState(kbArray);
if (bShow=False) And (kbArray[myKey]=1) then
begin
bShow:=True;
Form1:=TForm1.Create(Application);
ShowCursor(true);
try
// Form1.Caption :='我的DLL中的窗体！';
// LockWindowUpdate(mhwnd);
/// SetParent(Form1.Handle,mhwnd);
// MoveWindow(Form1.Handle,1,1,2,2,True);
// UpdateWindow(Form1.Handle);
// UpdateWindow(mhwnd);
SetWindowPos(Form1.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE);
// UpdateWindow(mhwnd);
// mMode:=GetMapMode(GetDC(mhwnd));
// SetMapMode(GetDC(Form1.Handle),mMode);
// UpdateWindow(Form1.Handle);
// SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong(mhwnd, GWL_STYLE));
Result :=1;
SuspendThread(hThread);
Form1.ShowModal;
ShowCursor(true);
ResumeThread(hThread);
kbArray[myKey] := 0;
SetKeyboardState(kbArray);
finally
Form1.Free;
end;
end
else
begin
Result := CallNextHookEx(hHk,nCode,WParam,LParam);
end;
end;
end;
function HookOn(lpHwnd:HWND;lpType:Longint): Longint;stdcall; export;
begin
mhwnd:=lpHwnd;
if hHk<>0 then UnHookWindowsHookEx(hHk);
hThread :=GetWindowThreadProcessId(mhwnd,hmod);
// hProcessId:=cardinal(hmod);
// Sleep(200);
hHk :=SetWindowsHookEx(lpType,@HookProc,hInstance,hThread); // WH_KEYBOARD
Result :=hHk
end;
function HookOff:Boolean;stdcall; export;
begin
if hHk<>0 then
begin
UnHookWindowsHookEx(hHk);
hHk :=0;
Result :=true;
end
else
Result :=false;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bShow:=False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bShow:=False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.close;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
ShowCursor(true);
end;
end.
这是调用的程序PAS
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function HookOn(lpHwnd:HWND;lpType:Longint):Longint;stdcall;external 'HOOK32.DLL' name 'HookOn';
function HookOff:Boolean;stdcall;external 'HOOK32.DLL' name 'HookOff';
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
hHandle:HWND;
hProID:HWND;
hThrID:HWND;
h1:HWND;
begin
//这些只是自身程序的，没什么用。
hHandle:=Application.Handle;
hProID:=GetCurrentProcessId();
hThrID:=GetCurrentThreadId();
h1:=FindWindow(NIL,'你的程序');//这是窗口的句柄，要自己找到后，填写入。
HookOn(h1,WH_KEYBOARD);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
hookoff;
end;
end.
