IsObject / IsClass

[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.