Michael Schimmel
573 lines
17 KiB
ObjectPascal
573 lines
17 KiB
ObjectPascal
unit Myc.Data.Records;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.TypInfo;
|
|
|
|
type
|
|
TDataRecord = record
|
|
public
|
|
type
|
|
TFieldType = (dfFloat, dfInteger, dfString, dfTimestamp, dfRecord);
|
|
|
|
TField = record
|
|
private
|
|
FFieldType: TFieldType;
|
|
FTypeInfo: PtypeInfo;
|
|
FName: string;
|
|
FOffset: Integer;
|
|
FSize: Integer;
|
|
|
|
procedure FromType(const [ref] Buffer: TBytes; const Src);
|
|
procedure ToType(const [ref] Buffer: TBytes; var Dst);
|
|
|
|
procedure InitField(const [ref] Buffer: TBytes);
|
|
procedure AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
|
|
procedure FinalizeField(const [ref] Buffer: TBytes);
|
|
|
|
procedure CopyField(Src, Dst: Pointer);
|
|
|
|
property Offset: Integer read FOffset;
|
|
|
|
constructor Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset, ASize: Integer);
|
|
|
|
procedure Copy(Src, Dst: Pointer);
|
|
|
|
function GetAlignedSize: Integer; inline;
|
|
|
|
public
|
|
class operator Equal(const A, B: TField): Boolean;
|
|
class operator NotEqual(const A, B: TField): Boolean; inline;
|
|
|
|
property FieldType: TFieldType read FFieldType;
|
|
property Name: string read FName;
|
|
property Size: Integer read FSize;
|
|
property AlignedSize: Integer read GetAlignedSize;
|
|
property TypeInfo: PTypeInfo read FTypeInfo;
|
|
end;
|
|
|
|
TFieldDef = record
|
|
public
|
|
Name: String;
|
|
FieldType: TFieldType
|
|
end;
|
|
|
|
TLayout = record
|
|
private
|
|
FFields: TArray<TField>;
|
|
|
|
constructor Create(const AFields: TArray<TField>);
|
|
function GetSize: Integer;
|
|
|
|
public
|
|
class function FromRecord<T>: TLayout; overload; static;
|
|
class function FromRecord(ATypeInfo: PtypeInfo): TLayout; overload; static;
|
|
|
|
class operator Equal(const A, B: TLayout): Boolean;
|
|
class operator NotEqual(const A, B: TLayout): Boolean; inline;
|
|
|
|
class function Construct(const Def: TArray<TFieldDef>): TLayout; static;
|
|
|
|
procedure Copy(Src, Dst: Pointer);
|
|
|
|
function IndexOf(const Name: String): Integer;
|
|
property Fields: TArray<TField> read FFields;
|
|
property Size: Integer read GetSize;
|
|
end;
|
|
|
|
const
|
|
Align = sizeof(Pointer);
|
|
|
|
private
|
|
FLayout: TLayout;
|
|
FBuffer: TBytes;
|
|
function GetRawData: Pointer; inline;
|
|
|
|
public
|
|
constructor Create(const ALayout: TLayout); overload;
|
|
constructor Create(const ALayout: TLayout; const ABuffer: TBytes); overload;
|
|
|
|
class operator Finalize(var Dest: TDataRecord);
|
|
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
|
|
|
class function FromRecord<T>: TDataRecord; overload; static;
|
|
class function FromRecord<T>(const Src: T): TDataRecord; overload; static;
|
|
|
|
procedure CopyFrom<T>(const Src: T);
|
|
|
|
procedure SetValue<T>(const Name: String; const Value: T); overload;
|
|
procedure SetValue(Idx: Integer; const Value); overload;
|
|
|
|
function GetValue<T>(const Name: String): T; overload;
|
|
procedure GetValue(Idx: Integer; out Value); overload;
|
|
function GetValueRef(Idx: Integer): Pointer; overload;
|
|
|
|
procedure CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
|
|
|
|
property RawData: Pointer read GetRawData;
|
|
property Layout: TLayout read FLayout;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Rtti;
|
|
|
|
{ TDataRecord }
|
|
|
|
constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
|
|
begin
|
|
FLayout := ALayout;
|
|
FBuffer := ABuffer;
|
|
end;
|
|
|
|
constructor TDataRecord.Create(const ALayout: TLayout);
|
|
begin
|
|
var buf: TBytes;
|
|
SetLength(buf, ALayout.Size);
|
|
Create(ALayout, buf);
|
|
end;
|
|
|
|
procedure TDataRecord.CopyFrom<T>(const Src: T);
|
|
begin
|
|
for var i := 0 to High(FLayout.FFields) do
|
|
FLayout.Fields[i].FromType(FBuffer, Src);
|
|
end;
|
|
|
|
procedure TDataRecord.CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
|
|
begin
|
|
Assert(SrcRec.Layout.Fields[SrcIdx].FieldType = FLayout.Fields[SrcIdx].FieldType);
|
|
|
|
var Src := @SrcRec.FBuffer[SrcRec.Layout.Fields[SrcIdx].Offset];
|
|
var Dst := @FBuffer[FLayout.Fields[DstIdx].Offset];
|
|
|
|
FLayout.Fields[SrcIdx].CopyField(Src, Dst);
|
|
end;
|
|
|
|
class function TDataRecord.FromRecord<T>: TDataRecord;
|
|
begin
|
|
var layout := TLayout.FromRecord<T>;
|
|
var buf: TBytes;
|
|
|
|
SetLength(buf, layout.Size);
|
|
for var i := 0 to High(layout.Fields) do
|
|
layout.Fields[i].InitField(buf);
|
|
|
|
Result.Create(layout, buf);
|
|
end;
|
|
|
|
class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord;
|
|
begin
|
|
Result := FromRecord<T>;
|
|
Result.CopyFrom<T>(Src);
|
|
end;
|
|
|
|
function TDataRecord.GetRawData: Pointer;
|
|
begin
|
|
Result := @FBuffer[0];
|
|
end;
|
|
|
|
procedure TDataRecord.GetValue(Idx: Integer; out Value);
|
|
begin
|
|
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
|
case FLayout.Fields[Idx].FieldType of
|
|
dfFloat: Double(Value) := PDouble(P)^;
|
|
dfInteger: Int64(Value) := PInt64(Value)^;
|
|
dfString: String(Value) := PString(Value)^;
|
|
dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
|
|
dfRecord: TDataRecord(Value) := TDataRecord(Value);
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
|
|
procedure TDataRecord.SetValue(Idx: Integer; const Value);
|
|
begin
|
|
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
|
case FLayout.Fields[Idx].FieldType of
|
|
dfFloat: PDouble(P)^ := Double(Value);
|
|
dfInteger: PInt64(P)^ := Int64(Value);
|
|
dfString: PString(P)^ := String(Value);
|
|
dfTimestamp: PDateTime(P)^ := TDateTime(Value);
|
|
dfRecord: TDataRecord(P^) := TDataRecord(Value);
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
|
|
function TDataRecord.GetValue<T>(const Name: String): T;
|
|
begin
|
|
var idx := FLayout.IndexOf(Name);
|
|
if (idx >= 0) then
|
|
begin
|
|
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
|
|
FLayout.Fields[idx].ToType(FBuffer, Result);
|
|
end;
|
|
end;
|
|
|
|
function TDataRecord.GetValueRef(Idx: Integer): Pointer;
|
|
begin
|
|
Result := @FBuffer[FLayout.Fields[Idx].Offset];
|
|
end;
|
|
|
|
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
|
|
begin
|
|
var idx := FLayout.IndexOf(Name);
|
|
if (idx >= 0) then
|
|
begin
|
|
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
|
|
FLayout.Fields[idx].FromType(FBuffer, Value);
|
|
end;
|
|
end;
|
|
|
|
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
|
begin
|
|
if Dest.FLayout.FFields <> Src.FLayout.FFields then
|
|
begin
|
|
Finalize(Dest);
|
|
var buf: TBytes;
|
|
SetLength(buf, Length(Dest.FBuffer));
|
|
Dest.Create(Src.Layout, buf);
|
|
end;
|
|
|
|
for var i := 0 to High(Dest.Layout.Fields) do
|
|
Dest.Layout.Fields[i].AssignField(Dest.FBuffer, Src.FBuffer);
|
|
end;
|
|
|
|
class operator TDataRecord.Finalize(var Dest: TDataRecord);
|
|
begin
|
|
for var i := High(Dest.FLayout.Fields) downto 0 do
|
|
Dest.Layout.Fields[i].FinalizeField(Dest.FBuffer);
|
|
end;
|
|
|
|
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset, ASize: Integer);
|
|
begin
|
|
FName := AName;
|
|
FFieldType := AFieldType;
|
|
FOffset := AOffset;
|
|
FTypeInfo := ATypeInfo;
|
|
FSize := ASize;
|
|
end;
|
|
|
|
procedure TDataRecord.TField.InitField(const [ref] Buffer: TBytes);
|
|
begin
|
|
if not (FFieldType in [dfString, dfRecord]) then
|
|
exit;
|
|
|
|
Assert(FOffset + Size <= Length(Buffer));
|
|
|
|
var P := @Buffer[FOffset];
|
|
case FFieldType of
|
|
dfString: Initialize(PString(P)^);
|
|
dfRecord: Initialize(TDataRecord(P^));
|
|
end;
|
|
end;
|
|
|
|
procedure TDataRecord.TField.FinalizeField(const [ref] Buffer: TBytes);
|
|
begin
|
|
if not (FFieldType in [dfString, dfRecord]) then
|
|
exit;
|
|
|
|
Assert(FOffset + Size <= Length(Buffer));
|
|
|
|
var P := @Buffer[FOffset];
|
|
case FFieldType of
|
|
dfString: Finalize(PString(P)^);
|
|
dfRecord: Finalize(TDataRecord(P^));
|
|
end;
|
|
end;
|
|
|
|
procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; const Src);
|
|
begin
|
|
Assert(FOffset + Size <= Length(Buffer));
|
|
Copy(@Src, @Buffer[FOffset]);
|
|
end;
|
|
|
|
function TDataRecord.TField.GetAlignedSize: Integer;
|
|
begin
|
|
Result := (FSize + (Align - 1)) and not (Align - 1);
|
|
end;
|
|
|
|
procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; var Dst);
|
|
begin
|
|
var Src := @Buffer[FOffset];
|
|
case FFieldType of
|
|
dfFloat:
|
|
begin
|
|
Assert(FTypeInfo.Kind = tkFloat);
|
|
case GetTypeData(FTypeInfo).FloatType of
|
|
ftSingle: PSingle(@Dst)^ := PSingle(Src)^;
|
|
ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
dfInteger:
|
|
begin
|
|
case FTypeInfo.Kind of
|
|
tkInteger: PInteger(@Dst)^ := PInteger(Src)^;
|
|
tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
dfString:
|
|
begin
|
|
Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
|
|
PString(@Dst)^ := PString(Src)^;
|
|
end;
|
|
dfTimestamp:
|
|
begin
|
|
Assert(FTypeInfo.Kind = tkFloat);
|
|
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
|
|
PDateTime(@Dst)^ := PDateTime(Src)^;
|
|
end;
|
|
dfRecord:
|
|
begin
|
|
Assert(FTypeInfo = System.TypeInfo(TDataRecord));
|
|
TDataRecord(Dst) := TDataRecord(Src^);
|
|
end;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
|
|
procedure TDataRecord.TField.AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
|
|
begin
|
|
Assert(FOffset + Size <= Length(Dest));
|
|
|
|
var Dst := @Dest[FOffset];
|
|
var Src := @Source[FOffset];
|
|
|
|
CopyField(Src, Dst);
|
|
end;
|
|
|
|
procedure TDataRecord.TField.CopyField(Src, Dst: Pointer);
|
|
begin
|
|
case FFieldType of
|
|
dfFloat: PDouble(Dst)^ := PDouble(Src)^;
|
|
dfInteger: PInt64(Dst)^ := PInt64(Src)^;
|
|
dfString: PString(Dst)^ := PString(Src)^;
|
|
dfTimestamp: PDateTime(Dst)^ := PDateTime(Src)^;
|
|
dfRecord: TDataRecord(Dst^) := TDataRecord(Src^);
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
|
|
procedure TDataRecord.TField.Copy(Src, Dst: Pointer);
|
|
begin
|
|
case FFieldType of
|
|
dfFloat:
|
|
begin
|
|
Assert(FTypeInfo.Kind = tkFloat);
|
|
case GetTypeData(FTypeInfo).FloatType of
|
|
ftSingle: PSingle(Dst)^ := PSingle(Src)^;
|
|
ftDouble: PDouble(Dst)^ := PDouble(Src)^;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
dfInteger:
|
|
begin
|
|
case FTypeInfo.Kind of
|
|
tkInteger: PInteger(Dst)^ := PInteger(Src)^;
|
|
tkInt64: PInt64(Dst)^ := PInt64(Src)^;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
dfString:
|
|
begin
|
|
Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
|
|
PString(Dst)^ := PString(Src)^;
|
|
end;
|
|
dfTimestamp:
|
|
begin
|
|
Assert(FTypeInfo.Kind = tkFloat);
|
|
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
|
|
PDateTime(Dst)^ := PDateTime(Src)^;
|
|
end;
|
|
dfRecord:
|
|
begin
|
|
Assert(FTypeInfo = System.TypeInfo(TDataRecord));
|
|
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
|
|
TDataRecord(Dst^) := TDataRecord(Src^);
|
|
end;
|
|
else
|
|
Assert(false);
|
|
end;
|
|
end;
|
|
|
|
class operator TDataRecord.TField.Equal(const A, B: TField): Boolean;
|
|
begin
|
|
Result := (A.FFieldType = B.FFieldType) and (A.FTypeInfo = B.FTypeInfo) and (A.FOffset = B.FOffset) and (A.FName = B.FName);
|
|
end;
|
|
|
|
class operator TDataRecord.TField.NotEqual(const A, B: TField): Boolean;
|
|
begin
|
|
Result := not (A = B);
|
|
end;
|
|
|
|
constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
|
|
begin
|
|
FFields := AFields;
|
|
end;
|
|
|
|
class function TDataRecord.TLayout.Construct(const Def: TArray<TFieldDef>): TLayout;
|
|
const
|
|
DataSize: array[TDataRecord.TFieldType] of Integer =
|
|
(sizeof(Double), sizeof(Int64), sizeof(String), sizeof(TDateTime), sizeof(TDataRecord));
|
|
var
|
|
Fields: TArray<TField>;
|
|
begin
|
|
SetLength(Fields, Length(Def));
|
|
var ofs := 0;
|
|
for var i := 0 to High(Fields) do
|
|
begin
|
|
var ti: PTypeInfo := nil;
|
|
case Def[i].FieldType of
|
|
dfFloat: ti := TypeInfo(Double);
|
|
dfInteger: ti := TypeInfo(Int64);
|
|
dfString: ti := TypeInfo(String);
|
|
dfTimestamp: ti := TypeInfo(TDateTime);
|
|
dfRecord: ti := TypeInfo(TDataRecord);
|
|
end;
|
|
|
|
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ti, ofs, DataSize[Def[i].FieldType]);
|
|
inc(ofs, Fields[i].AlignedSize);
|
|
end;
|
|
|
|
Result.Create(Fields);
|
|
end;
|
|
|
|
procedure TDataRecord.TLayout.Copy(Src, Dst: Pointer);
|
|
begin
|
|
for var i := 0 to High(FFields) do
|
|
begin
|
|
var ofs := FFields[i].Offset;
|
|
var S: PByte := Src;
|
|
inc(S, ofs);
|
|
var D: PByte := Dst;
|
|
inc(D, ofs);
|
|
FFields[i].Copy(S, D);
|
|
end;
|
|
end;
|
|
|
|
{ TLayout }
|
|
|
|
class function TDataRecord.TLayout.FromRecord(ATypeInfo: PtypeInfo): TLayout;
|
|
begin
|
|
var ctx := TRttiContext.Create;
|
|
var rttiType := ctx.GetType(ATypeInfo);
|
|
var rttiFields := rttiType.GetFields;
|
|
var fields: TArray<TField>;
|
|
|
|
// Add each field and its value to the builder
|
|
// The internal layout has to be the same as the original record
|
|
SetLength(fields, Length(rttiFields));
|
|
for var i := 0 to High(rttiFields) do
|
|
begin
|
|
var rf := rttiFields[i];
|
|
var ft: TFieldType := Default(TFieldType);
|
|
var size: Integer := 0;
|
|
|
|
case rf.FieldType.TypeKind of
|
|
tkInteger:
|
|
begin
|
|
ft := dfInteger;
|
|
size := sizeof(Integer);
|
|
end;
|
|
tkInt64:
|
|
begin
|
|
ft := dfInteger;
|
|
size := sizeof(Int64);
|
|
end;
|
|
tkFloat:
|
|
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then
|
|
begin
|
|
ft := dfTimestamp;
|
|
size := sizeof(TDateTime);
|
|
end
|
|
else
|
|
begin
|
|
case GetTypeData(rf.FieldType.Handle).FloatType of
|
|
ftSingle:
|
|
begin
|
|
ft := dfFloat;
|
|
size := sizeof(Single);
|
|
end;
|
|
ftDouble:
|
|
begin
|
|
ft := dfFloat;
|
|
size := sizeof(Double);
|
|
end;
|
|
end;
|
|
end;
|
|
tkString, tkWString, tkLString, tkUString:
|
|
begin
|
|
ft := dfString;
|
|
size := sizeof(String);
|
|
end;
|
|
tkMRecord:
|
|
begin
|
|
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDataRecord))) then
|
|
begin
|
|
ft := dfRecord;
|
|
size := sizeof(TDataRecord);
|
|
end
|
|
end;
|
|
end;
|
|
|
|
if size = 0 then
|
|
raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');
|
|
|
|
fields[i] := TField.Create(rf.Name, ft, rf.FieldType.Handle, rf.Offset, size);
|
|
end;
|
|
|
|
Result.Create(fields);
|
|
end;
|
|
|
|
{ TLayout }
|
|
|
|
class function TDataRecord.TLayout.FromRecord<T>: TLayout;
|
|
begin
|
|
Result := FromRecord(TypeInfo(T));
|
|
end;
|
|
|
|
function TDataRecord.TLayout.GetSize: Integer;
|
|
begin
|
|
Result := 0;
|
|
if Length(FFields) > 0 then
|
|
with FFields[High(FFields)] do
|
|
Result := Offset + Size;
|
|
end;
|
|
|
|
function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
|
|
begin
|
|
for var i := 0 to High(FFields) do
|
|
if (FFields[i].Name = Name) then
|
|
exit(i);
|
|
exit(-1);
|
|
end;
|
|
|
|
class operator TDataRecord.TLayout.Equal(const A, B: TLayout): Boolean;
|
|
begin
|
|
if Length(A.FFields) <> Length(B.FFields) then
|
|
exit(false);
|
|
|
|
for var i := 0 to High(A.FFields) do
|
|
if A.FFields[i] <> B.FFields[i] then
|
|
exit(false);
|
|
exit(true);
|
|
end;
|
|
|
|
class operator TDataRecord.TLayout.NotEqual(const A, B: TLayout): Boolean;
|
|
begin
|
|
Result := not (A = B);
|
|
end;
|
|
|
|
end.
|