将DLLDLL代码从Delphi2007移植到delphixe3

原作者: [db:作者] 来自: [db:来源] 收藏邀请

我有一个在Delphi 2007中开发的win32应用程序的工作钩子dll代码。从那时起，我将应用程序移植到Delphi xe3，但现在hook dll或注入函数不起作用。 hook dll替换了winsock数据发送和检索UDP和TCP的功能。请指导。注射功能

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.