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.

[himitsu]

TDBText ist zwar von TCustomLabel abgeleitet, aber holt sich den Text aus dem angehängten DataLink.

[PinkFloydFan]

Zitat:

(Außerdem gehört alles hier um Forum Cheffe. Der Braucht das angeblich für seine Weltherrschaft)

btw:

Ich hab letztes Jahr ne Weltreise gemacht..

Aber da fahr ich nicht mehr hin...

[sirius]

Zitat von himitsu:

TDBText ist zwar von TCustomLabel abgeleitet, aber holt sich den Text aus dem angehängten DataLink.

Jep, und wenn im DataLink das Ereignis onChange auftritt, wird automatisch Caption neu gesetzt. Und es scheint ja auch zu funktionieren.

[PinkFloydFan]

So.

Muss nun zur Arbeit..

Neueste Erkenntnisse dann Morgen..

[sirius]

for k:= 0 to Length(Help) do mem.vgl[k-1]:=help[k]; Muss die Schleife nicht von 1 loslaufen?

Zitat:

Muss nun zur Arbeit..

Du machst das für Deinen Chef also jetzt auch in deiner Freizeit?

[FredlFesl]

Neu programmierern wurde ja schon oft ins Spiel gebracht. Ich kann doch als Firma keine Blackbox haben, die ich nur mit irgendwelchen Tricks erweitern kann... Nur eine Neuerstellung der Anwendung ist nachhaltig.

Und wenn der Mitarbeiter das Programm wirklich in seiner Freizeit entwickelt haben sollte, dann stellt sich die Frage nach der Rechtmäßigkeit der Weiterverwendung sowieso. Desweiteren würde ich mit dem Herren in Verhandlungen treten. Wie gesagt: Wenn er es in seiner Freizeit entwickelt hat, dann steht ihm eine entsprechende Vergütung zu.

Der Chef ist ja wohl nur blöd, wenn er sich auf so etwas einlässt (also ein Programm zu verwenden, dass in der Freizeit geschrieben wurde).

Ich meine, man sollte mit dem Kerl reden, und zwar nach dem Motto:
"Tolles Programm, wir zahlen auch angemessen. Aber wir können es aber auch neu entwickeln, wenn Du uns blöd kommst"

Mehr als unverschämte Forderungen kann er auch nicht stellen und nach dem Gespräch weiss man, was zu tun ist.

Aber diese Labelausleserei ist ja wohl der größte Blödsinn, vor allen Dingen von TDBLabel... Woher kommen die Daten denn? Doch sicherlich aus einer DB...

Da die Anwendung von einer Person entwickelt wurde, sollte sich sich auch von 1-2 Personen in angemessener Zeit nachstellen lassen.

[himitsu]

Mit welcher Delphi-Version wurde das eigentlich mal entwickelt?