Delphi 2007 で開発した win32 アプリケーション用のフック dll コードが動作しています。それ以来、アプリケーションを Delphi xe3 に移植しましたが、フック dll またはインジェクション関数が機能しません。フック dll は、UDP および TCP の winsock データ送信および取得関数を置き換えます。ガイドしてください。
インジェクション機能
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;
フック 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.