Good evening
I'm Mastering using the DDetours Library, but porting to Lazarus... hasnt been Fun these days , but a, still learning as i know i have a whole lot to fight with to achieve success there
in the mean time, i decided to get busy with some hooking , by trying to change the code from C++ to pascal, hence i wrote something like this , outta ma spare time..
Now i get some errors, here. Which goes like this
Options changed, recompiling clean with -B
sendRecvDLL.lpr(37,13) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(37,33) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(38,60) Hint: Local variable "OldProtect" does not seem to be initialized
sendRecvDLL.lpr(40,28) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(43,19) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(43,11) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(45,25) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(45,17) Hint: Conversion between ordinals and pointers is not portable
sendRecvDLL.lpr(71,4) Error: Wrong number of parameters specified for call to "HookAPI"
sendRecvDLL.lpr(24,10) Hint: Found declaration: HookAPI(AnsiString,AnsiString,Pointer,var Pointer):Boolean;
sendRecvDLL.lpr(73,4) Error: Wrong number of parameters specified for call to "HookAPI"
sendRecvDLL.lpr(24,10) Hint: Found declaration: HookAPI(AnsiString,AnsiString,Pointer,var Pointer):Boolean;
sendRecvDLL.lpr(79,12) Error: Identifier not found "DllProc"
sendRecvDLL.lpr(82) Fatal: There were 3 errors compiling module, stopping
library sendRecvDLL;
{$mode delphi}{$H+}
uses
SysUtils,
Classes,
Winsock2,
Windows;
var
TrampolineSend: function(Sock: TSocket; var Buf; Len, Flags: Integer): Integer; stdcall;
TrampolineRecv: function(Sock: TSocket; var Buf; Len, Flags: Integer): Integer; stdcall;
function BufferToHex(Buf: PChar; Len: Integer): String;
var
I: Integer;
begin
Result := '';
for I := 0 to Len - 1 do
Result := Result + IntToHex(Ord(Buf[I]), 2) + ' ';
end;
function HookAPI(TargetModule, TargetProc: string; NewProc: pointer; var OldProc: pointer): boolean;
var
Address: longword;
OldProtect: longword;
OldFunction: pointer;
Proc: pointer;
hModule: longword;
begin
Result:=False;
try
hModule := LoadLibrary(pchar(TargetModule));
Proc := GetProcAddress(hModule, pchar(TargetProc));
Address := longword(NewProc) - longword(Proc) - 5;
VirtualProtect(Proc, 5, PAGE_EXECUTE_READWRITE, OldProtect);
GetMem(OldFunction, 255);
longword(OldFunction^) := longword(Proc);
byte(pointer(Proc)^) := $e9;
longword(pointer(longword(Proc) + 1)^) := Address;
VirtualProtect(Proc, 5, OldProtect, OldProtect);
OldProc := pointer(longword(OldFunction) + 5);
FreeLibrary(hModule);
except
Exit;
end;
Result:=True;
end;
function InterceptSend(Sock: TSocket; var Buf; Len, Flags: Integer): Integer; stdcall;
begin
MessageBoxW(0, PWideChar('Send: ' + BufferToHex(@Buf, Len)), PWideChar('Send'), 0);
Result:=TrampolineSend(Sock, Buf, Len, Flags);
end;
function InterceptRecv(Sock: TSocket; var Buf; Len, Flags: Integer): Integer; stdcall;
begin
Result := TrampolineRecv(Sock, Buf, Len, Flags);
MessageBoxW(0, PWideChar('Recv: ' + BufferToHex(@Buf, Len)), PWideChar('Recv'), 0);
end;
procedure DLLEntryPoint(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
if not Assigned(TrampolineSend) then
HookAPI('ws2_32.dll',@send,InterceptSend); //error here
if not Assigned(TrampolineRecv) then
HookAPI('ws2_32.dll',@recv,InterceptRecv); // error here
end;
end;
end;
begin
DllProc:=@DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.