Вот писал когда-то
Библиотека:
| Код | library CBT;
uses
SysUtils,
Windows;
const
MMFName:PChar='HookData';
type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=packed record
SysHook:HWND;
MyAppWnd:HWND;
end;
var
GlobalData:PGlobalDLLData;
MMFHandle:THandle;
function CBTProc(code:integer;wParam:wParam;lParam:lParam):longint;stdcall;
Var B:Array [0..8191]of Char;
WndClass,WndName,
DisClasses,DisNames:String;
h:hWnd;
n:integer;
begin
n:=0;
if code < 0 then
begin
Result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Exit;
end;
if (code=HCBT_ACTIVATE)
or(code=HCBT_CREATEWND)
or(code=HCBT_DESTROYWND)
or(code=HCBT_MINMAX)
or(code=HCBT_MOVESIZE)
or(code=HCBT_SETFOCUS)
or(code=HCBT_SYSCOMMAND)
then begin
ZeroMemory(@B,SizeOf(B));
GetClassName(wParam,@b,8191);
WndClass:=StrPas(@b);
ZeroMemory(@B,SizeOf(B));
GetWindowText(wParam,@b,8191);
WndName:=StrPas(@b);
if (WndClass=#32770)
or(WndClass='Notepad')
or(WndClass='IEFrame')
then n:=1
else n:=0;
end;
CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Result:= n;
end;
procedure hook(switch:Boolean;hMainProg:HWND) export; stdcall;
begin
if switch=true then
begin
GlobalData^.SysHook := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
end
else
begin
UnhookWindowsHookEx(GlobalData^.SysHook);
end;
end;
procedure OpenGlobalData;
begin
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,0,SizeOf(TGlobalDLLData),MMFName);
GlobalData:= MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalDLLData));
if GlobalData=nil then
begin
CloseHandle(MMFHandle);
Exit;
end;
end;
procedure CloseGlobalData;
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;
procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenGlobalData;
DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;
exports hook;
begin
DLLProc:= @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
|
И прога
| Код | unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hDLL: THandle;
implementation
{$R *.DFM}
procedure Init;
var
Hook: procedure (switch:Boolean;hMainProg:HWND) stdcall;
begin
@hook:= nil;
hDLL:=LoadLibrary(PChar('CBT.dll'));
if hDLL > HINSTANCE_ERROR then
begin
@hook:=GetProcAddress(Hdll, 'hook');
hook(true, Form1.Handle);
end
else
begin
ShowMessage('Хрен тебе!');
Exit;
end;
end;
procedure Destroyhook;
var
Hook: procedure (switch:Boolean;hMainProg:HWND) stdcall;
begin
@hook:= nil;
if hDLL > HINSTANCE_ERROR then
begin
@hook:=GetProcAddress(Hdll,'hook');
hook(false, Form1.Handle);
if FreeLibrary(hDLL)
then sleep(100)
else begin
ShowMessage('Хрен тебе!');
Exit;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary(hDLL);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=FALSE;
Init;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
DestroyHook;
end;
end.
|
Подгони просто под свои нужды. У меня она прикрывала блокнот, експлорер и диалоги виндовские. |