DELPHI HOOK 卸载崩溃的问题~~~

unit Unit1;interface
uses
  Windows, Messages, Dialogs, Controls, Classes, SysUtils, psapi;type
TMyCreateProcessInternalA = function(hToken:THandle;
                                 lpApplicationName,lpCommandLine:PAnsiChar;
                                 lpProcessAttributes,lpThreadAttributes:PSecurityAttributes;
                                 bInheritHandles:BOOL;
                                 dwCreationFlags:LongWord;
                                 lpEnvironment:Pointer;
                                 lpCurrentDirectory:PAnsiChar;
                                 lpStartupInfo:pStartupInfoA;
                                 lpProcessInformation:PProcessInformation;
                                 hNewToken:PHandle):BOOL; stdcall;
TMyCreateProcessInternalW = function(hToken:THandle;
                                 lpApplicationName,lpCommandLine:pWideChar;
                                 lpProcessAttributes,lpThreadAttributes:PSecurityAttributes;
                                 bInheritHandles:BOOL;
                                 dwCreationFlags:LongWord;
                                 lpEnvironment:Pointer;
                                 lpCurrentDirectory:pWideChar;
                                 lpStartupInfo:pStartupInfoW;
                                 lpProcessInformation:PProcessInformation;
                                 hNewToken:PHandle):BOOL; stdcall;
//function CreateProcessInternal; external 'kernel32.dll' name 'CreateProcessInternalW';type
  PImpCode = ^TImpCode;
  TImpCode = packed record
    JumpItn: Word; // 应该是$25FF，JUMP 指令
    AddressFun: PPointer; // 真正的开始地址
  end;

  TLongJmp = packed record
    JmpCode: ShortInt; {指令，用$E9来代替系统的指令}
    FuncAddr: DWORD; {函数地址}
  end;  THookClass = Class
  private
    BaseAddr : Pointer ;
    hProcess: Cardinal;
    AlreadyHook: boolean;
    Oldcode: array[0..4] of byte; {系统函数原来的前5个字节}
    Newcode: TLongJmp; {将要写在系统函数的前5个字节}
  public
    OldFunction, NewFunction: Pointer;
    Constructor Create(DllName, FuncName: string ; MYFun : Pointer);
    Constructor Destore;
    procedure Restore;
    procedure Change;
  end;procedure API_Hookup;  stdcall;
procedure Un_API_Hook;     stdcall;
function TrueFunctionAddress(func: Pointer): Pointer; stdcall ;type_HookProceName = function (Var NameStr : string ) : Boolean ;stdcall ;Var
xHookClass:array [0..1] of  THookClass; Exe_ProcePoint : Pointer =  nil;
hhk: HHOOK = 0 ;
// _MyCreateProcessInternalA : TMyCreateProcessInternalA ;
implementationfunction _MyCreateProcessInternalW(hToken:THandle;
                                 lpApplicationName,lpCommandLine:pWideChar;
                                 lpProcessAttributes,lpThreadAttributes:PSecurityAttributes;
                                 bInheritHandles:BOOL;
                                 dwCreationFlags:LongWord;
                                 lpEnvironment:Pointer;
                                 lpCurrentDirectory:pWideChar;
                                 lpStartupInfo:pStartupInfoW;
                                 lpProcessInformation:PProcessInformation;
                                 hNewToken:PHandle):BOOL; stdcall;
Var
   Temp_Str : string ;
begin
  xHookClass[1].Restore;  MessageBoxW(0,lpApplicationName,lpCommandLine,0);   Result :=  TMyCreateProcessInternalW(xHookClass[1].OldFunction)(hToken,lpApplicationName,lpCommandLine,
                                                                 lpProcessAttributes,lpThreadAttributes,
                                                                  bInheritHandles,dwCreationFlags,
                                                                 lpEnvironment,lpCurrentDirectory,lpStartupInfo,
                                                                  lpProcessInformation,hNewToken)  ;
  xHookClass[1].Change;
end;function _MyCreateProcessInternalA(hToken:THandle;
                                 lpApplicationName,lpCommandLine:PAnsiChar;
                                 lpProcessAttributes,lpThreadAttributes:PSecurityAttributes;
                                 bInheritHandles:BOOL;
                                 dwCreationFlags:LongWord;
                                 lpEnvironment:Pointer;
                                 lpCurrentDirectory:PAnsiChar;
                                 lpStartupInfo:pStartupInfoA;
                                 lpProcessInformation:PProcessInformation;
                                 hNewToken:PHandle):BOOL; stdcall;
Var
   Temp_Str : string ;
begin xHookClass[0].Restore;
   MessageBoxA(0,lpApplicationName,lpCommandLine,0); //Temp_Str :=  lpApplicationName;//  if     not    _HookProceName(Exe_ProcePoint)( Temp_Str )  then
//    _HookProceName(Exe_ProcePoint)( Temp_Str ) ;
     Result :=  TMyCreateProcessInternalA( xHookClass[0].OldFunction)(hToken,lpApplicationName,lpCommandLine,
                                                                 lpProcessAttributes,lpThreadAttributes,
                                                                  bInheritHandles,dwCreationFlags,
                                                                  lpEnvironment,lpCurrentDirectory,lpStartupInfo,
                                                                  lpProcessInformation,hNewToken)   ;
  // else   //------------
  // Result := False ;
// Result := True ;
  xHookClass[0].Change;end;
constructor THookClass.Create(DllName, FuncName: string ; MYFun : Pointer);
var
  Pid: DWORD;
  DllModule : THandle;
begin
//获取模块句柄
DllModule:=GetModuleHandle(PChar(DllName));
//如果得不到说明未被加载
if DllModule=0 then DllModule:=LoadLibrary(PChar(DllName));
//得到模块入口地址（基址）
BaseAddr:=Pointer(GetProcAddress(DllModule,PChar(FuncName)));
//获取当前进程句柄
//hProcess:=GetCurrentProcess;
  OldFunction := TrueFunctionAddress(BaseAddr);
  NewFunction := TrueFunctionAddress(MYFun);  Pid := GetCurrentProcessID;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);
  Newcode.JmpCode := ShortInt($E9);
  Newcode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5;
  Move(OldFunction^, Oldcode, 5);
  AlreadyHook := FALSE;  Change;
end;
procedure THookClass.Change;
var
  nCount,addr ,Pid ,hProc: DWORD;
begin
  if (AlreadyHook)  or (OldFunction = nil) or (NewFunction = nil) then
    exit;
  AlreadyHook := true; {表示已经HOOK}    Pid := GetCurrentProcessID;
    hProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);   VirtualProtectEx(hProc, OldFunction,5,PAGE_EXECUTE_READWRITE,addr)  ;
  WriteProcessMemory(hProc, OldFunction, @(Newcode), 5, nCount);
  VirtualProtectEx(hProc, OldFunction,5,PAGE_EXECUTE_READ,addr)  ;  CloseHandle( hProc )
end;
procedure API_Hookup;
begin
  xHookClass[0] := THookClass.Create('kernel32.dll','CreateProcessInternalA',@_MyCreateProcessInternalA);
  xHookClass[1] := THookClass.Create('kernel32.dll','CreateProcessInternalW',@_MyCreateProcessInternalW);
                               //  'kernel32.dll','CreateProcessInternalA',@MyCreateProcessInternalA
  Exe_ProcePoint:= GetProcAddress(GetModuleHandle(nil),'HookProceName');
end;procedure Un_API_Hook;
Var
i : Integer ;
begin
    for I := 0 to High(xHookClass) do
    begin
       // FreeAndNil(xHookClass[I]);       xHookClass[i].Destore;
    end;  // if hhk <> 0 then
   UnhookWindowsHookEx(hhk); // xHookClass.Destroy;
end;constructor THookClass.Destore;
begin
//MessageBox(0,'卸载','',0);
// MessageBox(0,'写回地址','',0);
  Restore;  {if  hProcess <> 0   then
  begin    CloseHandle(hProcess);
  end;  }    {if hhk <> 0 then
  begin
    MessageBox(0,'关闭  hhk','',0);
    UnhookWindowsHookEx(hhk);    hhk :=0 ;
  end;   }
end;procedure THookClass.Restore;
var
  nCount , addr ,Pid,hProc: DWORD;
begin
  if (not AlreadyHook) or (OldFunction = nil) or (NewFunction = nil) then
    exit;      Pid := GetCurrentProcessID;
    hProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);  VirtualProtectEx(hProcess, OldFunction,5,PAGE_EXECUTE_READWRITE,addr)  ;//  MessageBox(0,'写回地址','',0);
  WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
  AlreadyHook := FALSE; {表示退出HOOK}
  VirtualProtectEx(hProcess, OldFunction,5,PAGE_EXECUTE_READ,addr)  ;  CloseHandle(hProc);
end;
function TrueFunctionAddress(func: Pointer): Pointer;
var
  Code: PImpCode;
begin
  Result := func;
  if func = nil then exit;
  try
    Code := func;
    if (Code.JumpItn = $25FF) then begin
      Result := Code.AddressFun^;
    end;
  except
    Result := nil;
  end;
end;
end.

library HOOkdll;{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }uses
   SysUtils,
  Windows,
  Classes,
  dialogs,Messages,  Unit1 in 'Unit1.pas';
Var
//内存映射
MemFile: THandle;
startPid: PDWORD;   //保存PIDBol: Boolean = False;
const
HOOK_MEM_FILENAME = 'tmp.hkt';{$R *.res}//传递消息
procedure HookProc(nCode, wParam, lParam: LongWORD);stdcall;
begin
  if not Bol then
   CallNextHookEx(hhk, nCode, wParam, lParam);
// CallNextHookEx(hhk, nCode, wParam, lParam);
end;
function InstallHook(pid: DWORD): Boolean stdcall;
begin
startPid^ := pid;  //if  hhk = 0   then
      hhk := SetWindowsHookEx(WH_CALLWNDPROC, @HookProc, hInstance, 0);
      Result := hhk <> 0;
end;//结束HOOK
procedure EndHook;  stdcall;
Var
i : Integer;
begin  if   hhk <> 0  then
  begin  //  MessageBox(0,'关闭  hhk','',0);
    UnhookWindowsHookEx(hhk);
      hhk :=0 ;
  end;
    //Un_API_Hook ; // SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0); if   startPid <> nil then
begin
  // MessageBox(0,'关闭 startPid ','',0);
    UnmapViewOfFile(startPid );
    startPid := nil;
end;
   if   MemFile <> 0  then
   begin
     // MessageBox(0,'关闭 MemFile ','',0);
      closehandle(MemFile);
     MemFile := 0 ;
   end; end;//内存映射共想
procedure MemShared();
begin
MemFile:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False, HOOK_MEM_FILENAME);
  if MemFile = 0 then begin //打开失败则衉c2建内存映射文件
      MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
                                4, HOOK_MEM_FILENAME);
  end;
  if MemFile <> 0 then
  begin
      //映射文件到变量
      startPid := MapViewOfFile(MemFile,FILE_MAP_ALL_ACCESS,0,0,0);
  end;
end;
//环境处理
procedure DllEntry(dwResaon: DWORD);
begin
case dwResaon of
    DLL_PROCESS_ATTACH: API_Hookup;   //DLL载入
    DLL_PROCESS_DETACH: Un_API_Hook; //DLL删除
end;
end;exports
InstallHook,EndHook ,Un_API_Hook;begin
MemShared;{ 分配DLL程序到 DllProc 变量 }
DllProc := @DllEntry;
{ 调用DLL加载处理 }
DllEntry(DLL_PROCESS_ATTACH);
end

就是调用 UnhookWindowsHookEx(hhk);

或者关闭窗口就奔溃了.

Un_API_Hook;
这函数就是收到卸载信息.然后写会原来的地址啊procedure THookClass.Restore;
var
  nCount , addr ,Pid,hProc: DWORD;
begin
  if (not AlreadyHook) or (OldFunction = nil) or (NewFunction = nil) then
  exit;  Pid := GetCurrentProcessID;
  hProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);  VirtualProtectEx(hProcess, OldFunction,5,PAGE_EXECUTE_READWRITE,addr) ;// MessageBox(0,'写回地址','',0);
  WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
  AlreadyHook := FALSE; {表示退出HOOK}
  VirtualProtectEx(hProcess, OldFunction,5,PAGE_EXECUTE_READ,addr) ;  CloseHandle(hProc);
end;

我把 SetWindowsHookEx 的返回值改成共享变量,explorer.exe就没奔溃了,但是有些已经进入MYHOOK的进程就会挂点..请问有没什么好解决的办法啊?

http://blog.csdn.net/bdmh/archive/2010/12/29/6104475.aspx
给你个参考对照吧

我改成~  DllModule:=GetModuleHandle(PChar('kernel32.dll'));  if DllModule=0 then DllModule:=LoadLibrary(PChar('kernel32.dll'));
  _MyCreateProceA:=GetProcAddress(DllModule,PChar('CreateProcessInternalA'));
  _MyCreateProceW:=GetProcAddress(DllModule,PChar('CreateProcessInternalW'));           //   'CreateProcessInternalA'
    @MyCreateProcessA :=  GetFunTrueAddress( _MyCreateProceA);
    @MyCreateProcessW :=  GetFunTrueAddress(_MyCreateProceW);
  ReplaceFunAddress(@MyCreateProcessA,@_MyCreateProcessInternalA);
  ReplaceFunAddress(@MyCreateProcessW,@_MyCreateProcessInternalW);为什么就钩不上呢?

THookClass的实现不太好，这个在有多线程时容易出问题
我有一个做好的
http://download.csdn.net/source/3351392

//环境处理
procedure DllEntry(dwResaon: DWORD);
begin
case dwResaon of
DLL_PROCESS_ATTACH: API_Hookup; //DLL载入
DLL_PROCESS_DETACH: Un_API_Hook; //DLL删除
end;
end;不能在这里HOOK在你的EXE中API_Hookup;就可以了

调试易

DELPHI HOOK 卸载崩溃的问题~~~

解决方案 »