Delphi APIHook CreateProcess-木庄网络博客

本文整理自网络，侵删。
 unit ApiHook;

interface

uses
  Windows, Messages, Dialogs, Controls, Classes, SysUtils, psapi;

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
    hProcess: Cardinal;
    AlreadyHook: boolean;
    Oldcode: array[0..4] of byte; {系统函数原来的前5个字节}
    Newcode: TLongJmp; {将要写在系统函数的前5个字节}
  public
    OldFunction, NewFunction: Pointer;
    Constructor Create(OldFun, NewFun: Pointer);
    Constructor Destore;
    procedure Restore;
    procedure Change;
  end;

procedure API_Hookup;
procedure Un_API_Hook;


implementation

type
  TCreateProcess = function(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
    lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
    bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
    lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
    var lpProcessInformation: TProcessInformation): BOOL; stdcall;

var
  xHookClass: THookClass;

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;

function MyCreateProcess(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
  lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
  lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL; stdcall;
var
  s: String;
begin
  xHookClass.Restore;
  Result := FALSE;
  s := lpApplicationName+'---'+lpCommandLine;
  if MessageDlg('已截获'+s+'，是否允许运行？', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then begin
    xHookClass.Change;
    exit;
  end;
  Result := TCreateProcess(xHookClass.OldFunction)(lpApplicationName, lpCommandLine, lpProcessAttributes,
    lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
    lpCurrentDirectory, lpStartupInfo, lpProcessInformation);
  xHookClass.Change;
end;

procedure API_Hookup;
begin
  xHookClass := THookClass.Create(@CreateProcessW, @MyCreateProcess);
end;

procedure Un_API_Hook;
begin
  xHookClass.Destroy;
end;

{ THookClass }

procedure THookClass.Change;
var
  nCount: DWORD;
begin
  if (AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
    exit;
  AlreadyHook := true; {表示已经HOOK}
  WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount);
end;

constructor THookClass.Create(OldFun, NewFun: Pointer);
var
  Pid: DWORD;
begin
  OldFunction := TrueFunctionAddress(OldFun);
  NewFunction := TrueFunctionAddress(NewFun);

  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;

constructor THookClass.Destore;
begin
  Restore;
  CloseHandle(hProcess);
end;

procedure THookClass.Restore;
var
  nCount: DWORD;
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;

initialization


finalization
  Un_API_Hook;


end.

来源：http://blog.csdn.net/x44348428/article/details/4471353
Delphi APIHook CreateProcess

相关推荐

评论
