IsObject / IsClass

[negaH]

Hi Choose,

deine Assembler Funktionen sind buggy, leider

1.) Du benutzt EBX ohne es vorher zu sichern, eg. PUSH/POP
2.) IsBadReadPtr() ist zwar eine Funktion die überprüfen soll ob ein Zeiger gültig ist, sie funktioniert nur leider nicht so wie erwartet. D.h. IsBadReadPtr(KernelSpeicher) würde FALSE ergeben, ein Zugriff auf KernelSpeicher^ aber denoch eine Zugriffsverletzung auslösen

Delphi-Quellcode:

function IsObject(AObject: Pointer): Boolean;
asm
      OR    EAX,EAX                             // AObject == nil ??
      JNZ   @@1
      RET

@@1:  XOR   EDX,EDX                             // install Exception Frame, SEH
      PUSH  OFFSET @@3
      PUSH  DWord Ptr FS:[EDX]
      MOV   FS:[EDX],ESP
      
      MOV   EAX,[EAX]                           // EAX := AObject^.ClassType
      OR    EAX,EAX                             // ClassType == nil ??
      JZ    @@2

      CMP   EAX,[EAX].vmtSelfPtr                // EAX = ClassType.vmtSelfPtr
      SETZ  AL

@@2:  POP   DWord Ptr FS:[EDX]
      POP   EDX
      RET

// Exception Handler, wird aufgerufen wenn zwischen @@1 und @@2 eine AV auftritt,
// zum Debugger muß auf @@3 ein Breakpoint gesetzt werden,
// Dieser SEH ist NICHT sichtbar für Delphi's Debugger !!

@@3:  MOV   EAX,[ESP + 00Ch]                    // context
      MOV   DWord Ptr [EAX + 0B0h],0            // context.eax = 0
      MOV   DWord Ptr [EAX + 0B8h],OFFSET @@2   // context.eip = @@2
      SUB   EAX,EAX                             // 0 = ExceptionContinueExecution
end;

Gruß Hagen

[negaH]

Hier der Code um über die TypInfo's zu iterieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons, StdCtrls, TypInfo;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
    function DoRTTI(Info: PTypeInfo): Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TEnumTypeInfoCallback = function(UserData: Pointer; Info: PTypeInfo): Boolean; register;

function GetBaseOfCode(Module: hModule; var CodeStart, CodeEnd: PChar): Boolean;
asm // get Codesegment pointers, check if module is a valid PE
       PUSH  EDI
       PUSH  ESI
       AND   EAX,not 3
       JZ    @@2
       CMP   Word Ptr [EAX],'ZM';
       JNE   @@1
       MOV   ESI,[EAX + 03Ch]
       CMP   Word Ptr [ESI + EAX],'EP'
       JNE   @@1
       MOV   EDI,[EAX + ESI + 014h + 008h]
       ADD   EAX,[EAX + ESI + 014h + 018h]
       ADD   EDI,EAX
       MOV   [EDX],EAX
       MOV   [ECX],EDI
       XOR   EAX,EAX
@@1:   SETE  AL
@@2:   POP   ESI
       POP   EDI
end;

function EnumTypeInfo(Module: hModule; Callback: TEnumTypeInfoCallback; UserData: Pointer): PTypeInfo;
// copyright (c) 1998 Hagen Reddmann
var
  P,E,K,N: PChar;
  L: Integer;
begin
  Result := nil;
  if Assigned(Callback) then
  try
    if GetBaseOfCode(Module, P, E) then
      while P < E do
      begin
        DWord(P) := DWord(P) and not 3;
        K := P + 4;
        if (PDWord(P)^ = DWord(K)) and (PByte(K)^ > 0) and (PByte(K)^ < 18) then // Info.Kind in ValidRange.D6
        begin
          L := PByte(K + 1)^;  // length Info.Name
          N := K + 2;          // @Info.Name[1]
          if (L > 0) and (N^ in ['_', 'a'..'z', 'A'..'Z']) then  // valid ident ??
          begin
            repeat
              Inc(N);
              Dec(L);
            until (L = 0) or not (N^ in ['_', 'a'..'z', 'A'..'Z', '0'..'9']);
            if L = 0 then // length and ident valid
              if Callback(UserData, Pointer(K)) then // tell it and if needed abort iteration
              begin
                Result := Pointer(K);
                Exit;
              end else K := N;
          end;
        end;
        P := K;
      end;
  except
  end;
end;

function TForm1.DoRTTI(Info: PTypeInfo): Boolean;
var
  P: PTypeData;
begin
  Result := False;
//  if Info.Kind = tkClass then
  begin
//    P := GetTypeData(Info);
//    if P.ClassType.InheritsFrom(TCustomForm) then
      ListBox1.Items.Add(Info.Name{ + ', ' + P.UnitName});
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  EnumTypeInfo(MainInstance, @TForm1.DoRTTI, Self);
end;

end.

Gruß Hagen

[choose]

Hallo Hagen,

Zitat von negaH:

Du benutzt EBX ohne es vorher zu sichern, eg. PUSH/POP

Ja, das mache ich, weil es nicht notwendig ist:

Zitat:

You can rely on the fact that all Windows APIs save and restore the registers EBP,EBX,EDI and ESI. Therefore use these registers to keep handles and pointers which need to be used more than once through sequences of API calls.

Zitat von negaH:

IsBadReadPtr() ist zwar eine Funktion die überprüfen soll ob ein Zeiger gültig ist, sie [..][würde bei einem] Zugriff auf KernelSpeicher^ aber denoch eine Zugriffsverletzung auslösen

Das war mir nicht bekannt. Danke für Deinen recht kurzen Ansatz des Try..Excepts-Blocks. Ich werde ihn mir morgen etwas genauer ansehen.

Ebenso werde ich mir morgen den Code zum Iterieren der RTTI ansehen können, sieht schon einmal vielversprechend aus (kannst Du eine Aussage über die Kompatibilität Deiner Lösung zu den verschiedene Delphi-Versionen treffen?)!

[jbg]

Zitat von choose:

Zitat von negaH:

Du benutzt EBX ohne es vorher zu sichern, eg. PUSH/POP

Ja, das mache ich, weil es nicht notwendig ist:

Zitat:

You can rely on the fact that all Windows APIs save and restore the registers EBP,EBX,EDI and ESI. Therefore use these registers to keep handles and pointers which need to be used more than once through sequences of API calls.

Und das schließt aber nicht aus, dass der Delphi Compiler in EBX bestimmte Daten hält. Es muss ja auch einen Grund haben, warum der Compiler bei Benutzen von EBX dieses vorher sichert und danach wiederherstellt.
Aus der Delphi Hilfe:

Zitat:

In einer asm-Anweisung muß der Inhalt der Register EDI, ESI, ESP, EBP und EBX erhalten bleiben

Unter Windows mag das nicht gleich zu einem Fehler führen, aber unter Linux steht in EBX die GOT (Global Offset Table) und wenn du diese verlierst, bekommst du sie nicht wieder zurück. Und ohne GOT wird es ein Zuckerschlecken ala SEGV (=AccessViolation), wenn du auf globale Variablen zugreifen willst.

[choose]

Hallo jpg,

Du hast Recht. Leider habe ich die Routinen bisher in zu isolierten Umgebungen getestet, als dass ein durch die Nachlässigkeit bedingter Fehler aufgetreten sein könnte...
Ich werde die Implementierung wohl ohnehin zugunsten einer Prüfung gegen alle registrierten Klassenreferenzen, die mit Hagens Routine ermittelt werden können, aufgeben. Bei dieser Implementierung werde ich dann auf die GP-Register achten, versprochen

[negaH]

EBX, Kylix und seine GOT (Global Object Table, übrigens) ist schon eines der schlimmsten Probleme, aber normalerweise wird ein Überschreiben von EBX ohne Sicherung schon in Windows Programmen für massiven Ärger sorgen. Mit Windows API hat das wenig zu tun, es liegt am Compiler der davon ausgeht das Unterproceduren EBX nicht verändern. Also nutzt er diese Festlegung auch intensiv.

Zitat:

kannst Du eine Aussage über die Kompatibilität Deiner Lösung zu den verschiedene Delphi-Versionen treffen?

Ja kann ich. Vorweg muß ich sagen das mein Code eine Aufgabe erledigt die selbst die Borland Programmierer für unmöglich gehalten haben. Deren Aussagen in diversen Foren und Newsgroups mir gegenüber war immer "das ist nicht möglich". Logische Ableitung davon ist der Fakt das mein Code auf "undokumentierte" Informationen und Features WIE die TypInfos gespeichert werden angewiesen ist. Der obige Code ist von mir für Delphi 2 bis 6 entwickelt und getestet wurden. Er ist aber auch wie man sieht eine "Quick&Dirty" Lösung, d.h. ich habe sie nicht "schön" gemacht. Die einzigste Änderung die man für D7 machen muß ist in

  if (PDWord(P)^ = DWord(K)) and (PByte(K)^ > 0) and (PByte(K)^ < 18) then // Info.Kind in ValidRange.D6 Der Wert 18 könnte durch

 ... <= Integer(High(TTypeKind)) then ersetzt werden. Dann wäre es automatisch durch neucompilieren für alle Delphi Versionen gültig.

Es gibt Tricks wie man manuell und absichtlich per Assembler Datenstrukturen im Code ablegen kann die dann obigen EnumTypeInfo() Funktion ins stolpern bringen. Dazu muß man aber auch wirklich absichtlich exakt solche Strukturen anlegen. Bisher habe ich kein einzigstes Projekt gehabt bei dem dies der Fall war.
Natürlich kann man in der Callback oder Enum Funktion zusäzliche Überprüfungen einbauen, die dann abhängig von der gefundenen TypInfo deren Struktur auf logische Plausibilitäten abchecken.

Wichtigstes Hilfsmittel für dich ist die Unit TypInfo.pas

Gruß Hagen

[choose]

Hey,

habe einmal versucht, die Idee von Hagen umzusetzen, und nun eine angepasste Version von IsObject erstellt:

Delphi-Quellcode:

function IsObject(AObject: Pointer): Boolean; assembler;
asm
      OR    EAX,EAX                             // AObject == nil ??
      JNZ   @@Try
      RET
@@Try:
      XOR   EDX,EDX                             // install Exception Frame, SEH
      PUSH  OFFSET @@Except
      PUSH  DWord Ptr FS:[EDX]
      MOV   FS:[EDX],ESP

      // actual tests ***************
@@Step1_ClassTypeIsNil:
      // test whether classtype is nil
      MOV   EAX,[EAX]                           // EAX := AObject^.ClassType
      OR    EAX,EAX
      JZ    @@False
@@Step2_SelfReference:
      // object's self reference should point to object again
      CMP   EAX,[EAX].vmtSelfPtr                // EAX = ClassType.vmtSelfPtr
      JNE   @@False
@@Step3_TypeInfosKindIsClass:
      MOV   ECX,EAX                             // ECX := ClassType
      // object's typ info has to be a valid class
      MOV   EAX,[EAX].vmtTypeInfo               // EAX := TypeInfo(AnObject.ClassInfo)
      CMP   [EAX].TTypeInfo.Kind, tkClass       // AnObject.ClassInfo)^.Kind = tkClass
      JNE   @@False
@@Step4_ValidTypeInfo:
      // valid type info has self reference at -0x04
      CMP   EAX,[EAX-4]                         // (TypInfo-4)^ = TypInfo
      JNE   @@False
@@Step5_TypeDataPointsBackToClass:
      // type data of class' type info points to class again
      PUSH  EDX
      // copied from GetTypeData (EAX==PTypeInfo) -> (EAX==PTypeData)
        XOR   EDX,EDX
        MOV   DL,[EAX].TTypeInfo.Name.Byte[0]
        LEA   EAX,[EAX].TTypeInfo.Name[EDX+1]
      POP   EDX
      CMP   ECX,[EAX].TTypeData.ClassType       // TypeData(AnObject)^.ClassType = AnObject.ClassType
      JNE   @@False
      // ****************************

@@True:
      MOV   AL, 1
      JMP   @@ReturnWithoutException
@@FALSE:
      SUB   EAX, EAX
@@ReturnWithoutException:
      POP   DWord Ptr FS:[EDX]                  // uninstall Exception Frame
      POP   EDX
      RET

@@Except:
      MOV   EAX,[ESP + 00Ch]                    // context
      MOV   DWord Ptr [EAX + 0B0h],0            // context.eax = 0
      MOV   DWord Ptr [EAX + 0B8h],OFFSET @@ReturnWithoutException   // context.eip = @@2
      SUB   EAX,EAX                             // 0 = ExceptionContinueExecution
end;

@Hagen: Wenn Du damit einverstanden bist, würde ich IsObject sowie ein Extrakt für IsClass nach TypInfoEx übernehmen.

[Phoenix]

Boah. Manchmal glaub ich echt, Ihr habt kein RL mehr.

Nee, jetzt aber mal im Ernst: Respekt! Da steckt ne ungeheure Menge Gehirnschmalz drin, da wär ich froh wenn ich auch irgendwann mal so weit komme. Aber ihr habt mir da glaub ich auch ein paar Jährchen voraus

Um nochmal von der Praxis etwas wegzukommen nochmal zur Theorie:

1.) Wenn ein Objekt TypOfA zerstört wird und unmittelbar danach ein Objekt TypeOfB mit der gleichen Größe angelegt wird besteht wie Hagen sagte eine nicht unerhebliche Wahrscheinlichkeit, dass eine alte Referenz auf das erste Objekt danach eine gültige Referenz auf das zweite Objekt ist.

Eine Abfrage ob das Objekt jedoch vom Typ TypOfA ist, würde fehlschlagen. ( if ref is TypeOfA ) Somit kann ich schonmal abfangen das mir ein falsches Objekt untergejubelt wird.

2.) Wird das Objekt einfach nur zerstört kann ich mit dem entsprechenden Code auch abprüfen, ob das Objekt hinter der Referenz noch gültig ist oder nicht. Dies stellt auch kein Problem dar, im schlimmsten fall eben über Try-except und eien Zugriff auf das Objekt.

3.) Wird ein Objekt vom TypOfA erzeugt, zerstört und neu angelegt liegt ein anderes Objekt vom gleichen Typ an der gleichen Speicherstelle. Das wollt ihr so wie ich das mitbekommen habe am liebsten abfragen.

Hier stellt sich die Frage, warum?
Es reicht doch, wenn die Datenfelder des Objektes verändert werden. Allein schon durch eine Änderung einer Variablen kann ein Objekt 'falsche' oder unerwartete Werte annehmen. Da muss ich nicht das Objekt erst zerstören, neu anlegen und wieder befüllen um Schindluder damit zu betreiben.

Auf der ganz anderen Seite noch folgende Fragestellung:

Ich als Entwickler sollte wissen wann und wo ich ein Objekt zerstöre und wann und wo ich es benutze. Ich müsste mich doch gar nicht mit solchen Problemen herumschlagen, ausser es geht um die Bugsuche. Wer sollte mir denn ein falsches Objekt unterjubeln wollen? Es ist doch mein Code.

[negaH]

Zitat:

1.) Wenn ein Objekt TypOfA zerstört wird und unmittelbar danach ein Objekt TypeOfB mit der gleichen Größe angelegt wird besteht wie Hagen sagte eine nicht unerhebliche Wahrscheinlichkeit, dass eine alte Referenz auf das erste Objekt danach eine gültige Referenz auf das zweite Objekt ist.

Eine Abfrage ob das Objekt jedoch vom Typ TypOfA ist, würde fehlschlagen. ( if ref is TypeOfA ) Somit kann ich schonmal abfangen das mir ein falsches Objekt untergejubelt wird.

2.) Wird das Objekt einfach nur zerstört kann ich mit dem entsprechenden Code auch abprüfen, ob das Objekt hinter der Referenz noch gültig ist oder nicht. Dies stellt auch kein Problem dar, im schlimmsten fall eben über Try-except und eien Zugriff auf das Objekt.

3.) Wird ein Objekt vom TypOfA erzeugt, zerstört und neu angelegt liegt ein anderes Objekt vom gleichen Typ an der gleichen Speicherstelle. Das wollt ihr so wie ich das mitbekommen habe am liebsten abfragen.

1.) die Wahrscheinlichkeit ist bei nicht multithreaded Anweendung exakt 100%. Der Borland MM merkt sich speziell den zu letzt freigegebenen Speicherblock und überprüft bei einer erneuten Allozierung ob das Speicherbereich in den alten zuvor freigegebenen reinpasst. Er verwendet also als erste und schnellste Alternative immer den zuvor freigegebenen Speicher wieder. Im Falle das also der neue Speicher in der Größe <= dem zuvor freigegebenen ist kann man mit 100% Sicherheit sagen das dieser weiderverwendet wird.

2.) korrekt, aber exakt das ist aus Sicht einer wiederholten Freigabe und Neuallokation von Speicher eher weniger der Fall.

3.) Korrekt. Aber wenn man in Variable A ein Objekt allozierte und es freigibt und in B danach ebenfalls ein neues Objekt der gleichen Klasse so würde man mit A.Free; eben das neue Objekt zerstören. Exakt dies führt zu KEINEM sofort sichtbaren Fehler sondern zu serh unangenehmen Seiten-Effekt-Fehlern. Solche Fehler sind es die den Proghrammierer dann Wochenlang auf Fehlersuche festhängen lassen. Also sehr unangenehm.

Zitat:

Hier stellt sich die Frage, warum?
Es reicht doch, wenn die Datenfelder des Objektes verändert werden. Allein schon durch eine Änderung einer Variablen kann ein Objekt 'falsche' oder unerwartete Werte annehmen. Da muss ich nicht das Objekt erst zerstören, neu anlegen und wieder befüllen um Schindluder damit zu betreiben.

Eines hat mit dem Anderen nichts zu tuen. Überschreibt man durch falsche Speicheroperationen Felder eines Objektes dann hat dieser Fehler reingarnichts mit einem Fehler bei der falschen Variablenbenutzung, ergo Freigabe von Objekten zu tuen. IsObject() soll primär eine Möglichkeit bieten eine Variable auf eine Objectinstance zu überprüfen. Analytisch gesehen gibts dafür mit IsObject() keine 100% sichere Methode, ABER! die Verwendung von IsObject() ist wesentlich sicherer als einfach nur Assigned() zu benutzen. Konzeptionell sauberer wäre es wenn man natürlich Assigned() benutzen kann, dazu muß aber eben zu 100% sichergestellt sein das man mit Assigend() auch wirklich sauber bereinigte Variablen überprüft. Und exakt dies ist eben nicht der Fall. IsObject() befreit also den Programmierer von keinerlei Verantwortung einen sauberen Source zu schreiben, es verringert nur die Abstütze falls man einen Source eines schlampigen Coders benutzen muss.

IsObject() ist also keine Lösung für ein Problem, sondern nur ein probates Mittel bei zb. der Entwicklung in Teams um eventuelle Programmierfehler frühzeitiger erkennen zu können.

Gruß Hagen

[choose]

...darüber hinaus könnte IsObject auch zu analytischen Zwecken eingesetzt werden. So könnte ein bekannter Speicherbereich nach Objekten "durchsucht" werden, um Heuristiken über den Gebrauch von Klassen zu erstellen oder spezielle, sonst nicht weiter zugängliche, Exemplare gesucht werden. Auch Anfragen nach allen Exemplaren einer Klasse könnten mit einer Art von IsObject gelöst werden, auch wenn die vorliegende Implementierung zugegeben etwas inperformant sein würde...