unit U_getImage;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
const mymsg=WM_User+1;
type TSearchtype=(sImageSize,sCaption);
//Ich hab die Bezeichnungen mal angepasst und sClassname gibts nicht mehr
type PMemory=^TMemory;
TMemory=packed
record
newwndProc:
array[0..511]
of char;
//hier kommt die neue WndProc-Funktion für das fremde Window rein
Thread:
array[0..255]
of char;
//hier kommt die Thread-Funktion rein (die schließlich gestartet wird)
getInfo:
array[0..1023]
of char;
//hier kommt die Funktion zur Ermiitlung der Infos über Image und Label rein
//API-Funktionen bzw. deren Addressen
Postmessage:
function(wnd:hwnd;msg,wparam,lparam:cardinal):bool;
stdcall;
exitthread:
procedure(exitcode:integer);
stdcall;
sleep:
procedure(ms:cardinal);
stdcall;
getwindowlong:
function(wnd:hwnd;
index:integer):pointer;
stdcall;
setwindowlong:
function(wnd:hwnd;
index:integer;newvalue:pointer):integer;
stdcall;
callwindowProc:
function(proc:pointer;wnd:hwnd;msg,wparam,lparam:cardinal):integer;
stdcall;
globalgetatomname:
function(nAtom:cardinal;buf:pointer;size:integer):integer;
stdcall;
getupdaterect:
function(wnd:hwnd;rect:prect;erase:bool):bool;
stdcall;
getInfoFunc:
procedure(memory:PMemory;wparam,lparam:cardinal);
stdcall;
//Funktionszeiger auf getInfo, also die Info-Funktion
oldwindowProc:Pointer;
//Zeiger auf die alte WndProc
watchwnd:hwnd;
backwnd:hwnd;
backmsg:integer;
updateRect:TRect;
running:boolean;
//Thread (und newwndProc) läuft bis running=false
end;
type
TForm1 =
class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure GetMyMsg(
var msg:TMessage);
message mymsg;
procedure GetMyCaption(
var msg:TMessage);
message mymsg+1;
procedure GetCommandMsg(
var msg:TMessage);
message mymsg+2;
procedure startObservation;
procedure stopObservation;
procedure communicate(vgl:
string;Searchtype:TSearchtype);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private-Deklarationen }
myhandle:hwnd;
process:cardinal;
procmem:PMemory;
thread:THandle;
observed:boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function MyWndProc(Memory: PMemory; Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
forward;
procedure WndProcDispatcher;
//Funktion zum Finden des Records PMemory
asm
CALL @@1
@@1: POP EAX
SUB EAX,5
POP EDX
PUSH EAX
PUSH EDX
JMP MyWndProc
end;
function MyWndProc(Memory: PMemory; Wnd: hWnd; Msg,wParam,lParam: Integer): Integer;
stdcall;
//die neue WindowProc-funktion des fremden Formulars
//die "alte" wird mittels CallWindowproc auch noch aufgerufen
begin
case msg
of
wm_close:
begin
memory^.running:=false;
result:=memory^.CallWindowProc(memory^.oldwindowProc,wnd,msg,wparam,lparam);
memory^.Postmessage(memory^.backwnd,memory^.backmsg+2,msg,0);
end;
wm_paint:
begin
memory^.getupdaterect(memory^.watchwnd,@memory^.updaterect,false);
result:=memory^.CallWindowProc(memory^.oldwindowProc,wnd,msg,wparam,lparam);
memory^.Postmessage(memory^.backwnd,memory^.backmsg+2,msg,cardinal(@memory^.updateRect));
end;
mymsg:
begin
memory^.getinfofunc(memory,wparam,lparam);
result:=1;
end;
mymsg+1:
begin
memory^.running:=false;
result:=1;
end;
else
result:=memory^.CallWindowProc(memory^.oldwindowProc,wnd,msg,wparam,lparam);
end;
end;
function injectThread(memory:Pmemory):integer;
stdcall;
//Die eigentliche Thread-Funktion
//Hauptaufgabe: einklinken und am Ende wieder ausklinken unserer neuen WndProc
//dazwischen nur sleep, bis die Message mymsg+1 and die neue WndProc kommt
begin
memory^.running:=true;
memory^.oldwindowProc:=memory^.getwindowlong(memory^.watchwnd,gwl_wndproc);
memory^.getInfoFunc:=@memory^.getInfo;
memory^.setwindowlong(memory^.watchwnd,gwl_wndproc,memory);
while memory^.running
do memory^.sleep(200);
memory^.setwindowlong(memory^.watchwnd,gwl_wndproc,memory^.oldwindowproc);
result:=0;
memory^.exitthread(0);
end;
procedure Info(memory:Pmemory;wparam,lparam:cardinal);
stdcall;
//Die bisherige Funktion zum ermitteln und senden der Infos bezüglich TImage und TLabel
var pi,p,pm:ppointer;
i,a:integer;
c:pchar;
left,top,width,height:smallint;
same:boolean;
SearchType:TSearchType;
vgl:
array[0..31]
of char;
vgllength:integer;
begin
Searchtype:=TSearchType(lparam);
//Da Strings nicht über Messages gesendet werden können, benötigen wir ein Atom
vgllength:=memory^.GlobalGetAtomName(wparam,@vgl,32);
wparam:=0;
lparam:=0;
p:=pointer(cardinal(memory^.oldwindowproc)+9);
pm:=pointer(integer(p^)+16);
for a:=0
to pinteger(integer(pm^)+8)^-1
do begin //von 0 bis componentcount
p:=pointer(cardinal(pm^)+4);
p:=pointer(cardinal(p^)+4*a);
pi:=p;
//pi^ ist Zeiger auf ein Objekt
p:=pointer(cardinal(p^)+8);
p:=p^;
c:=pchar(p);
same:=false;
for i:=1
to vgllength
do begin
if vgl[i-1]<>c^
then break;
same:=i=vgllength;
inc(c);
end;
if same
then begin
if SearchType=sCaption
then begin
p:=pointer(cardinal(pi^)+$64);
wparam:=cardinal(p^);
c:=pchar(p^);
while c^<>#0
do begin
inc(c);
inc(lparam);
end;
inc(memory^.backmsg);
end else begin
left:=pinteger(integer(pi^)+$40)^;
top:=pinteger(integer(pi^)+$44)^;
width:=pinteger(integer(pi^)+$48)^;
height:=pinteger(integer(pi^)+$4C)^;
wparam:=left*65536+top;
lparam:=width*65536+height;
end;
break;
end;
end;
//Ergebnis Nach Hause senden
memory^.Postmessage(memory^.backwnd,memory^.backmsg,wparam,lparam);
end;
procedure endpoint;
//ohne Funktion nur zum finden des Address-endes von Info
asm
nop
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.startObservation;
//1. Record wird mit allen Infos gefüllt und in den fremden Prozess geschrieben
//2. Thread-Funktion aus dem Record wird gestartet
var mem:TMemory;
lib:THandle;
size:integer;
processid:cardinal;
tmp:cardinal;
threadID:cardinal;
begin
if observed
then exit;
//mem ist der Record der nachher in den anderen Process kopiert wird
mem.backwnd:=self.Handle;
//Handle, damit wir Nachrichten zurückschicken können
mem.backmsg:=mymsg;
//Message-Nr., damit wir unsere Message wiederfinden
mem.watchwnd:=myhandle;
//Das Handle für getwindowlong
//kopieren der ganzen compilierten Funktionen
size:=integer(@endpoint)-integer(@Info);
move(Info,mem.getInfo,size);
size:=integer(@info)-integer(@injectThread);
move(injectthread,mem.Thread,size);
size:=integer(@injectThread)-integer(@wndProcDispatcher);
move(wndprocdispatcher,mem.newwndproc,size);
//EinsprungAdresse von allen WinAPI-funktionen, die nacher benötigt werden
//Die Adressen sind in jedem Process gleich
lib:=getmodulehandle('
user32.dll');
mem.Postmessage:=getprocaddress(lib,'
PostMessageA');
mem.getwindowlong:=getprocaddress(lib,'
GetWindowLongA');
mem.setwindowlong:=getprocaddress(lib,'
SetWindowLongA');
mem.callwindowproc:=getprocaddress(lib,'
CallWindowProcA');
mem.getupdaterect:=getprocaddress(lib,'
GetUpdateRect');
lib:=getmodulehandle('
kernel32.dll');
mem.exitthread:=getprocaddress(lib,'
ExitThread');
mem.sleep:=getprocaddress(lib,'
Sleep');
mem.globalgetatomname:=getprocaddress(lib,'
GlobalGetAtomNameA');
//Thread-Record in anderen Process kopieren und mem.Thread starten
getwindowthreadprocessid(myhandle,@processid);
process:=openprocess(PROCESS_ALL_ACCESS,false,processid);
//Speicher reservieren
procmem:=virtualallocex(process,
nil,sizeof(Tmemory),MEM_COMMIT,PAGE_EXECUTE_READWRITE);
//Kopieren
writeprocessmemory(process,procmem,@mem,sizeof(TMemory),tmp);
//Starten
thread:=createremotethread(process,
nil,0,@procmem.thread,procmem,0,threadid);
observed:=true;
end;
procedure tForm1.stopObservation;
//Thread im fremden Process beenden (+WndProc zurücksetzen) und Speicher freigeben
begin
if not observed
then exit;
Postmessage(myHandle,mymsg+1,0,0);
//Message zum beenden des Threads (über Variable "running")
waitforsingleobject(thread,infinite);
//Warten bis Thread beendet wurde
//Handles und Speicher freigeben
closehandle(thread);
virtualfreeex(process,procmem,0,mem_decommit);
//Speicher freigeben
closehandle(process);
observed:=false;
end;
procedure TForm1.GetMyMsg(
var msg:TMessage);
//Message über Image empfangen
begin
memo1.Lines.add(inttostr(msg.WParamlo));
memo1.Lines.add(inttostr(msg.WParamhi));
memo1.Lines.add(inttostr(msg.lParamlo));
memo1.Lines.add(inttostr(msg.lParamhi));
end;
procedure TForm1.GetMyCaption(
var msg:TMessage);
//Message über TLabel empfangen
var process,processID,tmp:cardinal;
s:
string;
begin
if myhandle=0
then exit;
//in msg.wparam steht der Pointer auf das TLabel.caption im anderen Process
//in msg.lparam die Länge des TCaption
getwindowthreadprocessid(myhandle,@processid);
process:=openprocess(PROCESS_VM_READ,false,processid);
setlength(s,msg.LParam);
readprocessmemory(process,pointer(msg.wparam),@s[1],msg.lparam,tmp);
closehandle(process);
memo1.Lines.add(s);
end;
procedure Tform1.getcommandmsg(
var msg:Tmessage);
//Message empfangen wenn des fremde Window eine WM_Paint oder WM_close bekommt
var process,processID,tmp:cardinal;
rec:Trect;
begin
case msg.WParam
of
wm_paint:
begin
memo1.lines.Add('
onPaint');
if myhandle=0
then exit;
getwindowthreadprocessid(myhandle,@processid);
process:=openprocess(PROCESS_VM_READ,false,processid);
readprocessmemory(process,pointer(msg.lparam),@rec,sizeof(rec),tmp);
closehandle(process);
//Der Bereich der neu gezeichnet werden muss
memo1.lines.add(inttostr(rec.Left));
memo1.lines.add(inttostr(rec.top));
memo1.lines.add(inttostr(rec.right));
memo1.lines.add(inttostr(rec.bottom));
end;
wm_close:
begin
observed:=false;
close;
end;
end;
end;
procedure TForm1.communicate(vgl:
string;Searchtype:TsearchType);
//Eine Anfrage an unsere neue WndProc starten
var wparam,lparam:cardinal;
begin
wparam:=globaladdAtom(pchar(vgl));
//String in ein Atom laden; Nr. des Atoms in wparam
lparam:=cardinal(Searchtype);
//Searchtype in lparam
sendmessage(myhandle,mymsg,wparam,lparam);
//Message für unsere newwndproc; und warten bis sie dort verarbeitet wurde
globaldeleteatom(wparam);
//Atom wieder löschen
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//eine Besipielanfrage an die newwndProc
communicate('
Image1',sImageSize);
//hier oder in einer anderen Funktion können noch mehr solche Anfragen gestartet werden
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//myhandle setzen und dann startobservation
memo1.clear;
myhandle:=findwindow(
nil,'
PImage');
if myhandle=0
then exit;
startobservation;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
//nicht vergessen!
stopobservation;
end;
end.