Thema: Delphi IsObject / IsClass

Einzelnen Beitrag anzeigen

choose

Registriert seit: 2. Nov 2003
Ort: Bei Kiel, SH
729 Beiträge
 
Delphi 2006 Architect
 

Re: IsObject / IsClass

  Alt 21. Nov 2005, 09:00
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.
gruß, choose
  Mit Zitat antworten Zitat