Delphi Winsock Hooking Example by Aphex[1]

{
  Delphi Winsock Hooking Example by Aphex
  http://www.iamaphex.cjb.net
  unremote@knology.net

  This example shows you how to hook winsock functions
  of a target process and control incomming and outgoing
  data. It is based on send and recv but it will work the
  same way applied to sendto and recvfrom.

  The output file is a CPL (Control Panel Extension) which
  is simply a special DLL that is loaded when it is double
  clicked. This saves us from having to write a seperate
  loader for the hook library.

  The example shows how to hook the needed functions and
  perform some simple manipulation of the data, using two
  different methods of accessing the data. The second, which
  uses pointers, is more flexible but also more complex.
}

library Project1;

uses
  Windows,
  Winsock,
  SysUtils,
  madCodeHook;

{$R *.RES}

{$E CPL}

var
  sendNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  recvNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  DataSocket: TSocket;

const
  szTargetExe: string = 'GAME.EXE';

function ConvertDataToAscii(Buffer: pointer; Length: Word): string;
var
  Iterator: integer;
  AsciiBuffer: string;
begin
  AsciiBuffer := '';
  for Iterator := 0 to Length - 1 do
  begin
    if char(pointer(integer(Buffer) + Iterator)^) in [#32..#127] then
      AsciiBuffer := AsciiBuffer + ' ' + char(pointer(integer(Buffer) + Iterator)^) + ' '
    else
      AsciiBuffer := AsciiBuffer + ' . ';
  end;
  Result := AsciiBuffer;
end;

function ConvertDataToHex(Buffer: pointer; Length: Word): string;
var
  Iterator: integer;
  HexBuffer: string;
begin
  HexBuffer := '';
  for Iterator := 0 to Length - 1 do
  begin
    HexBuffer := HexBuffer + IntToHex(Ord(char(pointer(integer(Buffer) + Iterator)^)), 2) + ' ';
  end;
  Result := HexBuffer;
end;

function recvHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  AsciiBuffer: string;
  HexBuffer: string;
  DataBuffer: pchar;
begin
  //call the real winsock function
  Result := recvNextHook(s, Buf, len, flags);
  //allocate memory for our copy of the data
  GetMem(DataBuffer, Result);
  try
    //get our copy of the data
    CopyMemory(DataBuffer, @Buf, Result);
    //using the data as a byte array
    DataBuffer[0] := chr(10);  //changing first byte
    DataBuffer[1] := chr(20);  //changing second byte
    DataBuffer[2] := chr(30);  //changing thrid byte
    //using the data as a pointer to other data sizes
    word(pointer(DataBuffer)^) := 10; //changing first 2 bytes
    dword(pointer(integer(DataBuffer) + 2)^) := 20; //changing next 4 bytes
    word(pointer(integer(DataBuffer) + 6)^) := 30; //changing next 2 bytes
    //overwrite the original data with our new data
    CopyMemory(@Buf, DataBuffer, Result);
  finally
    FreeMem(DataBuffer);
  end;
  //convert data to readable ascii suitable for logging
  AsciiBuffer := ConvertDataToAscii(@Buf, Result);
  //convert data to readable hex suitable for logging
  HexBuffer := ConvertDataToHex(@Buf, Result);
end;

function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  AsciiBuffer: string;
  HexBuffer: string;
  DataBuffer: pchar;
begin
  Result := 0;
  //save the socket so we can send data too
  DataSocket := s;
  //allocate memory for our copy of the data
  GetMem(DataBuffer, Result);
  try
    //get our copy of the data
    CopyMemory(DataBuffer, @Buf, Result);
    //using the data as a byte array
  &nb