{
Delphi Winsock Hooking Example by Aphex
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
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);
//call the real winsock function
Result := sendNextHook(s, Buf, len, flags);
end;
procedure EntryPoint(Reason: dword); stdcall;
var
lpFileName: array [0..MAX_PATH - 1] of char;
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
if Reason = DLL_PROCESS_ATTACH then
begin
//check if we are injected inside the target
if lstrcmpi(pchar(Copy(ParamStr(0), Length(ParamStr(0)) - Length(szTargetExe) + 1, Length(szTargetExe))), pchar(szTargetExe)) = 0 then
begin
//if we are then we hook the needed functions
DataSocket := 0;
HookCode(@send, @sendHookProc, @sendNextHook);
HookCode(@recv, @recvHookProc, @recvNextHook);
end
else
begin
//if not then load the target and inject ourself
GetModuleFileName(hInstance, @lpFileName, MAX_PATH);
ZeroMemory(@StartInfo, SizeOf(TStartupInfo));
ZeroMemory(@ProcInfo, SizeOf(TProcessInformation));
StartInfo.dwFlags := STARTF_USESHOWWINDOW;
StartInfo.wShowWindow := SW_SHOW;
CreateProcess(PChar(ExtractFilePath(lpFileName) + szTargetExe), nil, nil, nil, False, 0, nil, nil, StartInfo, ProcInfo);
Sleep(3000);
InjectLibrary(ProcInfo.hProcess, lpFileName);
end;
end;
end;
begin
DLLProc := @EntryPoint;
EntryPoint(DLL_PROCESS_ATTACH);
end.
