我有一个在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.