are there any TypeInfo helper somewhere ?
are there any TypeInfo helper somewhere ?
the TypeInfo unit is somewhat complex to handle, but I don't like how the Rtti context handles things...
I'm looking for something like this :
type
TTypeInfoHelper = record helper for TTypeInfo
function DataPtr(Offset: Integer): Pointer; inline;
function DataByte(Offset: Integer): Byte; inline;
function DataLong(Offset: Integer): Integer; inline;
function RecordFieldsOfs : Integer;
function RecordFieldCount: Integer;
function RecordFieldType(Index: Integer): PRecordTypeField;
end;
TRecordTypeFieldHelper = record helper for TRecordTypeField
function InstanceSize: Integer;
end;
function TTypeInfoHelper.DataPtr(Offset: Integer): Pointer;
var
Value: PByte;
begin
Value := PByte(TypeData);
Inc(Value, Offset);
Result := Value;
end;
function TTypeInfoHelper.DataByte(Offset: Integer): Byte;
begin
Result := PByte(DataPtr(Offset))^;
end;
function TTypeInfoHelper.DataLong(Offset: Integer): Integer;
begin
Result := PInteger(DataPtr(Offset))^;
end;
function TTypeInfoHelper.RecordFieldsOfs: Integer;
var
NumOps: Byte;
begin
Result := 2 * SizeOf(Integer) + TypeData.ManagedFldCount * SizeOf(TManagedField);
NumOps := DataByte(Result);
Inc(Result, 1 + NumOps * SizeOf(Pointer));
end;
function TTypeInfoHelper.RecordFieldCount: Integer;
begin
if Kind <> tkRecord then
Exit(0);
Result := DataLong(RecordFieldsOfs);
end;
function TTypeInfoHelper.RecordFieldType(Index: Integer): PRecordTypeField;
var
Offset: Integer;
NumOps: Byte;
begin
if (Kind <> tkRecord) or (Index < 0) then
Exit(nil);
Offset := RecordFieldsOfs;
if DataLong(Offset) <= Index then
Exit(nil);
Inc(Offset, SizeOf(Integer));
Result := DataPtr(Offset);
while Index > 0 do
begin
Inc(Offset, Result.InstanceSize);
Result := DataPtr(Offset);
Dec(Index);
end;
end;
function TRecordTypeFieldHelper.InstanceSize: Integer;
begin
Result := SizeOf(TRecordTypeField) - 255 + Length(Name) + AttrData.Len;
end;
{ TForm1 }
procedure TForm1.Analyse(Instance, TypeInfo: Pointer);
var
Info : PTypeInfo absolute TypeInfo;
Index : Integer;
Field : PRecordTypeField;
begin
Memo1.Lines.Add(Info.Name);
case Info.Kind of
tkRecord:
begin
Memo1.Lines.Add('tkRecord');
Memo1.Lines.Add(' SizeOf = ' + IntToStr(Info.TypeData.RecSize));
Memo1.Lines.Add(' RecordCount = ' + IntToStr(Info.RecordFieldCount));
for Index := 0 to Info.RecordFieldCount - 1 do
begin
Field := Info.RecordFieldType(Index);
Memo1.Lines.Add(' ' + Field.Name);
Analyse(PByte(Instance) + Field.Field.FldOffset, Field.Field.TypeRef^);
end;
end;
end;
end;
the TypeInfo unit is somewhat complex to handle, but I don't like how the Rtti context handles things...
I'm looking for something like this :
type
TTypeInfoHelper = record helper for TTypeInfo
function DataPtr(Offset: Integer): Pointer; inline;
function DataByte(Offset: Integer): Byte; inline;
function DataLong(Offset: Integer): Integer; inline;
function RecordFieldsOfs : Integer;
function RecordFieldCount: Integer;
function RecordFieldType(Index: Integer): PRecordTypeField;
end;
TRecordTypeFieldHelper = record helper for TRecordTypeField
function InstanceSize: Integer;
end;
function TTypeInfoHelper.DataPtr(Offset: Integer): Pointer;
var
Value: PByte;
begin
Value := PByte(TypeData);
Inc(Value, Offset);
Result := Value;
end;
function TTypeInfoHelper.DataByte(Offset: Integer): Byte;
begin
Result := PByte(DataPtr(Offset))^;
end;
function TTypeInfoHelper.DataLong(Offset: Integer): Integer;
begin
Result := PInteger(DataPtr(Offset))^;
end;
function TTypeInfoHelper.RecordFieldsOfs: Integer;
var
NumOps: Byte;
begin
Result := 2 * SizeOf(Integer) + TypeData.ManagedFldCount * SizeOf(TManagedField);
NumOps := DataByte(Result);
Inc(Result, 1 + NumOps * SizeOf(Pointer));
end;
function TTypeInfoHelper.RecordFieldCount: Integer;
begin
if Kind <> tkRecord then
Exit(0);
Result := DataLong(RecordFieldsOfs);
end;
function TTypeInfoHelper.RecordFieldType(Index: Integer): PRecordTypeField;
var
Offset: Integer;
NumOps: Byte;
begin
if (Kind <> tkRecord) or (Index < 0) then
Exit(nil);
Offset := RecordFieldsOfs;
if DataLong(Offset) <= Index then
Exit(nil);
Inc(Offset, SizeOf(Integer));
Result := DataPtr(Offset);
while Index > 0 do
begin
Inc(Offset, Result.InstanceSize);
Result := DataPtr(Offset);
Dec(Index);
end;
end;
function TRecordTypeFieldHelper.InstanceSize: Integer;
begin
Result := SizeOf(TRecordTypeField) - 255 + Length(Name) + AttrData.Len;
end;
{ TForm1 }
procedure TForm1.Analyse(Instance, TypeInfo: Pointer);
var
Info : PTypeInfo absolute TypeInfo;
Index : Integer;
Field : PRecordTypeField;
begin
Memo1.Lines.Add(Info.Name);
case Info.Kind of
tkRecord:
begin
Memo1.Lines.Add('tkRecord');
Memo1.Lines.Add(' SizeOf = ' + IntToStr(Info.TypeData.RecSize));
Memo1.Lines.Add(' RecordCount = ' + IntToStr(Info.RecordFieldCount));
for Index := 0 to Info.RecordFieldCount - 1 do
begin
Field := Info.RecordFieldType(Index);
Memo1.Lines.Add(' ' + Field.Name);
Analyse(PByte(Instance) + Field.Field.FldOffset, Field.Field.TypeRef^);
end;
end;
end;
end;
Seems to me like you know what you want to do. What's stopping you writing your own helper library?
ReplyDeletenot reinvent the wheel :)
ReplyDeleteI've made this anyway:
type
TSubTest = record
aa: Integer;
bb: string;
end;
TTest = record
a: Integer;
b: string;
c: array of string;
d: TSubTest;
e: array of TSubTest;
f: array of Integer;
end;
TObjectTest = class
private
a: Integer;
t: TTest;
end;
var
o1, o2: TObjectTest;
begin
o1 := TObjectTest.Create;
o1.a := 123;
o1.t.a := 1;
o1.t.b := 'b';
o1.t.c := ['un', 'deux'];
o1.t.d.aa := 2;
o1.t.d.bb := 'bb';
SetLength(o1.t.e, 1);
o1.t.e[0].aa := 3;
o1.t.e[0].bb := 'BB';
o1.t.f := [1, 2, 3];
s: = o1.toJSON();
Memo1.Lines.Add(s);
o2 := TObjectTest.Create;
o2.FromJSON(s);
s := o2.toJSON();
Memo1.Lines.Add(s);
end;
{"a":123,"t":{"a":1,"b":"b","c":["un","deux"],"d":{"aa":2,"bb":"bb"},"e":[{"aa":3,"bb":"BB"}],"f":[1,2,3]}}
with only a TObject and a TTypeInfo helper :)
it doesn't supports properties getter/setters, JSONAttributes, class instantiation etc...but I don't really need them.