Procedure TXMLSerializeRecordInfo.CheckOffsets(Intern: Boolean = False);
Var i: Integer;
Begin
If not Intern
Then While Assigned(_Parent)
do Self := _Parent;
For i := 0
to High(_Data)
do
If _OffsetsOK
and Assigned(_Data[i].SubInfo)
Then Begin
_Data[i].SubInfo.CheckOffsets(True);
_OffsetsOK := _OffsetsOK
and _Data[i].SubInfo._OffsetsOK;
End;
If not Intern
and not _OffsetsOK
Then CalcOffsets;
End;
Procedure TXMLSerializeRecordInfo.CalcOffsets;
Const DSize:
Array[TXMLSerializeRDataType]
of Byte = (
1, 2, 4, SizeOf(Boolean), SizeOf(BOOL), 1, 2, 4, 8, 8, SizeOf(rtCardinal),
1, 2, 4, 8, 8, SizeOf(Integer), 4, 8, 10, SizeOf(Real), 8, 8, 0, 0, 0, SizeOf(Pointer),
0, SizeOf(Pointer), SizeOf(Pointer), SizeOf(Pointer), SizeOf(Pointer),
0, SizeOf(Pointer), SizeOf(Variant), SizeOf(TObject), 0, 0, SizeOf(Pointer), 0, 0, 0);
Var Split, i, i2, i3: Integer;
Begin
_OffsetsOK := False;
_Size := 0;
_ElementSize := 0;
Split := MaxInt;
For i := 0
to High(_Data)
do Begin
If Assigned(_Data[i].SubInfo)
Then _Data[i].SubInfo.CalcOffsets;
Case _Data[i].DType
of
rtByteBool, rtWordBool, rtLongBool, rtBoolean, rtBOOL,
rtByte, rtWord, rtLongWord, rtWord64, rtWord64LE, rtCardinal,
rtShortInt, rtSmallInt, rtLongInt, rtInt64, rtInt64LE, rtInteger,
rtSingle, rtDouble, rtExtended, rtReal, rtCurrency, rtDateTime,
rtUtf8String, rtAnsiString, rtWideString, rtUnicodeString, rtString,
rtPointer, rtVariant, rtObject, rtDynArray:
Begin
i2 := DSize[_Data[i].DType];
If i2 > _Align
Then i2 := _Align;
If i2 > Split
Then i2 := Split;
Inc(_Size, (i2 - _Size
mod i2)
mod i2);
_Data[i].Offset := _Size;
_Data[i].Size := DSize[_Data[i].DType];
_Data[i].ElementSize := _Data[i].Size;
Inc(_Size, _Data[i].Size);
Split := MaxInt;
End;
rtAnsiCharArray,
{$If SizeOf(Char) = 1} rtCharArray,
{$IFEND}
rtShortString, rtBinary, rtDummy:
Begin
_Data[i].Offset := _Size;
_Data[i].Size := _Data[i].Elements;
_Data[i].ElementSize := 1;
If _Data[i].DType = rtShortString
Then Inc(_Data[i].Size);
Inc(_Size, _Data[i].Size);
Split := MaxInt;
End;
rtWideCharArray
{$If SizeOf(Char) = 2}, rtCharArray
{$IFEND}:
Begin
i2 := 2;
If i2 > _Align
Then i2 := _Align;
If i2 > Split
Then i2 := Split;
Inc(_Size, (i2 - _Size
mod i2)
mod i2);
_Data[i].Offset := _Size;
_Data[i].Size := _Data[i].Elements * 2;
_Data[i].ElementSize := 2;
Inc(_Size, _Data[i].Size);
Split := MaxInt;
End;
rtRecord, rtArray:
Begin
If _Data[i].ElementSize >= 0
Then Begin
i2 := _Data[i].ElementSize;
End Else Begin
i2 := 0;
With _Data[i].SubInfo
do
For i3 := 0
to High(
{_Data[i].SubInfo.}_Data)
do
If {_Data[i].SubInfo.}_Data[i3].ElementSize > i2
Then
i2 :=
{_Data[i].SubInfo.}_Data[i3].ElementSize;
End;
If i2 > 0
Then Begin
If i2 > _Align
Then i2 := _Align;
If i2 > Split
Then i2 := Split;
Inc(_Size, (i2 - _Size
mod i2)
mod i2);
End;
_Data[i].Offset := _Size;
_Data[i].Size := _Data[i].SubInfo._Size;
_Data[i].ElementSize := _Data[i].Size;
Inc(_Size, _Data[i].Size);
Split := MaxInt;
End;
rtAlign:
Begin
i2 := _Data[i].Elements;
If i2 > _Align
Then i2 := _Align;
If i2 > Split
Then i2 := Split;
Inc(_Size, (i2 - _Size
mod i2)
mod i2);
_Data[i].Offset := _Size;
_Data[i].Size := 0;
_Data[i].ElementSize := 0;
Split := MaxInt;
End;
rtSplit:
Begin
_Data[i].Offset := _Size;
_Data[i].Size := 0;
_Data[i].ElementSize := 0;
Split := _Data[i].Elements;
End;
End;
If _Data[i].ElementSize <> 0
Then
If _ElementSize = 0
Then _ElementSize := _Data[i].ElementSize
Else If _ElementSize <> _Data[i].ElementSize
Then _ElementSize := -1;
End;
If _ElementSize > 0
Then Inc(_Size, (4 - _Size
mod 4)
mod 4);
_OffsetsOK := True;
End;
Function TXMLSerializeRecordInfo.GetCount: Integer;
{inline}
Begin
Result := Length(_Data);
End;
Function TXMLSerializeRecordInfo.GetFullOffset(
Index: Integer): Integer;
Begin
CheckOffsets;
If (
Index >= 0)
and (
Index < Length(_Data))
Then Begin
Result := _Data[
Index].Offset;
If Assigned(_Parent)
Then Inc(Result, _Parent.FullOffset[_Parent.IndexOf(Self)]);
End Else Result := -1;
End;
Function TXMLSerializeRecordInfo.GetOffset(
Index: Integer): Integer;
{inline}
Begin
CheckOffsets;
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result := -1
Else Result := _Data[
Index].Offset;
End;
Function TXMLSerializeRecordInfo.GetSize(
Index: Integer): Integer;
{inline}
Begin
CheckOffsets;
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result := -1
Else Result := _Data[
Index].Size;
End;
Function TXMLSerializeRecordInfo.GetName(
Index: Integer):
String;
{inline}
Begin
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result := '
'
Else Result :=
String(_Data[
Index].
Name);
End;
Function TXMLSerializeRecordInfo.GetDType(
Index: Integer): TXMLSerializeRDataType;
{inline}
Begin
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result := Pred(Low(TXMLSerializeRDataType))
Else Result := _Data[
Index].DType;
End;
Function TXMLSerializeRecordInfo.GetElements(
Index: Integer): Integer;
{inline}
Begin
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result := -1
Else Result := _Data[
Index].Elements;
End;
Function TXMLSerializeRecordInfo.GetSubInfo(
Index: Integer): TXMLSerializeRecordInfo;
{inline}
Begin
If (
Index < 0)
or (
Index >= Length(_Data))
Then Result :=
nil
Else Result := _Data[
Index].SubInfo;
End;
Procedure TXMLSerializeRecordInfo.Set_ObjectOpt(Source: TXMLSerializeRecordInfo);
Var i: Integer;
Begin
_SOptions := Source._SOptions;
_SerProc := Source._SerProc;
_DeSerProc := Source._DeSerProc;
_CreateProc := Source._CreateProc;
If Assigned(_Parent)
and (_Parent <> Self)
Then
_Parent.Set_ObjectOpt(Self);
For i := 0
to High(_Data)
do
If Assigned(_Data[i].SubInfo)
and (_Data[i].SubInfo <> Self)
Then
_Data[i].SubInfo.Set_ObjectOpt(Self);
End;
Procedure TXMLSerializeRecordInfo.SetSOptions(Value: TXMLSerializeOptions);
{inline}
Begin
_SOptions := Value + [xsSaveClassType];
Set_ObjectOpt(Self);
End;
Procedure TXMLSerializeRecordInfo.SetSerProc(Value: TXMLSerializeProc);
{inline}
Begin
_SerProc := Value;
Set_ObjectOpt(Self);
End;
Procedure TXMLSerializeRecordInfo.SetDeSerProc(Value: TXMLDeserializeProc);
{inline}
Begin
_DeSerProc := Value;
Set_ObjectOpt(Self);
End;
Procedure TXMLSerializeRecordInfo.SetCreateProc(Value: TXMLClassCreateProc);
{inline}
Begin
_CreateProc := Value;
Set_ObjectOpt(Self);
End;
Constructor TXMLSerializeRecordInfo.Create;
Var X: TSearchRec;
Begin
Inherited;
_Align := Integer(@X.Size) - Integer(@X.Time);
_SOptions := [xsSaveClassType];
End;
Destructor TXMLSerializeRecordInfo.Destroy;
Begin
Clear;
Inherited;
End;
Procedure TXMLSerializeRecordInfo.SetAlign(Align: LongInt = 4);
{inline}
Begin
_OffsetsOK := False;
If Align = 0
Then Align := 1;
If Align
in [1, 2, 4, 8, 16]
Then _Align := Align;
End;
Function TXMLSerializeRecordInfo.Add(
Name:
String; DType: TXMLSerializeRDataType; Elements: Integer = 1): TXMLSerializeRecordInfo;
Var i: Integer;
Begin
_OffsetsOK := False;
i := Length(_Data);
Name := Trim(
Name);
If (
Name = '
')
and not (DType
in [rtAlign, rtSplit])
Then Name := Format('
rec:%d', [i]);
If (
Name <> '
')
and not TXHelper.CheckString(
Name, xtElement_NodeName)
and (IndexOf(
Name) >= 0)
Then
Raise EXMLException.Create(ClassType, '
Add', @SInvalidValue,
Name);
If (DType > High(TXMLSerializeRDataType))
or ((DType
in [rtAnsiCharArray, rtWideCharArray, rtCharArray, rtShortString,
rtBinary, rtPointer, rtArray, rtDynArray, rtDummy])
and (Elements < 0))
or ((DType
in [rtAlign, rtSplit])
and not (Elements
in [1, 2, 4, 8, 16]))
Then
Raise EXMLException.Create(ClassType, '
Add', @SInvalidValueN);
SetLength(_Data, i + 1);
_Data[i].
Name := TWideString(
Name);
_Data[i].DType := DType;
If DType
in [rtAnsiCharArray, rtWideCharArray, rtCharArray, rtShortString,
rtBinary, rtPointer, rtArray, rtDynArray, rtDummy, rtAlign, rtSplit]
Then
_Data[i].Elements := Elements
Else _Data[i].Elements := 0;
_Data[i].SubInfo :=
nil;
If DType
in [rtRecord, rtArray, rtDynArray]
Then Begin
_Data[i].SubInfo := TXMLSerializeRecordInfo.Create;
_Data[i].SubInfo._Parent := Self;
_Data[i].SubInfo._Align := _Align;
_Data[i].SubInfo._SOptions := _SOptions;
_Data[i].SubInfo._SerProc := _SerProc;
_Data[i].SubInfo._DeSerProc := _DeSerProc;
_Data[i].SubInfo._CreateProc := _CreateProc;
End;
Result := _Data[i].SubInfo;
End;
Function TXMLSerializeRecordInfo.IndexOf(
Const Name:
String): Integer;
Begin
Result := High(_Data);
While (Result >= 0)
and not TXHelper.MatchText(
Name, _Data[Result].
Name, False)
do Dec(Result);
End;
Function TXMLSerializeRecordInfo.IndexOf(RecordInfo: TXMLSerializeRecordInfo): Integer;
Begin
Result := High(_Data);
While (Result >= 0)
and (
not Assigned(RecordInfo)
or (RecordInfo <> _Data[Result].SubInfo))
do Dec(Result);
End;
Procedure TXMLSerializeRecordInfo.Assign(RecordInfo: TXMLSerializeRecordInfo);
Var i: Integer;
Begin
Clear;
SetAlign(RecordInfo.Align);
For i := 0
to RecordInfo.Count
do Begin
Add(RecordInfo.
Name[i], RecordInfo.DType[i], RecordInfo.Elements[i]);
If Assigned(RecordInfo.SubInfo[i])
Then SubInfo[i].Assign(RecordInfo.SubInfo[i]);
End;
End;
Procedure TXMLSerializeRecordInfo.Parse(
Const S:
String);
Var C: Char;
S2:
String;
i, i2, i3, i4: Integer;
Begin
i := 1;
While i <= Length(S)
do
Case S[i]
of
#9, '
': Inc(i);
'
(', '
[', '
{':
Begin
Case S[i]
of
'
(': C := '
)';
'
[': C := '
]';
Else C := '
}';
End;
i3 := 0;
i2 := i;
Repeat
If S[i2] = S[i]
Then Inc(i3);
If S[i2] = C
Then Dec(i3);
Inc(i2);
Until (i3 = 0)
or (i2 > Length(S));
If (i3 <> 0)
or not Assigned(_Data)
or not Assigned(_Data[High(_Data)].SubInfo)
Then
Raise EXMLException.Create(ClassType, '
Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
_Data[High(_Data)].SubInfo.Parse(Copy(S, i + 1, i2 - i - 2));
i := i2;
End;
'
L', '
l':
If (i < Length(S))
and ((S[i + 1] = '
1')
or (S[i + 1] = '
2')
or (S[i + 1] = '
4')
or (S[i + 1] = '
8'))
Then Begin
SetAlign(Ord(S[i + 1]) - Ord('
0'));
Inc(i, 2);
End Else Raise EXMLException.Create(ClassType, '
Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
Else Begin
i2 := 0;
Repeat
If (Char(Ord(S[i])
or $20) = SerializeTypes[i2].Key)
and ((SerializeTypes[i2].Size = #0)
or
((i < Length(S))
and (Char(Ord(S[i + 1])
or $20) = SerializeTypes[i2].Size)))
Then Begin
Inc(i);
If SerializeTypes[i2].Size <> #0
Then Inc(i);
If SerializeTypes[i2].Elements
Then Begin
i3 := 0;
While (i3 < $0CCCCCCC)
and (i <= Length(S))
and (S[i] >= '
0')
and (S[i] <= '
9')
do Begin
i3 := i3 * 10 + (Ord(S[i]) - Ord('
0'));
Inc(i);
End;
End Else i3 := 1;
S2 := '
';
If (i < Length(S))
and (S[i] = '
"')
Then Begin
i4 := i + 1;
While (i4 < Length(S))
and (S[i4] <> '
"')
do Inc(i4);
If S[i4] <> '
"'
Then
Raise EXMLException.Create(ClassType, '
Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
S2 := Copy(S, i + 1, i4 - i - 1);
i := i4 + 1;
End Else If (i < Length(S))
and ((S[i] = '
>')
or (S[i] = '
='))
Then Begin
i4 := i + 1;
While (i4 <= Length(S))
and (S[i4] <> '
')
and (S[i4] <> #9)
do Inc(i4);
S2 := Copy(S, i + 1, i4 - i);
i := i4;
End;
Add(S2, SerializeTypes[i2].Typ, i3);
Break;
End;
Inc(i2);
Until i2 > High(SerializeTypes);
If i2 > High(SerializeTypes)
Then
Raise EXMLException.Create(ClassType, '
Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
End;
End;
End;
Function TXMLSerializeRecordInfo.GetString(DFormat: TXMLSerializeTextFormat = sfFormat1):
String;
Function Convert(InfoRec: TXMLSerializeRecordInfo; InsertAlign: Boolean = False):
String;
Var i, i2: Integer;
Begin
Result := '
';
If InsertAlign
or not Assigned(_Parent)
or (_Align <> _Parent._Align)
Then
Result := Format('
%sp%d', [Result, _Align]);
For i := 0
to High(_Data)
do Begin
For i2 := 0
to High(SerializeTypes)
do
If _Data[i].DType = SerializeTypes[i2].Typ
Then Begin
Result := Format('
%s%s', [Result, SerializeTypes[i2].Key]);
If SerializeTypes[i2].Size <> #0
Then
Result := Format('
%s%s', [Result, SerializeTypes[i2].Size]);
If SerializeTypes[i2].Elements
Then
Result := Format('
%s%d', [Result, _Data[i].Elements]);
If _Data[i].
Name <> '
'
Then Begin
Case DFormat
of
sfShort: ;
sfFormat1: Result := Format('
%s"%s"', [Result, _Data[i].
Name]);
sfFormat2: Result := Format('
%s"%s" ', [Result, _Data[i].
Name]);
sfFormat3: Result := Format('
%s>%s ', [Result, _Data[i].
Name]);
sfFormat4: Result := Format('
%s=%s ', [Result, _Data[i].
Name]);
End;
End Else If DFormat >= sfFormat2
Then Result := Result + '
';
Break;
End;
If Assigned(_Data[i].SubInfo)
Then Begin
If DFormat >= sfFormat2
Then Result := Result + '
( '
Else Result := Result + '
(';
Result := Result + Convert(_Data[i].SubInfo);
If DFormat >= sfFormat2
Then Result := Result + '
) '
Else Result := Result + '
)';
End;
End;
End;
Begin
Result := Trim(Convert(Self, True));
End;
Procedure TXMLSerializeRecordInfo.Clear;
Var i: Integer;
Begin
_OffsetsOK := False;
For i := High(_Data)
downto 0
do _Data[i].SubInfo.Free;
_Data :=
nil;
End;