Please help create detour in Pascal

[shonay]

Hence still not clear with it, you could help me look this out

From the code /source here


https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=2114&lngWId=7

[skalogryz]

Hmm don't get it twisted, how about seeing if it redirects and pops out a messagebox "hooked "

Ok. I've updated the example to actually show that the message has been modified to demo "hooking" abilities

[shonay]

Hmm don't get it twisted, how about seeing if it redirects and pops out a messagebox "hooked "

Ok. I've updated the example to actually show that the message has been modified to demo "hooking" abilities

Ok sir lemme check and see how it goes

You have a screen shot as apparently am not near ma computer now sir, sorry for causing you problems sir

[skalogryz]

a screen shot?

[shonay]

a screen shot?

Thanks sir for your time.
Normally the fake function is supposed to redirect back to the original function. Like this

Code: [Select]


program MsgBox;

uses
  Windows,
  afxCodeHook;

var
  MessageBoxANextHook: function(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT): Integer; stdcall;

function MessageBoxAHookProc(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT): Integer; stdcall;
begin
  Result := MessageBoxANextHook(0, '', 'bye', 0);
end;

begin
  //test the target API
  MessageBox(0, '', 'hi', 0);

  //hook the API
  HookCode('user32', 'MessageBoxA', @MessageBoxAHookProc, @MessageBoxANextHook);

  //the message should be changed
  MessageBox(0, '', 'hi', 0);

  //unhoook the API
  UnhookCode(@MessageBoxANextHook);

  //test the target API
  MessageBox(0, '', 'hi', 0);
end

Sorry only that he used afxcodehook, tho he used a detour library. It wouldn't redirect to msg here sir, it redirects to the main function as you can see sir.
The detour function still needs to be looked at as apparently it doesn't redirect the hook properly.

[skalogryz]

Thanks sir for your time.
Normally the fake function is supposed to redirect back to the original function.

that's exactly what's happening in hooking.zip example

Code: [Select]

type
  TMessageBoxProc = function (hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;

var
  msg : TMessageBoxProc = nil; // this would keep the reference to call the original function

function HijackMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;
var
  txt : String;
  capt : string;
begin
  writeln('hwnd:    ', hWnd);
  writeln('text:    ', lpText);
  writeln('caption: ', lpCaption);
  writeln('uType:   ', uType);
  if Assigned(msg) then begin
    txt:='hooked '+lpText;
    capt:='capt '+lpCaption;
    // calling the original with the adjusted parameters
    Result:=msg(hWnd, PAnsiChar(txt), PAnsiChar(capt), uType);
    // must release them, since FPC won't do that!
    txt:='';
    capt:='';
  end else
    Result:=0;

end;

begin
  try
    MessageBox(0, 'world', 'hello', 0);
    // DetourFunction - returns the pointer to call the previous version of the hooked function
    msg := TMessageBoxProc(DetourFunction( @MessageBox, @HijackMessageBox, 6));
    MessageBox(0, 'world', 'hello', 0);
  except
    on e: exception do
      writeln(e.message);
  end;
end.


[shonay]

Thanks sir for your time.
Normally the fake function is supposed to redirect back to the original function.

that's exactly what's happening in hooking.zip example

Code: [Select]

type
  TMessageBoxProc = function (hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;

var
  msg : TMessageBoxProc = nil; // this would keep the reference to call the original function

function HijackMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;
var
  txt : String;
  capt : string;
begin
  writeln('hwnd:    ', hWnd);
  writeln('text:    ', lpText);
  writeln('caption: ', lpCaption);
  writeln('uType:   ', uType);
  if Assigned(msg) then begin
    txt:='hooked '+lpText;
    capt:='capt '+lpCaption;
    // calling the original with the adjusted parameters
    Result:=msg(hWnd, PAnsiChar(txt), PAnsiChar(capt), uType);
    // must release them, since FPC won't do that!
    txt:='';
    capt:='';
  end else
    Result:=0;

end;

begin
  try
    MessageBox(0, 'world', 'hello', 0);
    // DetourFunction - returns the pointer to call the previous version of the hooked function
    msg := TMessageBoxProc(DetourFunction( @MessageBox, @HijackMessageBox, 6));
    MessageBox(0, 'world', 'hello', 0);
  except
    on e: exception do
      writeln(e.message);
  end;
end.


Ok what about using to hook send() and recv(), how possible is it gonna be sir with this, I just need examples. 

Thank you sir for your time..

[skalogryz]

Ok what about using to hook send() and recv(), how possible is it gonna be sir with this, I just need examples. 

Is there an issue to do them with afxCodeHook library?

[shonay]

Ok what about using to hook send() and recv(), how possible is it gonna be sir with this, I just need examples. 

Is there an issue to do them with afxCodeHook library?

No issues, only I haven't done it successfully with it. Hence I decided to ask on here, you have an example you can show me with afxcodehook on lazarus, I would be happy to learn from it.

Thank you sir.

[skalogryz]

does "haven't done it successfully" actually mean that these functions were not called?
because an application might not call them. Maybe they're using WinSockA functions?

anyway, here's the example!

[shonay]

does "haven't done it successfully" actually mean that these functions were not called?
because an application might not call them. Maybe they're using WinSockA functions?

anyway, here's the example!

Hmmm, downloaded already u tested with Firefox or? Like which programs use WinsockA functions?

[skalogryz]

Hmmm, downloaded already u tested with Firefox or? Like which programs use WinsockA functions?

neither  
the test is in the program itself.

[shonay]

Hmmm, downloaded already u tested with Firefox or? Like which programs use WinsockA functions?

neither  
the test is in the program itself.

Hmmm ok let's try it this way

Code: [Select]

library Project1;

{$mode delphi}{$H+}

uses
  Classes , Windows , Winsock , SysUtils
  { you can add units after this };

var
  oldsend:function(const s:Tsocket; var :buf; len, flags:Integer):Integer;stdcall;
dwModule : DWORD;

function DetourFunction()
begin
   //type Detour Function here
end;

function: newsend(const s:Tsocket; var :buf; len, flags:Integer):Integer;stdcall;
begin
  MessageBox(0,buf,MB_OK);
  Result:=oldsend(s,buf,len,flags);
end;

procedure DLLEntryPoint(dwReason: DWORD);
begin
  case dwReason of
  DLL_PROCESS_ATTACH:
    begin
      if not Assigned(oldsend) then
      @oldsend := DetourFunction(@Send, @newsend);
      end;
  end;

begin
  DllProc:=@DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

By just adding the detoured function only, kindly help me see if the code compiles without further problems.

Thank you.

[skalogryz]

sample.zip

[rtusrghsdfhsfdhsdfhsfdhs]

Hmm is this possible in linux? I would like to patch some of the methods in the FPC RTL for linux..