Undokumentierter Sendmessage-Befehl

[PinkFloydFan]

Also dann:

Aber wiegesagt: Quick'n Dirty..

Delphi-Quellcode:

unit readlabel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DBCtrls;

const mymsg=WM_User+1;

type TSearchtype=(sClassName,sName,sCaption);
type PMemory=^TMemory;
     TMemory=packed record
       Thread:array[0..1023] of char;
       Postmessage:function(wnd:hwnd;msg,wparam,lparam:cardinal):bool;stdcall;
       exitthread:procedure(exitcode:integer);stdcall;
       getwindowlong:function(wnd:hwnd;index:integer):cardinal;stdcall;
       watchwnd:hwnd;
       backwnd:hwnd;
       backmsg:integer;
       count:integer;
       SearchType:TSearchtype;
       vgl:array[0..31] of char;
       vgllength:integer;
     end;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label4: TLabel;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    DBText1: TDBText;
    Button3: TButton;
    Label3: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure GetMyCaption(var msg:TMessage);message mymsg+1;
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    myhandle:hwnd;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function injectThread(memory:Pmemory):integer; stdcall;
var pi,p,pm:ppointer;
    i,a:integer;
    c:pchar;
    left,top,width,height:smallint;
    same:boolean;
    wparam,lparam:cardinal;
begin
  wparam:=0;
  lparam:=0;
  p:=pointer(memory^.getwindowlong(memory^.watchwnd,gwl_wndproc)+9);
  pm:=pointer(integer(p^)+16);
  for a:=0 to pinteger(integer(pm^)+8)^-1 do
  begin
    p:=pointer(integer(pm^)+4);
    p:=pointer(integer(p^)+4*a);
    pi:=p;
    p:=pointer(integer(p^)+8);
    p:=p^;
    c:=pchar(p);
    if (pbyte(p)^=memory^.vgllength)or(memory^.SearchType in[sName,sCaption]) then
    begin
      if memory^.SearchType=sClassName then inc(c);
      same:=false;
      for i:=1 to memory^.vgllength do
      begin
        if memory^.vgl[i-1]<>c^ then break;
        same:=i=memory^.vgllength;
        inc(c);
      end;
      if same then
      begin
        dec(memory^.count);
        if (memory^.count=0)or(memory^.SearchType in [sName,sCaption]) then
        begin
          if memory^.SearchType=sCaption then
          begin
            p:=pointer(integer(pi^)+$64);
            wparam:=cardinal(p^);
            c:=pchar(p^);
            while c^<>#0 do
            begin
              inc(c);
              inc(lparam);
            end;
            inc(memory^.backmsg);
          end;
          break;
        end;
      end;
    end;
  end;
  memory^.Postmessage(memory^.backwnd,memory^.backmsg,wparam,lparam);
  result:=0;
  memory^.exitthread(0);
end;

procedure endpoint;
//ohne Funktion nur zum finden des Address-endes von injcetThread
asm
nop
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button1Click(Sender: TObject);
var mem:TMemory;
    lib:THandle;
    size:integer;
    process:cardinal;
    processid:cardinal;
    procmem:PMemory;
    tmp:cardinal;
    threadID:cardinal;
    thread:THandle;
    help:string;
    k:Integer;
begin
  try
    myhandle:=strtoint(Edit1.Text);
  except
    myhandle:=findwindow(nil,PChar(Edit1.Text));
  end;
  if myhandle=0 then exit;
  mem.backwnd:=self.Handle;
  mem.backmsg:=mymsg;
  mem.watchwnd:=myhandle;
  mem.count:=6;
  mem.vgl:='';
  help:=Edit2.Text;
  for k:= 0 to Length(Help) do mem.vgl[k-1]:=help[k];
  mem.vgllength:=Length(Help);
  mem.SearchType:=sCaption;
  size:=integer(@endpoint)-integer(@injectThread);
  move(injectthread,mem.thread,size);
  lib:=getmodulehandle('user32.dll');
  mem.Postmessage:=getprocaddress(lib,'PostMessageA');
  mem.getwindowlong:=getprocaddress(lib,'GetWindowLongA');
  lib:=getmodulehandle('kernel32.dll');
  mem.exitthread:=getprocaddress(lib,'ExitThread');
  getwindowthreadprocessid(myhandle,@processid);
  process:=openprocess(PROCESS_ALL_ACCESS,false,processid);
  procmem:=virtualallocex(process,nil,sizeof(Tmemory),MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  writeprocessmemory(process,procmem,@mem,sizeof(TMemory),tmp);
  thread:=createremotethread(process,nil,0,@procmem.thread,procmem,0,threadid);
  waitforsingleobject(thread,infinite);
  closehandle(thread);
  virtualfreeex(process,procmem,0,mem_decommit);
  closehandle(process);

end;

procedure TForm1.GetMyCaption(var msg:TMessage);
var process,processID,tmp:cardinal;
    s:string;
begin
  if myhandle=0 then exit;
  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);
  Label4.Caption:= 'Caption von "'+Edit2.Text+'" in Fenster "'+Edit1.Text+'":';
  Edit3.Text:=s;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  edit3.Text:=dbtext1.Caption;
   
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DBText1.Caption:='Test Xaverl';
end;

end.