網友寫的HookAPI源代碼

網友寫的HookAPI源代碼 

unit dllMain;
{*********************************************************
程序:   HookAPI函數
作者:   sunsjw
QQ  :   25656016
Blog:   [url]http://www.kao8.cn/blog.asp?name=sunsjw[/url]
**********************************************************}
interface
uses
  SysUtils,Windows,Winsock,Graphics,tlHelp32,madCodeHook;
type
  //要HOOK的API函數定義
  TSockSendProc = function (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  TSockRecvProc = function (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  TMsgBoxProc = function(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
//--------------------函數聲明---------------------------  
function Sun_Send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function Sun_Recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function Sun_Box(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
procedure Hook;stdcall;export;
procedure UnHook;stdcall;export;
var
  //用來保存原來函數的地址
  sunSend: TSockSendProc;
  sunRecv: TSockRecvProc;
  sunMsg: TMsgBoxProc;
  i: Integer;
  
implementation
function Sun_Box(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
var
  strTemp: string;
begin
  strTemp := '珊瑚蟲:sunsjw';
  Result := sunMsg(hWnd,lpText,pchar(strTemp),uType);
end;
{---------------------------------------}
{函數功能:Recv函數的HOOK
{函數參數:同Recv
{函數返回值:integer
{---------------------------------------}
function Sun_Recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
  //在這裏要對接收的數據Buf進行處理
  //暫時不處理了，隨便響一聲吧。
  MessageBeep(0);
  //調用直正的Send函數
  Result := sunRecv(s,Buf,len, flags);
end;
{---------------------------------------}
{函數功能:Send函數的HOOK
{函數參數:同Send
{函數返回值:integer
{---------------------------------------}
function Sun_Send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  DeskDC: HDC;
  Can: TCanvas;
  str: string;
  found: boolean;
  Hand,CurrHand: THandle;
  lppe: TProcessEntry32;
begin
  DeskDC := GetDC(0);
  Can := TCanvas.Create;
  Can.Handle := DeskDC;
  CurrHand := GetCurrentProcessID();
  Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
  lppe.dwSize := sizeof(lppe);
  found := Process32First(Hand,lppe);
  while found do
  begin
    if lppe.th32ProcessID=CurrHand then
    begin
      str := lppe.szExeFile;
      found := false;
    end
    else
      found := Process32Next(Hand,lppe);
  end;
  try
    Inc(i);
    Can.TextOut(0,0,str+':正在發送數據...');
  finally
    Can.Free;
    ReleaseDC(0,DeskDC);
  end;
  Result := sunSend(s,Buf,len, flags);
end;
{------------------------------------}
{過程功能:HookAPI
{過程參數:無
{------------------------------------}
procedure Hook;
begin
  HookAPI('ws2_32.dll','send',@Sun_Send,@sunSend);
  HookAPI('ws2_32.dll','recv',@Sun_Recv,@sunRecv);
  HookAPI('user32.dll','MessageBoxA',@sun_Box,@sunMsg);
end;
{------------------------------------}
{過程功能:取消HOOKAPI
{過程參數:無
{------------------------------------}
procedure UnHook;
begin
  UnHookAPI(@sunSend);
  UnHookAPI(@sunRecv);
  UnHookAPI(@sunMsg);
end;
end.
////////////////////////////////////////////
//調用
unit callMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,madCodeHook;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
  //把我們的函數注放到其它進程中
  InjectLibrary(ALL_SESSIONS or SYSTEM_PROCESSES,'hookMsg.dll');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  UninjectLibrary(ALL_SESSIONS or SYSTEM_PROCESSES,'hookMsg.dll');
end;
end.