不全，不知道为什么老是提交失败，但基本的在这里了

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, PSAPI,
Dialogs, ComCtrls, TlHelp32, ExtCtrls, StdCtrls, Menus, shadowlist;

type
NTSTATUS = Longint;
TPDWord = ^DWORD;
type
TMemoryHunks = record
Address: Longword;
Data: Pointer;
Length: Longword;
end;


type
TForm1 = class(TForm)
ListView1: TListView;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
StatusBar1: TStatusBar;
N2: TMenuItem;
procedure FormShow(Sender: TObject);
procedure ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function ZwQuerySystemInformation(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
SystemInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; external 'ntdll.dll' name 'ZwQuerySystemInformation';

function ZwSystemDebugControl(SYSDBG_COMMAND: Longword; InputBuffer: Pointer; InputBufferLength: Longword;
OutputBuffer: Pointer; OutputBufferLength: Longword; var ReturnLength: Longword): NTSTATUS; stdcall; external 'ntdll.dll';

function NtReadVirtualMemory(
ProcessHandle: tHANDLE;
BaseAddress: dword;
Buffer: pointer;
BufferLength: ULONG;
ReturnLength: PULONG
): NTSTATUS; stdcall; external 'ntdll.dll';

var
Form1: TForm1;
List: tlist;
pgSharedInfo: dword;
ColumnToSort: integer;
gSharedInfo: SHAREDINFO;
gsi: SERVERINFO;
gHandleEntries: array[0..10000] of HANDLEENTRY;
tmpBytArray: array of Byte;
hHookInfo: HOOK;
w32thd: W32THREAD;
newitem, pdata: PMsgHookInfo;
implementation

{$R *.dfm}
{$R XPTheme.RES}

//提升权限

procedure SetPrivilege;
var
TPPrev, TP: TTokenPrivileges;
TokenHandle: THandle;
dwRetLen: DWORD;
lpLuid: TLargeInteger;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, TokenHandle);
if (LookupPrivilegeValue(nil, 'SeDebugPrivilege', lpLuid)) then
begin
TP.PrivilegeCount := 1;
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TP.Privileges[0].Luid := lpLuid;
AdjustTokenPrivileges(TokenHandle, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen);
end;
CloseHandle(TokenHandle);
end;

function ReadVirtualMemory(VirtualAddress: Cardinal; Buffer: Pointer; BufferSize: Cardinal): boolean;
const SysDbgCopyMemoryChunks_0 = 8;
var
QueryBuff: TMemoryHunks;
i: DWord;
begin
QueryBuff.Address := VirtualAddress;
QueryBuff.Data := Buffer;
QueryBuff.Length := BufferSize;
ZwSystemDebugControl(SysDbgCopyMemoryChunks_0, @QueryBuff, SizeOf(TMemoryHunks), nil, 0, i);
Result := i > 0;
end;

function ReadMemory(VirtualAddress: Cardinal): dword;
var FLink: Cardinal;
begin
result := 0;
ReadVirtualMemory(VirtualAddress, @FLink, 4);
result := flink;
end;



function DumpKernelMemory(VirtualAddress: Cardinal; BufferSize: Cardinal; Buffer: Pointer): boolean;
const SysDbgCopyMemoryChunks_0 = 8;
var
QueryBuff: TMemoryHunks;
i: DWord;
begin
QueryBuff.Address := VirtualAddress;
QueryBuff.Data := Buffer;
QueryBuff.Length := BufferSize;

ZwSystemDebugControl(SysDbgCopyMemoryChunks_0, @QueryBuff, SizeOf(TMemoryHunks), nil, 0, i);

Result := i > 0;
end;


function SystemDirectory: string;
var
SysDir: PChar;
begin
SysDir := StrAlloc(MAX_PATH);
GetSystemDirectory(SysDir, MAX_PATH);
Result := string(SysDir);
if Result[Length(Result)] <> '\' then
Result := Result + '\';
StrDispose(SysDir);
end;

function LocateSharedInfo: dword;
var
UserRegisterWowHandlers: THandle;
i: integer;
begin
UserRegisterWowHandlers := dword(GetProcAddress(GetModuleHandle('user32.dll'), 'UserRegisterWowHandlers'));
for i := UserRegisterWowHandlers to UserRegisterWowHandlers + $1000 do
begin
if (inttohex(pword(i)^, 2) = '40C7') and (inttohex(pbyte(i + 7)^, 2) = 'B8') then
begin
//showmessage(inttohex(i + 8, 8));
result := pdword(i + 8)^;

end;
end;
//showmessage(inttohex(UserRegisterWowHandlers, 8));
end;

procedure SaveInfo(str: string); stdcall;
var
f: textfile;
begin
assignfile(f, extractfilepath(paramstr(0)) + 'key.txt');
if fileexists(extractfilepath(paramstr(0)) + 'key.txt') = false then rewrite(f)
else append(f);
if strcomp(pchar(str), pchar('#13#10')) = 0 then writeln(f, '')
else write(f, str);
closefile(f);
end;

function hooktypetostring(index: word): string;
begin
if index = -1 then result := 'WH_MSGFILTER';
if index = 0 then result := 'WH_JOURNALRECORD';
if index = 1 then result := 'WH_JOURNALPLAYBACK';
if index = 2 then result := 'WH_KEYBOARD';
if index = 3 then result := 'WH_GETMESSAGE';
if index = 4 then result := 'WH_CALLWNDPROC';
if index = 5 then result := 'WH_CBT';
if index = 6 then result := 'WH_SYSMSGFILTER';
if index = 7 then result := 'WH_MOUSE';
if index = 8 then result := 'WH_HARDWARE';
if index = 9 then result := 'WH_DEBUG';
if index = 10 then result := 'WH_SHELL';
if index = 11 then result := 'WH_FOREGROUNDIDLE';
if index = 12 then result := 'WH_CALLWNDPROCRET';
if index = 13 then result := 'WH_KEYBOARD_LL';
if index = 14 then result := 'WH_MOUSE_LL';
end;


function getpathfrompid(pid: dword): string;
var
h: THandle;
fileName: string;
iLen: integer;
hMod: HMODULE;
cbNeeded: dword;
begin
h := OpenProcess(PROCESS_ALL_ACCESS, false, pid); //p 为 进程ID
if h > 0 then
begin
if EnumProcessModules(h, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(fileName, MAX_PATH);
iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);
if iLen <> 0 then
begin
SetLength(fileName, StrLen(PCHAR(fileName)));
end;
end;
CloseHandle(h);
end;
result := fileName
end;

procedure enumhook;
var
i: integer;
st, nReadBytes, hprocess: dword;

item: TListItem;
begin
form1.ListView1.Clear;
List := TList.Create;
pgSharedInfo := LocateSharedInfo;
hProcess := GetCurrentProcess();
st := NtReadVirtualMemory(hProcess, pgSharedInfo, @(gSharedInfo), sizeof(gSharedInfo), nil);
st := NtReadVirtualMemory(hProcess, gSharedInfo.psi, @(gsi), sizeof(gsi), nil);
st := NtReadVirtualMemory(hProcess, dword(gSharedInfo.aheList), @(gHandleEntries[0]), sizeof(gHandleEntries[0]) * gsi.cHandleEntries, nil);
for i := low(gHandleEntries) to high(gHandleEntries) do
begin
if (gHandleEntries[I].bType = 5) then
begin
setlength(tmpBytArray, sizeof(hHookInfo) - 1);
if (DumpKernelMemory(dword(gHandleEntries[I].phead), sizeof(hHookInfo), tmpBytArray)) then
begin
CopyMemory(@(hHookInfo), @(tmpBytArray[0]), sizeof(hHookInfo));
GetMem(NewItem, SizeOf(MsgHookInfo));
ZeroMemory(NewItem, SizeOf(MsgHookInfo));
NewItem^.hHook := hHookInfo.tshead.ThreadObjHead.headinfo.hObject;
NewItem^.iHookType := hHookInfo.iHook;
NewItem^.offPfn := hHookInfo.offPfn;
setlength(tmpBytArray, sizeof(w32thd) - 1);
if (DumpKernelMemory(hHookInfo.tshead.ThreadObjHead.pti, sizeof(w32thd), tmpBytArray)) then
(CopyMemory(@(w32thd), @(tmpBytArray[0]), sizeof(w32thd)));
NewItem^.pEThread := w32thd.pEThread;
List.Add(NewItem);
end;
end;
end;
for i := 0 to List.Count - 1 do
begin
try
pdata := List.Items[i];
if pdata = nil then continue;
item := form1.Listview1.Items.Add;
item.Caption := inttohex(pdata^.hHook, 8);
item.SubItems.Add(hooktypetostring(pdata^.iHookType));
item.SubItems.Add(inttohex(pdata^.offPfn, 8));
item.SubItems.Add(getpathfrompid(ReadMemory(ReadMemory(pdata^.pEThread + $220) + $84)));
except
end;
end;
form1.StatusBar1.Panels.Items[0].Text := '共枚举到' + inttostr(List.Count) + '个全局钩子';
setlength(tmpBytArray, 0);
List.Free;

end;

procedure TForm1.FormShow(Sender: TObject);

begin
listview1.DoubleBuffered := true;

SetPrivilege;
enumhook;
end;


procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
//if strtoint('$' + Item.SubItems.Strings[1]) <> strtoint('$' + Item.SubItems.Strings[2]) then //加上条件
//(Sender as TListView).Canvas.Font.Color := clred;
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if ListView1.Items.Count > 0 then
begin
ColumnToSort := Column.Index;
(Sender as TCustomListView).AlphaSort;
end;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
enumhook;
end;

procedure TForm1.N2Click(Sender: TObject);
var
Item: TListItem;
begin
Item := ListView1.Selected;
if Item = nil then exit;
UnhookWindowsHookEx(strtoint('$'+Item.Caption));
end;

end.