Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Ist im Prozedurzeiger eine Klasse drin? (https://www.delphipraxis.net/158072-ist-im-prozedurzeiger-eine-klasse-drin.html)

himitsu 4. Feb 2011 10:10

Delphi-Version: XE

Ist im Prozedurzeiger eine Klasse drin?
 
Ja ja, ich mit meinen komischen Fragen :oops: ... ach ja, Moin erstma.


Kann man irgendwie rausbekommen, ob in einer
Delphi-Quellcode:
type T = procedure(...) of object;
ein Zeiger auf eine Methode+Objektinstanz oder eine Klassenmethode+Klassenzeiger drinsteckt?

Delphi-Quellcode:
type
  TProc = procedure of object;
  TTest = class
    procedure A;
    class procedure B;
  end;

var
  X: TProc;
  O: TTest;

X := O.A;
X := TTest.B;
Beides ist ja möglich.

Zwecks Threadsicherheit würde ich gern einen Clone des Objekts erstellen, wenn ein Objekt drin ist, ansonsten direkt aufrufen.

Also irgendwas in dieser Richtung vielleicht?
Delphi-Quellcode:
if TMethod(X).Data is TClass then ...
if TMethod(X).Data is TObject then ...


[add]
Hier laufe ich (zufällig) jeweils, beim Test auf's Andere, in eine Exception
und auf Exceptions möchte ich gerne verzichten.
Delphi-Quellcode:
type
  TProc = procedure of object;
  TTest = class
    procedure A;
    class procedure B;
  end;

procedure TTest.A;
begin
end;

class procedure TTest.B;
begin
end;

procedure Check(Proc: TProc);
begin
  try
    if TObject(TMethod(Proc).Data) is TTest then
      Beep;
  except
  end;
  try
    if TClass(TMethod(Proc).Data).InheritsFrom(TTest) then
      Beep;
  except
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  X: TProc;
  O: TTest;
begin
  O := TTest.Create;
  X := O.A;
  Check(X);
  O.Free;

  X := TTest.B;
  Check(X);
end;

guinnes 4. Feb 2011 11:46

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Hast du mal gekuckt, ob bei einer Class-Procedure Data nicht einfach nur NIL ist ?

WM_CLOSE 4. Feb 2011 11:57

AW: Ist im Prozedurzeiger eine Klasse drin?
 
@guinnes: Es ist nicht nil, aber auch keine Instanz, aber z.b.auf InstanceSize kann man zugreifen. Interressant

Edit: klar, ist auch eine class function

guinnes 4. Feb 2011 12:23

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Zitat:

Zitat von WM_CLOSE (Beitrag 1079523)
Es ist nicht nil,

Ich habs nicht probiert, aber da in Data ein Zeiger auf die Instanz steht und es die bei einer Class Procedure aber nicht gibt, sollte da konsequenterweise NIL drin stehen
Zitat:

aber z.b.auf InstanceSize kann man zugreifen. Interressant
Dafür brauchst du ja auch keine Instanz

guinnes 4. Feb 2011 12:35

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Ich habs mir mal angeschaut :
Im Falle einer normalen Methode steht in Data die Instanz, im Falle der Class Procedure steht in Data ein Zeiger auf die VMT.
Also : Beim Start feststellen, wo der Heap anfängt, ist der Zeiger in Data kleiner, ist es eine Class Procedure

himitsu 4. Feb 2011 12:48

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Bei einer Methode ist in Data ein Zeiger auf die Objektinstanz drin (TObject),
wärend bei der Klassen-Methode ein Zeiger auf die Klasse drin steht.

In diesem .Code steht das drin, welches an den versteckten "Self" Parameter übergeben wird.
Methode: Self = Instanz
Klassen-Methode: Self = Klasse, über welche auf die Methode zugegriffen wurde.
(bei der Objektinstanz wird der Zeiger auf die interne Klasse ja in der Instanz gespeichert)

Delphi-Quellcode:
type
  TTest = class
    class procedure Proc;
  end;
  TTest2 = class(TTest)
  end;

class procedure TTest.Proc;
begin
  ShowMessage({Self.}ClassName);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  TTest.Proc;
  TTest2.Proc;
end;

guinnes 4. Feb 2011 13:11

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Nicht schön tut aber :
Delphi-Quellcode:
procedure Check(Proc: TProc);
begin
  if Integer(TMethod(Proc).Data) > Integer(Application) then
    ShowMessage('Object')
  else
    ShowMessage('Class Proc');
end;

himitsu 4. Feb 2011 13:37

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Das geht aber nur, da der Speicher der Application-Instanz zufällig hinter dem Programmcode und der Speicher für die zu testende Instanz zufällig hinter der Application.Instanz im "RAM" liegt ... davor ist aber auch noch genug Platz. :?

Hab jetzt erstmal das hinbekommen.
(Zum Glück sollte es sich bei mir immer um gültige Klassenzeiger oder Objektinstanzen handeln.)
Delphi-Quellcode:
var
  P, P2: Pointer;
  C: LongWord;
  X: array[1..vmtCreateObject - vmtSelfPtr] of Byte;
  Proc: procedure of object;

// IsClass(TTest)
P := PAnsiChar(TMethod(Proc).Data) + vmtSelfPtr;
if (ReadProcessMemory(GetCurrentProcess, P, @X, SizeOf(X), C))
    and (C = SizeOf(X)) and (PPointer(P)^ = TMethod(Proc).Data)
    and (TClass(TMethod(Proc).Data).InheritsFrom(TTest)) then
  Beep;

// IsObject(TTest)
P := TMethod(Proc).Data;
if ReadProcessMemory(GetCurrentProcess, P, @X, SizeOf(Pointer), C) and (C = SizeOf(Pointer)) then begin
  P2 := PPointer(P)^;
  P := PAnsiChar(P2) + vmtSelfPtr;
  if ReadProcessMemory(GetCurrentProcess, P, @X, SizeOf(X), C)
      and (C = SizeOf(X)) and (PPointer(P)^ = P2)
      and (TObject(TMethod(Proc).Data) is TTest) then
    Beep;
end;

//ReadProcessMemory als Ersatz für IsBadReadPtr

guinnes 4. Feb 2011 13:51

AW: Ist im Prozedurzeiger eine Klasse drin?
 
Zitat:

Zitat von himitsu (Beitrag 1079550)
Das geht aber nur, da der Speicher der Application-Instanz zufällig hinter dem Programmcode und der Speicher für die zu testende Instanz zufällig hinter der Application.Instanz im "RAM" liegt ... davor ist aber auch noch genug Platz.

Da das Application-Object ja relativ früh in einem noch recht unfragmentierten Speicher angelegt wird, ist die Wahrscheinlichkeit recht hoch, dass es ziemlich am Anfang des Heaps liegt. Aber im Prinzip hast du recht
Um dem aus dem Weg zu gehen, kann man die Adresse der globalen Variablen Application benutzen : Die liegt unterhalb des Heap aber garantiert höher als die VMT's :
Delphi-Quellcode:
procedure Check(Proc: TProc);
begin
  if Integer(TMethod(Proc).Data) < Integer(@Application) then
    ShowMessage('Class Proc')
  else
    ShowMessage('Object');
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:34 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz