[code=java] function TObject.ClassType: TClass; begin Pointer(Result) := PPointer(Self)^; end; class function TObject.ClassName: ShortString; {$IFDEF PUREPASCAL} begin Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^; end; {$ELSE} asm { -> EAX VMT } { EDX Pointer to result string } PUSH ESI PUSH EDI MOV EDI,EDX MOV ESI,[EAX].vmtClassName XOR ECX,ECX MOV CL,[ESI] INC ECX REP MOVSB POP EDI POP ESI end; {$ENDIF} class function TObject.ClassNameIs(const Name: string): Boolean; {$IFDEF PUREPASCAL} var Temp: ShortString; I: Byte; begin Result := False; Temp := ClassName; for I := 0 to Byte(Temp[0]) do if Temp[I] <> Name[I] then Exit; Result := True; end; {$ELSE} asm PUSH EBX XOR EBX,EBX OR EDX,EDX JE @@exit MOV EAX,[EAX].vmtClassName XOR ECX,ECX MOV CL,[EAX] CMP ECX,[EDX-4] JNE @@exit DEC EDX @@loop: MOV BH,[EAX+ECX] XOR BH,[EDX+ECX] AND BH,0DFH JNE @@exit DEC ECX JNE @@loop INC EBX @@exit: MOV AL,BL POP EBX end; {$ENDIF} class function TObject.ClassParent: TClass; {$IFDEF PUREPASCAL} begin Pointer(Result) := PPointer(Integer(Self) + vmtParent)^; if Result <> nil then Pointer(Result) := PPointer(Result)^; end; {$ELSE} asm MOV EAX,[EAX].vmtParent TEST EAX,EAX JE @@exit MOV EAX,[EAX] @@exit: end; {$ENDIF} class function TObject.NewInstance: TObject; begin Result := InitInstance(_GetMem(InstanceSize)); end; procedure TObject.FreeInstance; begin CleanupInstance; _FreeMem(Self); end; class function TObject.InstanceSize: Longint; begin Result := PInteger(Integer(Self) + vmtInstanceSize)^; end; constructor TObject.Create; begin end; destructor TObject.Destroy; begin end; procedure TObject.Free; begin if Self <> nil then Destroy; end; class function TObject.InitInstance(Instance: Pointer): TObject; {$IFDEF PUREPASCAL} var IntfTable: PInterfaceTable; ClassPtr: TClass; I: Integer; begin FillChar(Instance^, InstanceSize, 0); PInteger(Instance)^ := Integer(Self); ClassPtr := Self; while ClassPtr <> nil do begin IntfTable := ClassPtr.GetInterfaceTable; if IntfTable <> nil then for I := 0 to IntfTable.EntryCount-1 do with IntfTable.Entries[I] do begin if VTable <> nil then PInteger(@PChar(Instance)[IOffset])^ := Integer(VTable); end; ClassPtr := ClassPtr.ClassParent; end; Result := Instance; end; {$ELSE} asm PUSH EBX PUSH ESI PUSH EDI MOV EBX,EAX MOV EDI,EDX STOSD MOV ECX,[EBX].vmtInstanceSize XOR EAX,EAX PUSH ECX SHR ECX,2 DEC ECX REP STOSD POP ECX AND ECX,3 REP STOSB MOV EAX,EDX MOV EDX,ESP @@0: MOV ECX,[EBX].vmtIntfTable TEST ECX,ECX JE @@1 PUSH ECX @@1: MOV EBX,[EBX].vmtParent TEST EBX,EBX JE @@2 MOV EBX,[EBX] JMP @@0 @@2: CMP ESP,EDX JE @@5 @@3: POP EBX MOV ECX,[EBX].TInterfaceTable.EntryCount ADD EBX,4 @@4: MOV ESI,[EBX].TInterfaceEntry.VTable TEST ESI,ESI JE @@4a MOV EDI,[EBX].TInterfaceEntry.IOffset MOV [EAX+EDI],ESI @@4a: ADD EBX,TYPE TInterfaceEntry DEC ECX JNE @@4 CMP ESP,EDX JNE @@3 @@5: POP EDI POP ESI POP EBX end; {$ENDIF} [/code]