DLL 程序library DB;uses SysUtils, Classes, UnitNt2000Hook in 'UnitNt2000Hook.pas', UnitHookType in 'UnitHookType.pas', UnitHookDll in 'UnitHookDll.pas';exports StartHook,StopHook;end.unit UnitHookDll;interfaceuses Windows, SysUtils, Classes, messages,Dialogs, UnitNt2000Hook, UnitHookType,ShellAPI;const Trap=True; //True陷阱式，False表示改引入表式 procedure StartHook;stdcall; procedure StopHook;stdcall;implementationvar GetMsgHook:THandle; pShMem: PShareMem; hMappingFile: THandle; HookWinExec:THookClass; HookCreateProcessA:THookClass; HookCreateProcessW:THookClass; HookShellExecuteA:THookClass; HookShellExecuteW:THookClass; HookTerminateProcess:THookClass;procedure SendData(const SendText: string);var DS: TCopyDataStruct;begin DS.dwData := 0; DS.cbData := MaxStringLen; DS.lpData := @SendText[1]; SendMessage(pShMem^.hProcWnd, WM_COPYDATA, 0, LongWord(@DS));end;function MyWinExec(lpCmdLine: LPCSTR; uCmdShow: UINT): UINT; stdcall;begin HookWinExec.Restore; SendData(string(lpCmdLine)); if pShMem^.YRun=True then Result:=WinExec(lpCmdLine,uCmdShow) else Result:=ERROR_FILE_NOT_FOUND; HookWinExec.Change;end;function MyCreateProcessA(lpApplicationName: PAnsiChar; lpCommandLine: PAnsiChar; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: PAnsiChar; const lpStartupInfo: TStartupInfoA; var lpProcessInformation: TProcessInformation): BOOL; stdcall;varStartUpInfoA: TStartUpInfoA;//打开exe必要的头部说明ProcessInformation: TProcessInformation;//存储进程的信息begin HookCreateProcessA.Restore; ZeroMemory(@StartUpInfoA, 0); StartUpInfoA:=lpStartupInfo; SendData(string(lpApplicationName)); if pShMem^.YRun=True then Result:=CreateProcessA(lpApplicationName,lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory,StartUpInfoA,ProcessInformation) else Result:=false; HookCreateProcessA.Change;end;function MyCreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; stdcall;varStartUpInfoW: TStartUpInfoW;//打开exe必要的头部说明ProcessInformation: TProcessInformation;//存储进程的信息begin HookCreateProcessW.Restore; ZeroMemory(@StartUpInfoW, 0); StartUpInfoW:=lpStartupInfo; SendData(string(lpApplicationName)); if pShMem^.YRun=True then Result:=CreateProcessW(lpApplicationName,lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory,StartUpInfoW,ProcessInformation) else Result:=false; HookCreateProcessW.Change;end;function MyShellExecuteA(hWnd: HWND; Operation, FileName, Parameters, Directory: PAnsiChar; ShowCmd: Integer): HINST; stdcall;begin HookShellExecuteA.Restore; SendData(string(FileName)); if pShMem^.YRun=True then Result:=ShellExecuteA(hWnd,Operation,FileName,Parameters,Directory,ShowCmd) else Result:=ERROR_FILE_NOT_FOUND; HookShellExecuteA.Change;end;function MyTerminateProcess(hProcess: THandle; uExitCode: UINT): BOOL; stdcall;begin HookTerminateProcess.Restore; Result:=TerminateProcess(hProcess,uExitCode); HookTerminateProcess.Change;end;function MyShellExecuteW(hWnd: HWND; Operation, FileName, Parameters, Directory: PWideChar; ShowCmd: Integer): HINST; stdcall;begin HookShellExecuteW.Restore; SendData(string(FileName)); if pShMem^.YRun=True then Result:=ShellExecuteW(hWnd,Operation,FileName,Parameters,Directory,ShowCmd) else Result:=ERROR_FILE_NOT_FOUND; HookShellExecuteW.Change;end;{消息钩子}function GetMsgHookProc(nCode: integer; wPar: WParam; lPar: LParam): lResult;stdcall;begin Result := CallNextHookEx(GetMsgHook, nCode, wPar, lPar);end;procedure StartHook; stdcall;begin if GetMsgHook=0 then begin GetMsgHook := SetWindowsHookEx(WH_GETMESSAGE, GetMsgHookProc, HInstance, 0); end;end;procedure StopHook; stdcall;begin if GetMsgHook<>0 then begin UnhookWindowsHookEx(GetMsgHook); GetMsgHook:=0; end;end;initialization hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName); if hMappingFile=0 then hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShareMem),MappingFileName) else if hMappingFile=0 then Exception.Create('不能建立共享内存!'); pShMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0); if pShMem = nil then begin CloseHandle(hMappingFile); Exception.Create('不能映射共享内存!'); end; HookWinExec:=THookClass.Create(Trap,@WinExec,@MyWinExec); HookCreateProcessA:=THookClass.Create(Trap,@CreateProcessA,@MyCreateProcessA); HookCreateProcessW:=THookClass.Create(Trap,@CreateProcessW,@MyCreateProcessW); HookTerminateProcess:=THookClass.Create(Trap,@TerminateProcess,@MyTerminateProcess);finalization HookWinExec.Destroy; HookCreateProcessA.Destroy; HookCreateProcessW.Destroy; HookTerminateProcess.Destroy; UnMapViewOfFile(pShMem); {取消映射视图} CloseHandle(hMappingFile); {关闭映射文件句柄}end.unit UnitHookType;interfaceuses windows, messages;const MaxStringLen = 500; WM_CALLHOOKAPI = WM_USER + 1139; MappingFileName = 'Hook API for NT 2000 XP';type TShareMem = packed record hProcWnd: HWND; {主应用窗口句柄} HProc:HWND; {主进程句柄} YRun:BOOL; //是否可运行 end; PShareMem = ^TShareMem;implementationend.unit UnitNt2000Hook;interfaceuses classes, Windows,SysUtils, messages;type TImportCode = packed record JumpInstruction: Word; AddressOfPointerToFunction: PPointer; end; PImage_Import_Entry = ^Image_Import_Entry; Image_Import_Entry = record Characteristics: DWORD; TimeDateStamp: DWORD; MajorVersion: Word; MinorVersion: Word; Name: DWORD; LookupTable: DWORD; end; PImportCode = ^TImportCode; TLongJmp = packed record JmpCode: ShortInt; {指令，用$E9来代替系统的指令} FuncAddr: DWORD; {函数地址} end; THookClass = class private Trap:boolean; {调用方式：True陷阱式，False改引入表式} hProcess: Cardinal; {进程句柄，只用于陷阱式} AlreadyHook:boolean; {是否已安装Hook，只用于陷阱式} AllowChange:boolean; {是否允许安装、卸载Hook，只用于改引入表式} Oldcode: array[0..4]of byte; {系统函数原来的前5个字节} Newcode: TLongJmp; {将要写在系统函数的前5个字节} private public OldFunction,NewFunction
ointer;{被截函数、自定义函数} constructor Create(IsTrap:boolean;OldFun,NewFun
ointer); constructor Destroy; procedure Restore; procedure Change; published end;implementation{取函数的实际地址。如果函数的第一个指令是Jmp，则取出它的跳转地址（实际地址），这往往是由于程序中含有Debug调试信息引起的}function FinalFunctionAddress(Code: Pointer): Pointer;Var func: PImportCode;begin Result:=Code; if Code=nil then exit; try func:=code; if (func.JumpInstruction=$25FF) then {指令二进制码FF 25 汇编指令jmp [...]} Func:=func.AddressOfPointerToFunction^; result:=Func; except Result:=nil; end;end;{更改引入表中指定函数的地址，只用于改引入表式}function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;const SIZE=4;Var Dos: PImageDosHeader; NT: PImageNTHeaders; ImportDesc: PImage_Import_Entry; rva: DWORD; Func: PPointer; DLL: String; f: Pointer; written: DWORD; mbi_thunk:TMemoryBasicInformation; dwOldProtect
WORD;begin Result:=0; if hModule=0 then exit; Dos:=Pointer(hModule); {如果这个DLL模块已经处理过，则退出。BeenDone包含已处理的DLL模块} if BeenDone.IndexOf(Dos)>=0 then exit; BeenDone.Add(Dos);{把DLL模块名加入BeenDone} OldFunc:=FinalFunctionAddress(OldFunc);{取函数的实际地址} {如果这个DLL模块的地址不能访问，则退出} if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit; {如果这个模块不是以'MZ'开头，表明不是DLL，则退出} if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;{IMAGE_DOS_SIGNATURE='MZ'} {定位至NT Header} NT :=Pointer(Integer(Dos) + dos._lfanew); {定位至引入函数表} RVA:=NT^.OptionalHeader. DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress; if RVA=0 then exit;{如果引入函数表为空，则退出} {把函数引入表的相对地址RVA转换为绝对地址} ImportDesc := pointer(DWORD(Dos)+RVA);{Dos是此DLL模块的首地址} {遍历所有被引入的下级DLL模块} While (ImportDesc^.Name<>0) do begin {被引入的下级DLL模块名字} DLL:=PChar(DWORD(Dos)+ImportDesc^.Name); {把被导入的下级DLL模块当做当前模块，进行递归调用} PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc); {定位至被引入的下级DLL模块的函数表} Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable); {遍历被引入的下级DLL模块的所有函数} While Func^<>nil do begin f:=FinalFunctionAddress(Func^);{取实际地址} if f=OldFunc then {如果函数实际地址就是所要找的地址} begin VirtualQuery(Func,mbi_thunk, sizeof(TMemoryBasicInformation)); VirtualProtect(Func,SIZE,PAGE_EXECUTE_WRITECOPY,mbi_thunk.Protect);{更改内存属性} WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,SIZE,written);{把新函数地址覆盖它} VirtualProtect(Func, SIZE, mbi_thunk.Protect,dwOldProtect);{恢复内存属性} end; If Written=4 then Inc(Result);// else showmessagefmt('error:%d',[Written]); Inc(Func);{下一个功能函数} end; Inc(ImportDesc);{下一个被引入的下级DLL模块} end;end;{HOOK的入口，其中IsTrap表示是否采用陷阱式}constructor THookClass.Create(IsTrap:boolean;OldFun,NewFun
ointer);begin {求被截函数、自定义函数的实际地址} OldFunction:=FinalFunctionAddress(OldFun); NewFunction:=FinalFunctionAddress(NewFun); Trap:=IsTrap; if Trap then{如果是陷阱式} begin {以特权的方式来打开当前进程} hProcess := OpenProcess(PROCESS_ALL_ACCESS,FALSE, GetCurrentProcessID); {生成jmp xxxx的代码，共5字节} Newcode.JmpCode := ShortInt($E9); {jmp指令的十六进制代码是E9} NewCode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5; {保存被截函数的前5个字节} move(OldFunction^,OldCode,5); {设置为还没有开始HOOK} AlreadyHook:=false; end; {如果是改引入表式，将允许HOOK} if not Trap then AllowChange:=true; Change; {开始HOOK} {如果是改引入表式，将暂时不允许HOOK} if not Trap then AllowChange:=false;end;{HOOK的出口}constructor THookClass.Destroy;begin {如果是改引入表式，将允许HOOK} if not Trap then AllowChange:=true; Restore; {停止HOOK} if Trap then{如果是陷阱式} CloseHandle(hProcess);end;{开始HOOK}procedure THookClass.Change;var nCount: DWORD; BeenDone: TList;begin if Trap then{如果是陷阱式} begin if (AlreadyHook)or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then exit; AlreadyHook:=true;{表示已经HOOK} WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount); end else begin{如果是改引入表式} if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit; BeenDone:=TList.Create; {用于存放当前进程所有DLL模块的名字} try PatchAddressInModule(BeenDone,GetModuleHandle(nil),OldFunction,NewFunction); finally BeenDone.Free; end; end;end;{恢复系统函数的调用}procedure THookClass.Restore;var nCount: DWORD; BeenDone: TList;begin if Trap then{如果是陷阱式} begin if (not AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then exit; WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount); AlreadyHook:=false;{表示退出HOOK} end else begin{如果是改引入表式} if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit; BeenDone:=TList.Create;{用于存放当前进程所有DLL模块的名字} try PatchAddressInModule(BeenDone,GetModuleHandle(nil),NewFunction,OldFunction); finally BeenDone.Free; end; end;end;end.主程序unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,UnitHookType;type TForm1 = class(TForm) lst1: TListBox; btn1: TButton; btn2: TButton; btn3: TButton; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btn2Click(Sender: TObject); procedure btn1Click(Sender: TObject); procedure btn3Click(Sender: TObject); private hMapObj : THandle; pShMem : PShareMem; fWndClosed:boolean;{是否正在退出主程序} procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA; { Private declarations } public { Public declarations } end;var Form1: TForm1; procedure StartHook; stdcall; external '../DB.dll'; procedure StopHook; stdcall; external '../DB.dll';implementation{$R *.dfm}{ TForm1 }procedure TForm1.btn1Click(Sender: TObject);beginStartHook;end;procedure TForm1.btn2Click(Sender: TObject);beginStopHook;Sleep(500);end;procedure TForm1.btn3Click(Sender: TObject);var hh:THandle;beginhh:= pShMem^.HProc;ShowMessage(IntToStr(hh)); TerminateProcess( pShMem^.HProc,1);end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);beginStopHook;Sleep(500);end;procedure TForm1.FormCreate(Sender: TObject);begin hMapObj := OpenFileMapping(FILE_MAP_WRITE,{获取完全访问映射文件} False,{不可继承的} LPCTSTR(MappingFileName));{映射文件名字} if hMapObj = 0 then begin ShowMessage('不能定位内存映射文件块!'); Halt; end; pShMem := MapViewOfFile(hMapObj,FILE_MAP_WRITE,0,0,0); if pShMem = nil then begin ShowMessage('映射文件错误'+ IntToStr(GetLastError)); CloseHandle(hMapObj); Halt; end; FillChar(pShMem^, SizeOf(TShareMem), 0); pShMem^.hProcWnd := Self.Handle; pShMem^.HProc:=OpenProcess( PROCESS_ALL_ACCESS,FALSE,GetCurrentProcessId()); pShMem^.Yrun := true; fWndClosed:=false;end;procedure TForm1.WMCopyData(var Msg: TWMCopyData);var S: string; List1:TStringList; i:integer;begin SetLength(S, Msg.CopyDataStruct.cbData); CopyMemory(@S[1], Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData); List1:=TStringList.Create; if MessageBox(Self.Handle,PChar('是否允许'+s+'运行'),'程序运行',MB_YESNO)=mrYes then pShMem^.YRun:=True else pShMem^.YRun:=False; List1.Text:=s; for i:=0 to List1.Count-1 do begin lst1.Items.Add(list1
); end; List1.Free;end;end.