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 repeat until 随机插入

Delphi判断一个字符是否为汉字的最佳方法

Delphi �c 使用createoleobject后释放olevariant

Delphi dbgrid鼠标滚屏

Delphi 10.4 新变化:定制拖管记录(结构)类型

Delphi windows 获取指定进程句柄数

Delphi ado 连接mssql数据库

Delphi强制关闭执行程序(杀进程)

Delphi调用阿里云的对象存储服务oss

Delphi 调试tms web core应用

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...