Porting Hook DLL Code from Delphi 2007 to delphi xe3 - delphi

Question

I have a working hook dll code for a win32 application which I developed in Delphi 2007. Since then I have ported the application to Delphi xe3 but now the hook dll or the injection function doesn't work. The hook dll replaces winsock data send and retrieve functions for UDP and TCP. Please guide.
Injection Function
Function InjectDll(Process: dword; ModulePath: PChar): boolean;
var
Memory:pointer;
Code: dword;
BytesWritten: size_t;
ThreadId: dword;
hThread: dword;
hKernel32: dword;
Inject: packed record
PushCommand:byte;
PushArgument:DWORD;
CallCommand:WORD;
CallAddr:DWORD;
PushExitThread:byte;
ExitThreadArg:dword;
CallExitThread:word;
CallExitThreadAddr:DWord;
AddrLoadLibrary:pointer;
AddrExitThread:pointer;
LibraryName:array[0..MAX_PATH] of char;
end;
begin
Result := false;
Memory := VirtualAllocEx(Process, nil, sizeof(Inject),
MEM_COMMIT, PAGE_EXECUTE_READWRITE);
if Memory = nil then Exit;
Code := dword(Memory);
Inject.PushCommand := $68;
inject.PushArgument := code + $1E;
inject.CallCommand := $15FF;
inject.CallAddr := code + $16;
inject.PushExitThread := $68;
inject.ExitThreadArg := 0;
inject.CallExitThread := $15FF;
inject.CallExitThreadAddr := code + $1A;
hKernel32 := GetModuleHandle('kernel32.dll');
inject.AddrLoadLibrary := GetProcAddress(hKernel32, 'LoadLibraryA');
inject.AddrExitThread := GetProcAddress(hKernel32, 'ExitThread');
lstrcpy(#inject.LibraryName, ModulePath);
WriteProcessMemory(Process, Memory, #inject, sizeof(inject), BytesWritten);
hThread := CreateRemoteThread(Process, nil, 0, Memory, nil, 0, ThreadId);
if hThread = 0 then Exit;
CloseHandle(hThread);
Result := True;
end;
Hook DLL
unit uMain;
interface
implementation
uses
windows, SysUtils,
advApiHook,
Winsock2b;
const
ModuleName = 'Main Dll Unit';
var
// >> Replaced functions for intercepting UDP messages
TrueSendTo : function (s: TSocket; Buf : Pointer; len, flags: Integer; var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;
TrueWsaRecvFrom : function (s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesRecvd: PDWORD; lpFlags: PDWORD; lpFrom: psockaddr;
lpFromlen: PInt; lpOverlapped: LPWSAOVERLAPPED;
lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE): u_int; stdcall;
// <<
// >> Replaced functions for intercepting TCP messages
TrueConnect : function (s: TSocket; name: PSockAddr; namelen: Integer): Integer; stdcall;
TrueSend : function (s: TSocket; Buf : Pointer; len, flags: UINT): Integer; stdcall;
TrueWsaRecv : function (s: TSocket; lpBuffers : PWSABUF; dwBufferCount : DWORD;
lpNumberOfBytesSent : LPDWORD; dwFlags : PDWORD; lpOverlapped : POVERLAPPED;
lpCompletionRoutine : Pointer ): Integer; stdcall;
// <<
// >> Other replaced functions; just for logging now
TrueRecv : function (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
TrueRecvfrom : function (s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr;
var fromlen: Integer): Integer; stdcall;
TrueWsaSend : function (s: TSocket; lpBuffers : PWSABUF; dwBufferCount : DWORD;
lpNumberOfBytesSent : LPDWORD; dwFlags : DWORD; lpOverlapped : POVERLAPPED;
lpCompletionRoutine : Pointer ): Integer; stdcall;
TrueGethostbyname : function (name: PChar): PHostEnt; stdcall;
TrueAccept : function (s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; stdcall;
TrueWsaAccept : function (s: TSOCKET; addr: psockaddr; addrlen: PINT; lpfnCondition: PCONDITIONPROC;
dwCallbackData: DWORD): TSOCKET; stdcall;
// <<
function NewSendTo(s: TSocket; Buf : Pointer; len, flags: Integer; var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;
var
addrtoNew : TSockAddr;
buffer : array of byte;
dst : word;
begin
// determine destination address
if addrto.sin_addr.S_addr = u_long($FFFFFFFF) then
dst := $FFFF
else if (addrto.sin_addr.S_un_w.s_w1 = $000A) then
dst := addrto.sin_addr.S_un_w.s_w2
else
begin
// weird situation... just emulate standard behavior
result := TrueSendTo(s, Buf, len, flags, addrto, tolen);
exit;
end;
// initialize structure for new address
Move(addrto, addrtoNew, sizeOf(TSockAddr));
// change destination ip
addrtoNew.sin_addr.S_addr := $0100007F; // = 127.0.0.1
// change destination port
addrtoNew.sin_port := $E117;
// create new data with additional destination address in it
SetLength(buffer, len+2);
Move(Buf^, buffer[0], len);
Move(dst, buffer[len], 2);
// send modified package
result := TrueSendTo(s, #buffer[0], len+2, flags, addrtoNew, tolen);
end;
function NewWSARecvFrom(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesRecvd: PDWORD; lpFlags: PDWORD; lpFrom: psockaddr;
lpFromlen: PInt; lpOverlapped: LPWSAOVERLAPPED;
lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE): u_int; stdcall;
begin
result := TrueWsaRecvFrom(s, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd, lpFlags, lpFrom,
lpFromlen, lpOverlapped, lpCompletionRoutine);
// ignore recevies with optional lpFrom
if (lpFrom = nil) or (lpFromlen = nil) or (lpFromlen^ = 0) then
exit;
// change only our packages
if lpFrom.sin_addr.S_addr <> $0100007F then
begin
log(ModuleName, 'Unknown package sender');
exit;
end;
// replace source ip
lpFrom.sin_addr.S_un_w.s_w1 := $000A;
move(PByteArray(lpBuffers.buf)[lpNumberOfBytesRecvd^ - 2], lpFrom.sin_addr.S_un_w.s_w2, 2);
// data size should be smaller by 2 bytes (without source id)
lpNumberOfBytesRecvd^ := lpNumberOfBytesRecvd^ - 2;
end;
function NewConnect(s: TSocket; name: PSockAddr; namelen: Integer): Integer; stdcall;
var
newName : TSockAddr;
dst : word;
dstFile : TextFile;
begin
// determine destination address
if (name.sin_addr.S_un_w.s_w1 = $000A) then
dst := name.sin_addr.S_un_w.s_w2
else
begin
// connection to non-LAN host; just emulate standard behavior
result := TrueConnect(s, name, namelen);
exit;
end;
// write destination address into the temporarily file
AssignFile(dstFile, 'temp.dll.dst');
Rewrite(dstFile);
Writeln(dstFile, dst);
CloseFile(dstFile);
// change destination address and port
move(name^, newName, sizeOf(TSockAddr));
newName.sin_addr.S_addr := $0100007F;
newName.sin_port := $E117;
// call standard method
result := TrueConnect(s, #newName, namelen);
end;
function NewRecv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
result := TrueRecv(s, Buf, len, flags);
end;
function NewRecvfrom(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr;
var fromlen: Integer): Integer; stdcall;
begin
result := TrueRecvfrom(s, Buf, len, flags, from, fromlen);
end;
function NewWsaSend(s : TSocket; lpBuffers : PWSABUF; dwBufferCount : DWORD; lpNumberOfBytesSent : LPDWORD;
dwFlags : DWORD; lpOverlapped : POVERLAPPED; lpCompletionRoutine : Pointer ): Integer; stdcall;
begin
result := TrueWsaSend(s, lpBuffers, dwBufferCount, lpNumberOfBytesSent, dwFlags, lpOverlapped, lpCompletionRoutine);
end;
function NewWsaRecv(s : TSocket; lpBuffers : PWSABUF; dwBufferCount : DWORD; lpNumberOfBytesSent : LPDWORD;
dwFlags : PDWORD; lpOverlapped : POVERLAPPED; lpCompletionRoutine : Pointer ): Integer; stdcall;
begin
result := TrueWsaRecv(s, lpBuffers, dwBufferCount, lpNumberOfBytesSent, dwFlags, lpOverlapped, lpCompletionRoutine);
end;
function NewSend(s: TSocket; Buf : Pointer; len, flags: Integer): Integer; stdcall;
begin
result := TrueSend(s, Buf, len, flags);
end;
function NewGethostbyname(name: PChar): PHostEnt; stdcall;
begin
result := TrueGethostbyname(name);
end;
function NewAccept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; stdcall;
begin
result := TrueAccept(s, addr, addrlen);
end;
function NewWsaAccept(s: TSOCKET; addr: psockaddr; addrlen: PINT;
lpfnCondition: PCONDITIONPROC; dwCallbackData: DWORD): TSOCKET; stdcall;
begin
result := TrueWsaAccept(s, addr, addrlen, lpfnCondition, dwCallbackData);
end;
procedure replaceMethod(libName, method: String; newProc: pointer; var oldProc: pointer);
begin
HookProc(PChar(libName), PChar(method), newProc, oldProc);
end;
initialization
// replace methods
replaceMethod('ws2_32.dll', 'send', #NewSend, #TrueSend);
replaceMethod('ws2_32.dll', 'sendto', #NewSendTo, #TrueSendTo);
replaceMethod('ws2_32.dll', 'recv', #NewRecv, #TrueRecv);
replaceMethod('ws2_32.dll', 'recvfrom', #NewRecvfrom, #TrueRecvfrom);
replaceMethod('ws2_32.dll', 'WSASend', #NewWsaSend, #TrueWsaSend);
replaceMethod('ws2_32.dll', 'WSARecv', #NewWsaRecv, #TrueWsaRecv);
replaceMethod('ws2_32.dll', 'WSARecvFrom', #NewWsaRecvFrom, #TrueWsaRecvFrom);
replaceMethod('ws2_32.dll', 'connect', #NewConnect, #TrueConnect);
replaceMethod('ws2_32.dll', 'gethostbyname', #NewGethostbyname, #TrueGethostbyname);
replaceMethod('ws2_32.dll', 'accept', #NewAccept, #TrueAccept);
replaceMethod('ws2_32.dll', 'WSAAccept', #NewWsaAccept, #TrueWsaAccept);
finalization
// release hooks
UnhookCode(#TrueSend);
UnhookCode(#TrueSendTo);
UnhookCode(#TrueRecv);
UnhookCode(#TrueRecvfrom);
UnhookCode(#TrueWsaSend);
UnhookCode(#TrueWsaRecv);
UnhookCode(#TrueWsaRecvFrom);
UnhookCode(#TrueConnect);
UnhookCode(#TrueGethostbyname);
UnhookCode(#TrueAccept);
UnhookCode(#TrueWsaAccept);
end.