Socket Hook

//-------------------------------------------------------------------------------------------------Hook.dpr 

library Hook;

uses
  SysUtils,
  windows,
  Messages,
  APIHook in 'APIHook.pas';

type
  PData = ^TData;
  TData = record
    Hook: THandle;
    Hooked: Boolean;
  end;

var
  DLLData: PData;

  {------------------------------------}
  {¹ý³ÌÃû:HookProc
  {¹ý³Ì¹¦ÄÜ:HOOK¹ý³Ì
  {¹ý³Ì²ÎÊý:nCode,   wParam,   lParamÏûÏ¢µÄÏà
  {   ¹Ø²ÎÊý
  {------------------------------------}
procedure HookProc(nCode, wParam, lParam: LongWORD); stdcall;
begin
  if not DLLData^.Hooked then begin
    HookAPI;
    DLLData^.Hooked := True;
  end;
  //µ÷ÓÃÏÂÒ»¸öHook
  CallNextHookEx(DLLData^.Hook, nCode, wParam, lParam);
end;

{------------------------------------}
{º¯ÊýÃû:InstallHook
{º¯Êý¹¦ÄÜ:ÔÚÖ¸¶¨´°¿ÚÉÏ°²×°HOOK
{º¯Êý²ÎÊý:sWindow:Òª°²×°HOOKµÄ´°¿Ú
{·µ»ØÖµ:³É¹¦·µ»ØTRUE,ʧ°Ü·µ»ØFALSE
{------------------------------------}
function InstallHook(SWindow: LongWORD): Boolean; stdcall;
var
  ThreadID: LongWORD;
begin
  Result := False;
  DLLData^.Hook := 0;
  ThreadID := GetWindowThreadProcessId(SWindow, nil);
  //¸øÖ¸¶¨´°¿Ú¹ÒÉϹ³×Ó
  DLLData^.Hook := SetWindowsHookEx(WH_GETMESSAGE, @HookProc, Hinstance, ThreadID);
  if DLLData^.Hook > 0 then
    Result := True //ÊÇ·ñ³É¹¦HOOK
  else
    exit;
end;

{------------------------------------}
{¹ý³ÌÃû:UnHook
{¹ý³Ì¹¦ÄÜ:жÔØHOOK
{¹ý³Ì²ÎÊý:ÎÞ
{------------------------------------}
procedure UnHook; stdcall;
begin
  UnHookAPI;
  //жÔØHook
  UnhookWindowsHookEx(DLLData^.Hook);
end;

{------------------------------------}
{¹ý³ÌÃû:DLLÈë¿Úº¯Êý
{¹ý³Ì¹¦ÄÜ:½øÐÐDLL³õʼ»¯,ÊͷŵÈ
{¹ý³Ì²ÎÊý:DLL״̬
{------------------------------------}
procedure MyDLLHandler(Reason: Integer);
var
  FHandle: LongWORD;
begin
  case Reason of
    DLL_PROCESS_ATTACH: begin //½¨Á¢ÎļþÓ³Éä,ÒÔʵÏÖDLLÖеÄÈ«¾Ö±äÁ¿
        FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, $FFFF, 'MYDLLDATA');
        if FHandle = 0 then
          if GetLastError = ERROR_ALREADY_EXISTS then begin
            FHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, 'MYDLLDATA');
            if FHandle = 0 then exit;
          end else exit;
        DLLData := MapViewOfFile(FHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
        if DLLData = nil then
          CloseHandle(FHandle);
      end;
    DLL_PROCESS_DETACH: begin
        if Assigned(DLLData) then begin
          UnmapViewOfFile(DLLData);
          DLLData := nil;
        end;
      end;
  end;
end;

//{$R   *.res}
exports
  InstallHook, UnHook, HookProc;

begin
  DLLProc := @MyDLLHandler;
  MyDLLHandler(DLL_PROCESS_ATTACH);
  DLLData^.Hooked := False;
end.

 

 

//-----------------------------------------------------------------------------------------------------------------APIHook.pas

unit APIHook;

interface

uses
  SysUtils,
  Windows, WinSock;

type
  //ÒªHOOKµÄAPIº¯Êý¶¨Òå
  TSockProc = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;

  PJmpCode = ^TJmpCode;
  TJmpCode = packed record
    JmpCode: BYTE;
    Address: TSockProc;
    MovEAX: array[0..2] of BYTE;
  end;

  //--------------------º¯ÊýÉùÃ÷---------------------------
procedure HookAPI;
procedure UnHookAPI;
procedure WriteAppexceptionLog(Log: string);

var
  OldSend, OldRecv: TSockProc; //Ô­À´µÄAPIµØÖ·
  JmpCode: TJmpCode;
  OldProc: array[0..1] of TJmpCode;
  AddSend, AddRecv: pointer; //APIµØÖ·
  TmpJmp: TJmpCode;
  ProcessHandle: THandle;
implementation

{---------------------------------------}
{º¯Êý¹¦ÄÜ:Sendº¯ÊýµÄHOOK
{º¯Êý²ÎÊý:ͬSend
{º¯Êý·µ»ØÖµ:integer
{---------------------------------------}
function MySend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  i, dwSize: cardinal;
  buff: array of char;
  str: string;
begin
  //Õâ¶ù½øÐз¢Ë͵ÄÊý¾Ý´¦Àí
  //MessageBeep(1000); //¼òµ¥µÄÏìÒ»Éù
  //µ÷ÓÃÖ±ÕýµÄSendº¯Êý
  WriteProcessMemory(ProcessHandle, AddSend, @OldProc[0], 8, dwSize);
  setlength(buff, len);
  move(Buf, buff[0], len); str := '';
  for i := 1 to len do str := str + buff[i - 1]; // inttohex(BYTE(buff[i - 1]), 2) + '  ' buff[i] := char(BYTE(buff[i]) + 1);
  WriteAppexceptionLog(str);
  //copymemory(@Buf,buff,len);
 //Result := OldSend(s, buff[0], len, flags);
  Result := OldSend(s, Buf, len, flags);
  JmpCode.Address := @MySend;
  WriteProcessMemory(ProcessHandle, AddSend, @JmpCode, 8, dwSize);
end;

procedure WriteAppexceptionLog(Log: string);
var
  f: textfile;
begin
  try
    if not fileexists('c:/error.log') then begin
      assignfile(f, 'c:/error.log');
      rewrite(f);
      try
        writeln(f, DateTimetostr(now) + '  ' + Log);
      finally
        closefile(f);
      end;
    end
    else begin
      assignfile(f, 'c:/error.log');
      Append(f);
      try
        writeln(f, DateTimetostr(now) + '  ' + Log);
      finally
        closefile(f);
      end;
    end;
  except
    on E: Exception do begin
      // Mainfrm.MemoDebug.Lines.Add('Appexception ' + E.Message);
    end;
  end;
end;

{---------------------------------------}
{º¯Êý¹¦ÄÜ:Recvº¯ÊýµÄHOOK
{º¯Êý²ÎÊý:ͬRecv
{º¯Êý·µ»ØÖµ:integer
{---------------------------------------}
function MyRecv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  dwSize: cardinal;
begin
  //Õâ¶ù½øÐнÓÊÕµÄÊý¾Ý´¦Àí
  //MessageBeep(1000); //¼òµ¥µÄÏìÒ»Éù
  //µ÷ÓÃÖ±ÕýµÄRecvº¯Êý
  WriteProcessMemory(ProcessHandle, AddRecv, @OldProc[1], 8, dwSize);
  Result := OldRecv(s, Buf, len, flags);
  JmpCode.Address := @MyRecv;
  WriteProcessMemory(ProcessHandle, AddRecv, @JmpCode, 8, dwSize);
end;

{------------------------------------}
{¹ý³Ì¹¦ÄÜ:HookAPI
{¹ý³Ì²ÎÊý:ÎÞ
{------------------------------------}

procedure HookAPI;
var
  DLLModule: THandle;
  dwSize: cardinal;
begin
  ProcessHandle := GetCurrentProcess;
  DLLModule := LoadLibrary('ws2_32.dll');
  AddSend := GetProcAddress(DLLModule, 'send'); //È¡µÃAPIµØÖ·
  AddRecv := GetProcAddress(DLLModule, 'recv');
  JmpCode.JmpCode := $B8;
  JmpCode.MovEAX[0] := $FF;
  JmpCode.MovEAX[1] := $E0;
  JmpCode.MovEAX[2] := 0;
  ReadProcessMemory(ProcessHandle, AddSend, @OldProc[0], 8, dwSize);
  JmpCode.Address := @MySend;
  WriteProcessMemory(ProcessHandle, AddSend, @JmpCode, 8, dwSize); //ÐÞ¸ÄSendÈë¿Ú
  ReadProcessMemory(ProcessHandle, AddRecv, @OldProc[1], 8, dwSize);
  JmpCode.Address := @MyRecv;
  WriteProcessMemory(ProcessHandle, AddRecv, @JmpCode, 8, dwSize); //ÐÞ¸ÄRecvÈë¿Ú
  OldSend := AddSend;
  OldRecv := AddRecv;
end;

{------------------------------------}
{¹ý³Ì¹¦ÄÜ:È¡ÏûHOOKAPI
{¹ý³Ì²ÎÊý:ÎÞ
{------------------------------------}
procedure UnHookAPI;
var
  dwSize: cardinal;
begin
  WriteProcessMemory(ProcessHandle, AddSend, @OldProc[0], 8, dwSize);
  WriteProcessMemory(ProcessHandle, AddRecv, @OldProc[1], 8, dwSize);
end;

end.

//-------------------------------------------------------------------------------------------------------unit1.pas

unit Uni2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    ClientSocket1: TClientSocket;
    ServerSocket1: TServerSocket;
    Button3: TButton;
    Memo1: TMemo;
    Button4: TButton;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  InstallHook: function(SWindow: THandle): Boolean; stdcall;
  UnHook: procedure; stdcall;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  ModuleHandle: THandle;
  TmpWndHandle: THandle;
begin
  TmpWndHandle := 0;
  TmpWndHandle := FindWindow(nil, 'Ä¿±ê´°¿ÚµÄ±êÌâ');
  if not isWindow(TmpWndHandle) then begin
    MessageBox(self.Handle, 'ûÓÐÕÒµ½´°¿Ú', '!!!', MB_OK);
    exit;
  end;
  ModuleHandle := LoadLibrary('Hook.dll');
  @InstallHook := GetProcAddress(ModuleHandle, 'InstallHook');
  @UnHook := GetProcAddress(ModuleHandle, 'UnHook');
  if InstallHook(FindWindow(nil, 'Untitled')) then
    ShowMessage('Hook   OK');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  UnHook

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ClientSocket1.Socket.SendText('1234')
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText)
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  WebBrowser1.Navigate('http://tianya.cn');
end;

end.