DeerBear
asked on
Substituting Window Procedure in another process
Hello,
I am trying to substitute a Window Procedure in another process.
I've come across Madshi collection, thus I was thinking about using
DLL injection in order to solve my problem.
But there's a thing: how can I say which handle the DLL should refer to
after a call to CreateProcessEx?
I mean, how am I supposed to communicate with the DLL in the
other process?
Which other paths may be advisable in order to get a decent result?
TIA,
Andrew
P.S. I tried using hooks, but am having all sorts of troubles, starting from the
fact I have no clue about how to share the right window handle. Any clues on how
I could achieve this?
I am trying to substitute a Window Procedure in another process.
I've come across Madshi collection, thus I was thinking about using
DLL injection in order to solve my problem.
But there's a thing: how can I say which handle the DLL should refer to
after a call to CreateProcessEx?
I mean, how am I supposed to communicate with the DLL in the
other process?
Which other paths may be advisable in order to get a decent result?
TIA,
Andrew
P.S. I tried using hooks, but am having all sorts of troubles, starting from the
fact I have no clue about how to share the right window handle. Any clues on how
I could achieve this?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi again,
This is the DLL I have now:
library EventReg_Hks;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
Hook_Mgt in 'Hook_Mgt.pas',
HookRoutines in 'HookRoutines.pas',
Windows,
Messages,
SysUtils;
{$R *.RES}
type
PShared=^TShared;
TShared = record
WindowHandle: integer;
PID: Cardinal;
bSubClassDone: boolean;
AttachCount:Integer;
end;
var
MemFile: THandle;
Shared: PShared;
OldWndProc: pointer;
const HookMemFileName='MyMemoryM appedFile. Andrea';
function NewWndProc(HWindow: HWnd; Message, WParam: Longint;
LParam: Longint): Longint;
begin
if Message = WM_COMMAND then
begin
if HiWord(WParam) = 0 then
begin
if LoWord( WParam ) = 2 then
Result := CallWindowProc(OldWndProc,
HWindow,
Message,
WParam,
LParam)
else
Result := 0;
Exit;
end;
end;
result := CallWindowProc(OldWndProc,
HWindow,
Message,
WParam,
LParam);
end;
procedure DoSubClassWindow;
begin
if Not Shared^.bSubClassDone then begin
// subclasso la finestra...
Shared^.bSubClassDone := True;
OldWndProc := Pointer(GetWindowLong(Shar ed^.Window Handle, GWL_WNDPROC));
MessageBox( Shared^.WindowHandle,PCHar ( 'Risultato: '+GetLastErrorString( ) ),'WndProc',MB_OK );
SetWindowLong(Shared^.Wind owHandle, GWL_WNDPROC, Longint(@NewWndProc));
end
else // ho già subclassato questa finestra !!
end;
procedure DoSubClassBack;
begin
if Shared^.bSubClassDone then
// de-subclasso la finestra...
SetWindowLong(Shared^.Wind owHandle, GWL_WNDPROC, Longint(OldWndProc));
end;
procedure Intro; stdcall;
begin
MemFile := OpenFileMapping(FILE_MAP_W RITE, False, HookMemFileName);
if MemFile=0 then
MemFile := CreateFileMapping($FFFFFFF F, nil, PAGE_READWRITE, 0,
SizeOf(TShared), HookMemFileName);
Shared := MapViewOfFile(MemFile, FILE_MAP_WRITE, 0, 0, 0);
if MemFile=0 then
FillChar(Shared^, SizeOf(TShared), 0);
Inc(Shared^.AttachCount);
if GetCurrentProcessId = Shared^.PID then
DoSubClassWindow;
end;
procedure Extro; stdcall;
var
bFinished:Boolean;
begin
Dec(Shared^.AttachCount);
bFinished := (Shared^.AttachCount=0);
if (GetCurrentProcessId = Shared^.PID) and Shared^.bSubClassDone then
DoSubClassBack;
if bFinished then
begin
RemoveHook;
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;
end;
procedure DLLEntryPoint(reason:integ er);
begin
case reason of
0: {DLL_PROCESS_DETACH} Extro;
1: {DLL_PROCESS_ATTACH} Intro;
end;
end;
procedure SetPID(APID: Cardinal); stdcall;
begin
Shared^.PID := APID;
end;
procedure SetWindowHandle(AHandle: Integer); stdcall;
begin
Shared^.WindowHandle := AHandle;
Shared^.bSubClassDone := False;
end;
exports
InstallHook index 1,
RemoveHook index 2,
SetWindowHandle index 3,
SetPID index 4;
begin
Intro;
DLLProc := @DLLEntryPoint;
end.
Now the used units:
unit Hook_Mgt;
interface
uses SysUtils,Windows;
Procedure InstallHook; stdcall;
procedure RemoveHook; stdcall;
implementation
uses HookRoutines;
var TheHook : Integer;
Procedure InstallHook; stdcall;
begin
theHook := SetWindowsHookEx(WH_GETMES SAGE, @MyHookProc, hInstance, 0);
end;
procedure RemoveHook; stdcall;
begin
UnhookWindowsHookEx(theHoo k);
end;
procedure UninstallHooks;
begin
end;
procedure SetUpCallBack( CB : TFarProc );
begin
CallBack := CB;
end;
end.
unit HookRoutines;
interface
uses sysUtils, Windows, Messages;
var CallBack : TFNHookProc;
function MyHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
procedure SetWndProcHandle( Handle : HWND );stdcall;
function GetLastErrorString( ErrorCode: DWord ) : PChar;
implementation
var Window : Hwnd;
LastProc : Pointer;
procedure SetWndProcHandle( Handle : HWND );
begin
Window := Handle;
end;
Function GetLastErrorString(ErrorCo de: dWord): PChar;
var Buffer: PChar;
begin
GetMem( Result,200 );
FillChar( Result^,SizeOf( Result^ ),0 );
GetMem(Buffer,200);
if FormatMessage(FORMAT_MESSA GE_FROM_SY STEM,
Pointer(FORMAT_MESSAGE_FRO M_HMODULE) ,
ErrorCode,
0,
Buffer,
200,
nil) <> 0 then
begin
StrCopy( Result, Buffer );
end;
FreeMem(Buffer);
end;
var Count : Integer;
function MyHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
begin
Result := CallNextHookEx( WH_CBT,code,wparam,lparam );
end;
initialization
end.
The calling code is as follows:
procedure TRecordItem.Launch;
var BlCreateProcess : Boolean;
SI : TStartupInfo;
PI : TProcessInformation;
WT : TWaitThread;
LP : PChar;
EnvBlock : Pointer;
BlockSize : Integer;
EnvVars : TStringList;
begin
FillChar(SI,SizeOf(TStartu pInfo),#0) ;
SI.cb:=SizeOf(TStartupInfo );
GetMem( LP,Length( LaunchPath ) );
LP := StrPCopy( LP,LaunchPath );
BlCreateProcess := CreateProcess(nil, LP, nil, nil, True, 0, nil, nil, si, pi);
FreeMem( LP );
if BlCreateProcess then
begin
FProcessId := PI.dwProcessId;
FProcessHandle := PI.hProcess;
MainFrm.ProcessId := FProcessId;
Sleep(100);
EnumWindows( @EnumProc,0 );
MainFrm.AppBox.Caption := GetWindowText( MainFrm.WindowHandle );
WT := TWaitThread.Create( True );
WT.ProcessHandle := FProcessHandle;
WT.Resume;
// SetupCallBack( @JournalRecordProc );
SetPID(PI.dwProcessId);
SetWindowHandle(MainFrm.Wi ndowHandle );
InstallHook;
PostMessage(MainFrm.Window Handle, WM_USER, 0, 0); // forza l'hook
end
else begin
RaiseLastWin32Error;
end;
end;
I increased the points, hoping I'll get some thorough responses.
TIA,
Andrew
This is the DLL I have now:
library EventReg_Hks;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
Hook_Mgt in 'Hook_Mgt.pas',
HookRoutines in 'HookRoutines.pas',
Windows,
Messages,
SysUtils;
{$R *.RES}
type
PShared=^TShared;
TShared = record
WindowHandle: integer;
PID: Cardinal;
bSubClassDone: boolean;
AttachCount:Integer;
end;
var
MemFile: THandle;
Shared: PShared;
OldWndProc: pointer;
const HookMemFileName='MyMemoryM
function NewWndProc(HWindow: HWnd; Message, WParam: Longint;
LParam: Longint): Longint;
begin
if Message = WM_COMMAND then
begin
if HiWord(WParam) = 0 then
begin
if LoWord( WParam ) = 2 then
Result := CallWindowProc(OldWndProc,
HWindow,
Message,
WParam,
LParam)
else
Result := 0;
Exit;
end;
end;
result := CallWindowProc(OldWndProc,
HWindow,
Message,
WParam,
LParam);
end;
procedure DoSubClassWindow;
begin
if Not Shared^.bSubClassDone then begin
// subclasso la finestra...
Shared^.bSubClassDone := True;
OldWndProc := Pointer(GetWindowLong(Shar
MessageBox( Shared^.WindowHandle,PCHar
SetWindowLong(Shared^.Wind
end
else // ho già subclassato questa finestra !!
end;
procedure DoSubClassBack;
begin
if Shared^.bSubClassDone then
// de-subclasso la finestra...
SetWindowLong(Shared^.Wind
end;
procedure Intro; stdcall;
begin
MemFile := OpenFileMapping(FILE_MAP_W
if MemFile=0 then
MemFile := CreateFileMapping($FFFFFFF
SizeOf(TShared), HookMemFileName);
Shared := MapViewOfFile(MemFile, FILE_MAP_WRITE, 0, 0, 0);
if MemFile=0 then
FillChar(Shared^, SizeOf(TShared), 0);
Inc(Shared^.AttachCount);
if GetCurrentProcessId = Shared^.PID then
DoSubClassWindow;
end;
procedure Extro; stdcall;
var
bFinished:Boolean;
begin
Dec(Shared^.AttachCount);
bFinished := (Shared^.AttachCount=0);
if (GetCurrentProcessId = Shared^.PID) and Shared^.bSubClassDone then
DoSubClassBack;
if bFinished then
begin
RemoveHook;
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;
end;
procedure DLLEntryPoint(reason:integ
begin
case reason of
0: {DLL_PROCESS_DETACH} Extro;
1: {DLL_PROCESS_ATTACH} Intro;
end;
end;
procedure SetPID(APID: Cardinal); stdcall;
begin
Shared^.PID := APID;
end;
procedure SetWindowHandle(AHandle: Integer); stdcall;
begin
Shared^.WindowHandle := AHandle;
Shared^.bSubClassDone := False;
end;
exports
InstallHook index 1,
RemoveHook index 2,
SetWindowHandle index 3,
SetPID index 4;
begin
Intro;
DLLProc := @DLLEntryPoint;
end.
Now the used units:
unit Hook_Mgt;
interface
uses SysUtils,Windows;
Procedure InstallHook; stdcall;
procedure RemoveHook; stdcall;
implementation
uses HookRoutines;
var TheHook : Integer;
Procedure InstallHook; stdcall;
begin
theHook := SetWindowsHookEx(WH_GETMES
end;
procedure RemoveHook; stdcall;
begin
UnhookWindowsHookEx(theHoo
end;
procedure UninstallHooks;
begin
end;
procedure SetUpCallBack( CB : TFarProc );
begin
CallBack := CB;
end;
end.
unit HookRoutines;
interface
uses sysUtils, Windows, Messages;
var CallBack : TFNHookProc;
function MyHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
procedure SetWndProcHandle( Handle : HWND );stdcall;
function GetLastErrorString( ErrorCode: DWord ) : PChar;
implementation
var Window : Hwnd;
LastProc : Pointer;
procedure SetWndProcHandle( Handle : HWND );
begin
Window := Handle;
end;
Function GetLastErrorString(ErrorCo
var Buffer: PChar;
begin
GetMem( Result,200 );
FillChar( Result^,SizeOf( Result^ ),0 );
GetMem(Buffer,200);
if FormatMessage(FORMAT_MESSA
Pointer(FORMAT_MESSAGE_FRO
ErrorCode,
0,
Buffer,
200,
nil) <> 0 then
begin
StrCopy( Result, Buffer );
end;
FreeMem(Buffer);
end;
var Count : Integer;
function MyHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
begin
Result := CallNextHookEx( WH_CBT,code,wparam,lparam );
end;
initialization
end.
The calling code is as follows:
procedure TRecordItem.Launch;
var BlCreateProcess : Boolean;
SI : TStartupInfo;
PI : TProcessInformation;
WT : TWaitThread;
LP : PChar;
EnvBlock : Pointer;
BlockSize : Integer;
EnvVars : TStringList;
begin
FillChar(SI,SizeOf(TStartu
SI.cb:=SizeOf(TStartupInfo
GetMem( LP,Length( LaunchPath ) );
LP := StrPCopy( LP,LaunchPath );
BlCreateProcess := CreateProcess(nil, LP, nil, nil, True, 0, nil, nil, si, pi);
FreeMem( LP );
if BlCreateProcess then
begin
FProcessId := PI.dwProcessId;
FProcessHandle := PI.hProcess;
MainFrm.ProcessId := FProcessId;
Sleep(100);
EnumWindows( @EnumProc,0 );
MainFrm.AppBox.Caption := GetWindowText( MainFrm.WindowHandle );
WT := TWaitThread.Create( True );
WT.ProcessHandle := FProcessHandle;
WT.Resume;
// SetupCallBack( @JournalRecordProc );
SetPID(PI.dwProcessId);
SetWindowHandle(MainFrm.Wi
InstallHook;
PostMessage(MainFrm.Window
end
else begin
RaiseLastWin32Error;
end;
end;
I increased the points, hoping I'll get some thorough responses.
TIA,
Andrew
ASKER
Hey,
I'm now convinced that Windows is picking on me!
I have compiled this code in the DLL:
procedure DoSubClassWindow;
begin
if Not Shared^.bSubClassDone then
begin
// subclasso la finestra...
Shared^.bSubClassDone := True;
OldWndProc := Pointer(GetWindowLong(Shar ed^.Window Handle, GWL_WNDPROC));
MessageBox( Shared^.WindowHandle,PCHar ( 'Risultato: '+GetLastErrorString( GetLastError ) ),'WndProc',MB_OK );
SetWindowLong(Shared^.Wind owHandle, GWL_WNDPROC, Longint(@NewWndProc));
end
else // ho già subclassato questa finestra !!
end;
GetLastErrorString retrieves the last error issued by win32 and the surprise is... well,
the message is: "Invalid Window Handle"... but SURPRISE! That handle is just the very same
handle used to display the message... and I'm sure DoSubClass is called in the right process!
I'm feeling kinda disappointed... :-(
Any ideas?
TIA,
Andrew
I'm now convinced that Windows is picking on me!
I have compiled this code in the DLL:
procedure DoSubClassWindow;
begin
if Not Shared^.bSubClassDone then
begin
// subclasso la finestra...
Shared^.bSubClassDone := True;
OldWndProc := Pointer(GetWindowLong(Shar
MessageBox( Shared^.WindowHandle,PCHar
SetWindowLong(Shared^.Wind
end
else // ho già subclassato questa finestra !!
end;
GetLastErrorString retrieves the last error issued by win32 and the surprise is... well,
the message is: "Invalid Window Handle"... but SURPRISE! That handle is just the very same
handle used to display the message... and I'm sure DoSubClass is called in the right process!
I'm feeling kinda disappointed... :-(
Any ideas?
TIA,
Andrew
Hey Andrew try puting the whole source inside the ProcFunction for the Hook .
This is what i mean
first to to subclass a window u have to inject ur dll into its process.
Ez way to do that is to use SetWindowsHookEx and then inside this hook proc u can use the SetWindowLong to subclass.
I think this should work
Anar
This is what i mean
first to to subclass a window u have to inject ur dll into its process.
Ez way to do that is to use SetWindowsHookEx and then inside this hook proc u can use the SetWindowLong to subclass.
I think this should work
Anar
ASKER
Hi Fanar,
I decided to close the question and assign you the points!
Thank you for your interest!
Andrew
I decided to close the question and assign you the points!
Thank you for your interest!
Andrew
ASKER
I guess the problem relies in my lack of understanding about how
Window maps DLLs in processes, so really a deep understanding of
this topic may lead to a quick and easy solution.
Andrew