Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Speicherausrichtung (Align) berechnen (https://www.delphipraxis.net/143800-speicherausrichtung-align-berechnen.html)

himitsu 23. Nov 2009 21:58
Speicherausrichtung (Align) berechnen
 
Ich dreh bald noch durch ... wie um Himmels Willen macht Delphi das nur? :wall:

Also wie entscheidet Delphi wann es wie ausrichtet?

Hier mal ein kleiner Test:
TY und TZ sind gleich groß, aber dennnoch ist es anders.
Delphi-Quellcode:
Type
{$ALIGN 1}
  TYb1 = Record x: byte; y: integer; End;
{$ALIGN 4}
  TYb = Record x: byte; y: integer; End;
  TZb = Record x: array[0..7] of Byte; End;
  TX = Record
    a: Byte;
    b: Int64;
  End;
  TY1 = Record
    a: Byte;
    b: TYb1;
  End;
  TY = Record
    a: Byte;
    b: TYb;
  End;
  TZ = Record
    a: Byte;
    b: TZb;
  End;

Var X: TX;
  Y: TY;
  Y1: TY1;
  Z: TZ;
  i, j, k,l: Integer;

Begin
  i := Integer(@X.b) - Integer(@X.a);
  j := Integer(@Y.b) - Integer(@Y.a);
  l := Integer(@Y1.b) - Integer(@Y1.a);
  k := Integer(@Z.b) - Integer(@Z.a);
  ShowMessage(Format('X.a-Xb: %d  X: %d'#10
    + 'Y.a-Yb: %d  Y: %d  TY: %d'#10
    + 'Z.a-Zb: %d  Z: %d  TZ: %d'#10
    + 'Y1.a-Y1b: %d  Y1: %d  TY1: %d'#10,
    [i, SizeOf(TX),
     j, SizeOf(TY), SizeOf(TYb),
     k, SizeOf(TZ), SizeOf(TZb),
     l, SizeOf(TY1), SizeOf(TYb1)]));

Code:
---------------------------
Test
---------------------------
X.a-Xb: 4   X: 12
Y.a-Yb: 4   Y: 12   TY: 8
Z.a-Zb: 1   Z: 9   TZ: 8
Y1.a-Y1b: 1   Y1: 6   TY1: 5

---------------------------
OK  
---------------------------
Im Packed-Modus läuft meine Record-Serialisierung, aber mit der automatischen Ausrichtung will es einfach nicht klappen. :cry:

Uwe Raabe 24. Nov 2009 10:03
Re: Speicherausrichtung (Align) berechnen
 
So ganz bin ich noch nicht dahintergekommen. Kannst du das Problem etwas genauer schildern?

Ich sehe zwar was du tust, aber ich weiß nicht was du erwartest und was stattdessen herauskommt.

himitsu 24. Nov 2009 10:21
Re: Speicherausrichtung (Align) berechnen
 
Ich hab in meinem himXML einige Datenserialisierungen implementiert,
womit man praktisch Record-Inhalte in eine entsprechende XML-Stucktur umwandeln kann.

Und nun suche ich, da sich meine bisherige Rechnung als "etwas falsch" herausstellte,
eine Möglichkeit das Alignment zu berechnen.
Also so, daß mein Code selbstständig die Ausrichtung bestimmen/berechnen kann.

gegeben seien z.B. diese Typen:
Delphi-Quellcode:
type
  TFileName = type String;
  THandle = LongWord;
  TWin32FindData = record
    dwFileAttributes:  DWORD;
    ftCreationTime:    TFileTime;
    ftLastAccessTime:  TFileTime;
    ftLastWriteTime:   TFileTime;
    nFileSizeHigh:     DWORD;
    nFileSizeLow:      DWORD;
    dwReserved0:       DWORD;
    dwReserved1:       DWORD;
    cFileName:         array[0..259] of Char;
    cAlternateFileName: array[0..13] of Char;
  end;

  TSearchRec = record
    Time:       Integer;
    Size:       Int64;
    Attr:       Integer;
    Name:       TFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData:   TWin32FindData;
  end;
Diese sind nicht gepackt und werden entsprechend ab Delphi 2009 mit einem {$ALIGN 8} ausgerichtet.

Nun würde man meinem Serialisierer den Aufbau der Structur mitteilen und dieser würde (theoretisch) im vorliegenden Fall die übergebenen Daten-Adressen noch ausrichten und dann die Inhalte in der Datei speichern.
Delphi-Quellcode:
Var Data: TSearchRec;
  XML:  TXMLFile;
  RI, RIx: TXMLSerializeRecordInfo;

// einfach nur den Record mit irgendetwas befüllen
FindFirst(Application.ExeName, faAnyFile, Data);
FindClose(Data);

XML := TXMLFile.Create;
Try

  RI := TXMLSerializeRecordInfo.Create;
  Try
    //RI.Align(4);
    RI.Add('Time',   rtInteger);
    RI.Add('Size',   rtInt64);
    RI.Add('Attr',   rtInteger);
    RI.Add('Name',   rtString);
    RI.Add('Exclude', rtInteger);
    RI.Add('Handle', rtLongWord);
    RIx := RI.Add('Data', rtRecord);
    //RIx.Align(4);
    RIx.Add('Attributes', rtLongWord);
    RIx.Add('Creation',  rtWord64);
    RIx.Add('LastAccess', rtWord64);
    RIx.Add('LastWrite', rtWord64);
    RIx.Add('FileSize',  rtInt64);
    RIx.Add('Reserved',  rtInt64);
    RIx.Add('FileName',  rtCharArray, 260);
    RIx.Add('Alternate', rtCharArray, 14);
    XML.AddNode('via_Add').Serialize(Data, RI);
  Finally
    RI.Free;
  End;

  RI := TXMLSerializeRecordInfo.Create;
  Try
    //RI.Parse('I I8 I S I W4 R ( W4 W8 W8 W8 I8 I8 C260 C14 )');
    RI.Parse('ii8isiw4r(w4w8w8w8i8i8c260c14)');
    XML.AddNode('short').Serialize(Data, RI);
    RI.Clear;

    RI.Parse('I"Time" I8"Size" I"Attr" S"Name" I"Exclude" W4"Handle" R"Data" ('
      + 'W4"Attributes" W8"Creation" W8"LastAccess" W8"LastWrite" I8"FileSize"'
      + 'I8"Reserved" C260"FileName" C14"Alternate" )');
    XML.AddNode('long').Serialize(Data, RI);
  Finally
    RI.Free;
  End;

  XML.SaveToFile('Test.xml');
Finally
  XML.Free;
End;
Entstehen würde jetzt sowas:
XML-Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml>
  <via_Add>
    <Time himxml:type="LongInt">997743401</Time>
    <Size himxml:type="Int64">939520</Size>
    <Attr himxml:type="LongInt">8224</Attr>
    <Name himxml:type="WideString"/>
    <Exclude himxml:type="LongInt">8224</Exclude>
    <Handle himxml:type="LongWord">30042434</Handle>
    <Data himxml:type="Record">
      <Attributes himxml:type="LongWord">30043376</Attributes>
      <Creation himxml:type="Word64">30043376</Creation>
      <LastAccess himxml:type="Word64">939520</LastAccess>
      <LastWrite himxml:type="Word64">28429333425029120</LastWrite>
      <FileSize himxml:type="Int64">28429170223874163</FileSize>
      <Reserved himxml:type="Int64">6619256</Reserved>
      <FileName himxml:type="WideCharArray"/>
      <Alternate himxml:type="WideCharArray"/>
    </Data>
  </via_Add>
  <short>
    <rec:r0 himxml:type="LongInt">997743401</rec:r0>
    <rec:r1 himxml:type="Int64">939520</rec:r1>
    <rec:r2 himxml:type="LongInt">8224</rec:r2>
    <rec:r3 himxml:type="WideString"/>
    <rec:r4 himxml:type="LongInt">8224</rec:r4>
    <rec:r5 himxml:type="LongWord">30042434</rec:r5>
    <rec:r6 himxml:type="Record">
      <rec:r0 himxml:type="LongWord">30043376</rec:r0>
      <rec:r1 himxml:type="Word64">30043376</rec:r1>
      <rec:r2 himxml:type="Word64">939520</rec:r2>
      <rec:r3 himxml:type="Word64">28429333425029120</rec:r3>
      <rec:r4 himxml:type="Int64">28429170223874163</rec:r4>
      <rec:r5 himxml:type="Int64">6619256</rec:r5>
      <rec:r6 himxml:type="WideCharArray"/>
      <rec:r7 himxml:type="WideCharArray"/>
    </rec:r6>
  </short>
  <long>
    <Time himxml:type="LongInt">997743401</Time>
    <Size himxml:type="Int64">939520</Size>
    <Attr himxml:type="LongInt">8224</Attr>
    <Name himxml:type="WideString"/>
    <Exclude himxml:type="LongInt">8224</Exclude>
    <Handle himxml:type="LongWord">30042434</Handle>
    <Data himxml:type="Record">
      <Attributes himxml:type="LongWord">30043376</Attributes>
      <Creation himxml:type="Word64">30043376</Creation>
      <LastAccess himxml:type="Word64">939520</LastAccess>
      <LastWrite himxml:type="Word64">28429333425029120</LastWrite>
      <FileSize himxml:type="Int64">28429170223874163</FileSize>
      <Reserved himxml:type="Int64">6619256</Reserved>
      <FileName himxml:type="WideCharArray"/>
      <Alternate himxml:type="WideCharArray"/>
    </Data>
  </long>
</xml>
nur leider sind meine errechneten Adressen falsch, weswegen die Inhalte natürlich nicht stimmen :cry:


Tja und nun suche ich nach einer korrekten Berechnung, welches für einfache Daten theoretisch garnicht soschwer ist, aber schon im vorliegenden Fall taucht da ein Problem auf, wenn die untergeordneten Records (siehe Post #1) werden unterschiedlich ausgerichtet und gefür fehlt mir die zündende Idee, also nach welchen Regeln dieses nun alles abläuft.

Uwe Raabe 24. Nov 2009 14:51
Re: Speicherausrichtung (Align) berechnen
 
Ah ja, hätte mich bei dir auch gewundert, wenn die Frage so leicht zu beantworten wäre.

Ich denke mal, das Problem liegt darin, daß nur der Compiler weiß, wie die Records wirklich aligned sind - und das kann sich ja im Source an jeder Stelle ändern.

Spontan fällt mir folgende Lösung ein: Du übergibst bei TXMLSerializeRecordInfo.Create eine Record-Instanz als Parameter und bei jedem Add einen Pointer auf das jeweilige Feld. Dann kanst du die Offsets direkt berechnen. Nebenbei kann dann auch die Reihenfolge beliebig sein und es können Felder weggelassen werden.

Delphi-Quellcode:
 
RI := TXMLSerializeRecordInfo.Create(Data);
Try
  RI.Add('Time',   rtInteger, Data.Time);
  RI.Add('Size',   rtInt64, Data.Size);
  RI.Add('Attr',   rtInteger, Data.Attr);
  RI.Add('Name',   rtString, Data.Name);
...
Oder man steigt gleich auf D2010 um und benutzt RTTI :zwinker:

himitsu 24. Nov 2009 15:03
Re: Speicherausrichtung (Align) berechnen
 
Bei einer Typendefinition geht der Compiler erstmal davon aus, daß der Anfang des Records ausgerichtet ist und alles andere wird dann nach gewissen Regeln und Anhand von {$ALIGN *} und {$A*} ausgerichtet ... tja und genau diese Regeln bräuchte ich.

Hab jetzt erstmal 'nen ganzen Browser voller Tabs und versuch die ganzen Informationen irgendwie zusammenzubekommen, bzw. mir daraus 'nen Satz (Rechen)Regeln zu erstellen, aber für das Beispiel aus Post #1 hab ich noch nichts gefunden :?


Joar, was die neue 2010er RTTI betrifft, da muß ich irgendwann mal sehn, ob sich damit was machen läßt, aber vorallem für ältere Delphis ist das eh nicht möglich.

Nja, und mit den Pointern wollte ich nicht unbedingt rumspielen, kommt mir auch etwas umständlich vor.
(abgesehn davon kann man so auch "virtuelle" Records füllen :angel: )

brechi 24. Nov 2009 17:47
Re: Speicherausrichtung (Align) berechnen
 
Ich hätte Code da, kann dir den aber leider so net rausgeben.
Problem ist auch dass z.B. die Daten verschachtelt sein können (z.b. packed record mit weiterem aligned 4 record usw.)
Ich hab das genau für einen virtuellen Record gemacht.

Vielleicht kann ich dir morgen bisl Code dazugeben, aber eigentlich solltest das leicht selbst rausbekommen:

z.B. 4 Bytes groß:
Delphi-Quellcode:
{$A4}
type x = record
  a: byte; //@0
  b: byte; //@1
  c: word; //@2
end;
z.B: 6 Bytes groß
Delphi-Quellcode:
{$A4}
type x = record
  a: byte; //@0
  c: word; //@2
  b: byte; //@4
end;
(bytes können z.b. bei 0,1,2,3 startet, words nur bei 0,2,4 dwords bei 0,4,8)

dann ist der größte Datentyp wichtig (also ob byte, word oder dword) verwendet wird, denn der größte verwendete Datentyp bestimmt die absolute Größe des Records falls, dieser kleiner als das im Delphi eingestellte alignment ist.

heißt:

Delphi-Quellcode:
{$A4}
type x = record
  a: byte; //@0
  c: word; //@2
  b: byte; //@4
end;
größte = word = 2 (obwohl alignment 4) d.h. record Größe muss mod 2 = 0 sein -> 6 bytes Gesamt statt 5


Delphi-Quellcode:
{$A4}
type x = record
  a: byte; //@0
  c: dword; //@4
  b: byte; //@8
end;
größte = dword = 4, align = 4 -> 12 bytes Gesamt


Hoffe das hilft erstmal, ein string = pointer, ein string[xx] ist wie nen array of char (d.h. einzelne Bytes)
records in records sind wiedrum an ihrem alignment ausgerichtet (bzw. dem größten Datentyp falls dieser kleiner ist)

himitsu 24. Nov 2009 18:27
Re: Speicherausrichtung (Align) berechnen
 
Also zumindestens weiß ich jetzt, daß ich die untergeordneten Arrays/Records zuerst berechnen muß
und dann scheint es so, als wenn je nach Aufbau dieses untergeordnete Array anders im übergeordneten plaziert wird.

Delphi-Quellcode:
{$align 4}

1: record
  a: Byte;
  {3x Byte align}
  b: LongWord;
end;

2: record
  a: Byte;
  {kein align}
  b: array[0..3] of Byte;
end;

3: record
  a: Byte;
  {nun ratet mal}
  b: trec;
end;

trec: record
  case byte of
    0: (c: LongWord);
    1: (d: array[0..3] of Byte);
end;
Zitat:
Problem ist auch dass z.B. die Daten verschachtelt sein können
Joar, deswegen ist in der Struktur auch für jeden Bereich/Record eine eigene Align-Definition vorgesen (von 1=packed über 2, 4 bis 8)

thkerkmann 24. Nov 2009 19:23
Re: Speicherausrichtung (Align) berechnen
 
Hi,

schiesst Du nicht mit dieser Art der Serialisierung über das Ziel hinaus ?
Du analysierst ja bereits "händisch" den Record, um ihn dann wieder gepackt in die Struktur zu bringen.

Dann kann ich doch gleich einzeln die Elemente des Records serialisieren.

Oder hab ich da was falsch verstanden :?:

himitsu 24. Nov 2009 20:01
Re: Speicherausrichtung (Align) berechnen
 
nja, theoretisch kannst du den Record auch selber Element für Element abspeichern.

so bräuchtest du aber nur einmal den Aufbau definieren
(mal sehn, ab Delphi 2010 kannst dir eventuell auch von der neuen RTTI den Aufbau geben lassen)
und kannst diesen für die Serialisierung UND auch gleich für die Deserialisierung und auch an mehreren Stellen verwenden.

oder gleich die kurze Variante über'n Parser
Delphi-Quellcode:
RI.Parse('ii8isiw4r(w4w8w8w8i8i8c260c14)');
XML.AddNode('data').Serialize(Data, RI);
und schon hast du mit nur 2 Zeilen den Demo-Record mit 16 Werten gespeichert.

Delphi-Quellcode:
TXMLSerializeRDataType = (
  rtBoolean, rtBOOL, rtByte, rtWord, rtLongWord, rtWord64, {rtCardinal,}
  rtShortInt, rtSmallInt, rtLongInt, rtInt64, {rtInteger,}
  rtSingle, rtDouble, rtExtended, {rtReal,} rtCurrency, rtDateTime,
  rtAnsiCharArray, rtWideCharArray, {rtCharArray,}
  rtShortString, rtAnsiString, rtWideString, rtUnicodeString, {rtString,}
  rtBinary, rtVariant, rtObject, rtRecord, rtArray, rtDynArray,
  rtDummy, rtAlign, rtResetAlign);
von den Serialisierungen lassen sich ganze Variants, Objekte und Records/Arrays speichern
und vorallen bei den Records und Variants sind die ganzen Binär<>Text-Konvertierungen alle schon enthalten.

Vor 'ner Weile hatte ich dieses auch mal mißbraucht
Delphi-Quellcode:
Uses Dialogs, himXML__DataConv;

Var Src: packed Record
           B: Byte;
           i: Integer;
           S: String;
         End;
  Dest: packed Record
           S: String;
           i: Integer;
           W: Word;
         End;

Begin
  Src.B := 123;
  Src.i := 987654321;
  Src.S := 'Test';
  DataConverter(Src, Dest, 'p1 w1>B i>I s>S', 'p1 s>S i>I w2>W');
  ShowMessage(Format('"%s"  %d', [Dest.S, Dest.i]));
End;
Und mir 'nen Record-Converter gebastelt, da ich 'ne Binärdatei umstellen mußte.

himitsu 25. Nov 2009 21:24
Re: Speicherausrichtung (Align) berechnen
 
Die bißher "besten" Informationen hab ich nun erstmal hier gefunden:
http://en.wikipedia.org/wiki/Data_structure_alignment
http://msdn.microsoft.com/en-us/libr...8VS.71%29.aspx

Schlimm wird es aber bei sowas:
Delphi-Quellcode:
// align = 2, 4 oder 8

Type
  T1 = Record
    A: Array[0..1] of Byte;
    B: Byte;
  End;
  T2 = Record
    A: Word;
    B: Byte;
  End;
Die beiden Records sind (packed) 3 Byte groß, werden aber anders behandelt.

SizeOf(T1) = 3
SizeOf(T2) = 4

Und als SubRecords oder in Arrays wird T2 an 2er-Grenzen ausgerichter, aber T1 natürlich nicht.


Ich bekomme zwar langsam so Einiges zusammen, aber auch nur durch ausprobieren

hatte sogar mal vor lauter Wahnsinn 'ne größere Testreihe gemacht ... nur um ganz ganz ganz sicher zu gehn :wall:
Delphi-Quellcode:
{$ALIGN x}
Type TA = Record
    B: Array[1..y] of Byte;
    C: z;
  End;
Type TD = Record
    B: Array[1..Y] of Byte;
    C: z;
    D: Byte;
  End;
Code:
x = align
y = 1..7
z = 1:Byte 2:Word 4:LongWord 8:Int64 10:Extended

// > size  (C)
// V offset (B)
//
// Integer(@A.C) - Integer(@A.B)
//     align 1           align 2           align 4           align 8
//     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10
// 1   1  1  1  1  1     1  2  2  2  2     1  2  4  4  4     1  2  4  8  8
// 2   2  2  2  2  2     2  2  2  2  2     2  2  4  4  4     2  2  4  8  8
// 3   3  3  3  3  3     3  4  4  4  4     3  4  4  4  4     3  4  4  8  8
// 4   4  4  4  4  4     4  4  4  4  4     4  4  4  4  4     4  4  4  8  8
// 5   5  5  5  5  5     5  6  6  6  6     5  6  8  8  8     5  6  8  8  8
// 6   6  6  6  6  6     6  6  6  6  6     6  6  8  8  8     6  6  8  8  8
// 7   7  7  7  7  7     7  8  8  8  8     7  8  8  8  8     7  8  8  8  8
//
// SizeOf(TA)
//     align 1           align 2           align 4           align 8
//     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10
// 1   2  3  5  9 11     2  4  6 10 12     2  4  8 12 16     2  4  8 16 24
// 2   3  4  6 10 12     3  4  6 10 12     3  4  8 12 16     3  4  8 16 24
// 3   4  5  7 11 13     4  6  8 12 14     4  6  8 12 16     4  6  8 16 24
// 4   5  6  8 12 14     5  6  8 12 14     5  6  8 12 16     5  6  8 16 24
// 5   6  7  9 13 15     6  8 10 14 16     6  8 12 16 20     6  8 12 16 24
// 6   7  8 10 14 16     7  8 10 14 16     7  8 12 16 20     7  8 12 16 24
// 7   8  9 11 15 17     8 10 12 16 18     8 10 12 16 20     8 10 12 16 24
//
// SizeOf(TD)
//     align 1           align 2           align 4           align 8
//     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10     1  2  4  8 10
// 1   3  4  6 10 12     3  6  8 12 14     3  6 12 16 16     3  6 12 24 24
// 2   4  5  7 11 13     4  6  8 12 14     4  6 12 16 16     4  6 12 24 24
// 3   5  6  8 12 14     5  8 10 14 16     5  8 12 16 16     5  8 12 24 24
// 4   6  7  9 13 15     6  8 10 14 16     6  8 12 16 16     6  8 12 24 24
// 5   7  8 10 14 16     7 10 12 16 18     7 10 16 20 20     7 10 16 24 24
// 6   8  9 11 15 17     8 10 12 16 18     8 10 16 20 20     8 10 16 24 24
// 7   9 10 12 16 18     9 12 14 18 20     9 12 16 20 20     9 12 16 24 24
und nun probiere ich verschiedene Record/Array-Kombinationen :?

Hawkeye219 25. Nov 2009 21:54
Re: Speicherausrichtung (Align) berechnen
 
Hallo himitsu,

Rudy Velthuis hat für seine "Delphi Corner" einen Artikel verfasst, in dem es unter anderem um das Thema Records and alignment geht. Ich möchte dich jetzt nicht entmutigen, aber es wird sehr interessant, wenn man einen gepackten Record in einen nicht gepackten Record einbaut...

Gruß Hawkeye

himitsu 25. Nov 2009 22:08
Re: Speicherausrichtung (Align) berechnen
 
Daß es nicht so leicht ist, wie anfangs gelaubt, ist mir inzwischen klar,
aber jetzt steckt da schon soviel Arbeit drinnen, daß ich keine Lust hab aufzugeben
und das alles wieder rauszulöschen, oder Dergleichen. :?

Hab nun auch angefangen die Berechnungen aus der eigentlichen Serialisierungen in TXMLSerializeRecordInfo zu verschieben, so daß man dieses dann auch mal für andere Dinge nutzen könnte. :)

himitsu 26. Nov 2009 10:37
Re: Speicherausrichtung (Align) berechnen
 
Aktuell sieht es so aus:

TXMLSerializeRDataType wären alle unterstützten Typen und daraus müßte man eigentlich alles Andere erstellen können.

Procedure TXMLSerializeRecordInfo.CalcOffsets; wäre die entscheidende Baustelle für die Berechnung.
Sitze grad an den ShortStrings und danach werd ich mal 'nen Test machen, ob das Aktuelle so überhaupt läuft und dann müßten irgendwie die Records und statischen Arrays mit rein.
Record und Array dürfte dann gleich sein, da ein Record ja eigentlich nur einem StaticArray mit Length=1 entsprechen müßte. :gruebel:

Delphi-Quellcode:
Type
  TXMLSerializeRDataType = (rtByteBool, rtWordBool, rtLongBool, {rtBoolean, rtBOOL,}
    rtByte, rtWord, rtLongWord, rtWord64, {rtCardinal,}
    rtShortInt, rtSmallInt, rtLongInt, rtInt64, {rtInteger,}
    rtSingle, rtDouble, rtExtended, {rtReal,} rtCurrency, rtDateTime,
    rtAnsiCharArray, rtWideCharArray, {rtCharArray,} rtUtf8String,
    rtShortString, rtAnsiString, rtWideString, rtUnicodeString, {rtString,}
    rtBinary, rtPointer{=rtDynBinary}, rtVariant, rtObject,
    rtRecord, rtArray, rtDynArray, rtDummy, rtAlign);

  TXMLSerializeRecordInfo = Class
    Private
      _Parent:      TXMLSerializeRecordInfo;
      _Data: Array of Record
        Offset:     Integer;
        Size:       Integer;
        ElementSize: Integern;
        Name:       TWideString;
        DType:      TXMLSerializeRDataType;
        Elements:   Integer; // for rtAnsiCharArray, rtWideCharArray, rtShortString, rtBinary, rtArray and rtDummy
        SubInfo:    TXMLSerializeRecordInfo; // for rtRecord, rtArray and rtDynArray
      End;
      _Align:       LongInt;
      _OffsetsOK:   Boolean;
      _Size:        LongInt;
      _ElementSize: LongInt;
      _SOptions:    TXMLSerializeOptions;
      _SerProc:     TXMLSerializeProc;
      _DeSerProc:   TXMLDeserializeProc;
      _CreateProc:  TXMLClassCreateProc;
      Procedure CheckOffsets (Intern: Boolean = False);
      Procedure CalcOffsets;
      Function GetCount:                      Integer;                Inline;
      Function GetFullOffset(Index: Integer): Integer;
      Function GetOffset   (Index: Integer): Integer;                Inline;
      Function GetSize     (Index: Integer): Integer;                Inline;
      Function GetName     (Index: Integer): String;                 Inline;
      Function GetDType    (Index: Integer): TXMLSerializeRDataType; Inline;
      Function GetElements (Index: Integer): Integer;                Inline;
      Function GetSubInfo  (Index: Integer): TXMLSerializeRecordInfo; Inline;
      Procedure Set_ObjectOpt(Source: TXMLSerializeRecordInfo);
      Procedure SetSOptions (Value: TXMLSerializeOptions); Inline;
      Procedure SetSerProc  (Value: TXMLSerializeProc);   Inline;
      Procedure SetDeSerProc (Value: TXMLDeserializeProc); Inline;
      Procedure SetCreateProc(Value: TXMLClassCreateProc); Inline;
    Public
      Constructor Create;
      Destructor Destroy; Override;
      Procedure SetAlign(     Align: LongInt = 4 {packed = 1}); Inline;
      Function Add    (      Name: String; DType: TXMLSerializeRDataType; Elements: Integer = 1): TXMLSerializeRecordInfo;
      Function IndexOf (Const Name: String):                 Integer; Overload;
      Function IndexOf (RecordInfo: TXMLSerializeRecordInfo): Integer; Overload;
      Procedure Assign (RecordInfo: TXMLSerializeRecordInfo);
      Procedure Parse  (Const S:   String);
      Procedure Clear;

      Property Count:                     Integer                Read GetCount;
      Property FullOffset[Index: Integer]: Integer                Read GetFullOffset;
      Property Offset   [Index: Integer]: Integer                Read GetOffset;
      Property Size     [Index: Integer]: Integer                Read GetSize;
      Property Name     [Index: Integer]: String                 Read GetName;
      Property DType    [Index: Integer]: TXMLSerializeRDataType Read GetDType;
      Property Elements [Index: Integer]: Integer                Read GetElements;
      Property SubInfo  [Index: Integer]: TXMLSerializeRecordInfo Read GetSubInfo;
      Property Align:                     LongInt                Read _Align;

      // for (de)serialization of objects
      Property SOptions:  TXMLSerializeOptions Read _SOptions  Write SetSOptions;
      Property SerProc:   TXMLSerializeProc   Read _SerProc   Write SetSerProc;
      Property DeSerProc: TXMLDeserializeProc Read _DeSerProc Write SetDeSerProc;
      Property CreateProc: TXMLClassCreateProc Read _CreateProc Write SetCreateProc;
    End;

Const
  rtBoolean  = {$If SizeOf(Boolean) = 1} rtByteBool     {$ELSE} unknown {$IFEND};
  rtBOOL     = {$If SizeOf(BOOL)    = 4} rtLongBool     {$ELSE} unknown {$IFEND};
  rtCardinal = {$If SizeOf(Cardinal) = 4} rtLongWord     {$ELSE}
                {$If SizeOf(Cardinal) = 8} rtWord64        {$ELSE} unknown {$IFEND}{$IFEND};
  rtInteger  = {$If SizeOf(Integer) = 4} rtLongInt      {$ELSE}
                {$If SizeOf(Integer) = 8} rtInt64         {$ELSE} unknown {$IFEND}{$IFEND};
  rtReal     = {$If SizeOf(Real)    = 4} rtSingle       {$ELSE}
                {$If SizeOf(Real)    = 8} rtDouble       {$ELSE}
                {$If SizeOf(Real)   = 10} rtExtended     {$ELSE} unknown {$IFEND}{$IFEND}{$IFEND};
  rtCharArray = {$If SizeOf(Char)    = 1} rtAnsiCharArray {$ELSE}
                {$If SizeOf(Char)    = 2} rtWideCharArray {$ELSE} unknown {$IFEND}{$IFEND};
  rtString   = {$If SizeOf(Char)    = 1} rtAnsiString   {$ELSE}
                {$If (SizeOf(Char)   = 2) and not Declared(UnicodeString)} rtWideString   {$ELSE}
                {$IF (SizeOf(Char)   = 2) and    Declared(UnicodeString)} rtUnicodeString {$ELSE} unknown {$IFEND}{$IFEND}{$IFEND};

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 _OffsetsOK Then CalcOffsets;
  End;

Procedure TXMLSerializeRecordInfo.CalcOffsets;
  Const DSize: Array[TXMLSerializeRDataType] of Byte = (1, 2, 4, 1, 2, 4, 8,
      1, 2, 4, 8, 4, 8, 10, 8, 8, 0, 0, SizeOf(Pointer), 0, SizeOf(Pointer),
      SizeOf(Pointer), SizeOf(Pointer), 0, SizeOf(Pointer), SizeOf(Variant),
      SizeOf(TObject), 0, 0, SizeOf(Pointer), 0, 0);

  Var D, i, i2: Integer;

  Begin
    _OffsetsOK := False;
    _Size     := 0;
    D         := -2;
    For i := 0 to High(_Data) do Begin
      If Assigned(_Data[i].SubInfo) Then Begin
        _Data[i].Size := DSize[_Data[i].DType];
        _Data[i].SubInfo.CalcOffsets;
      End Else _Data[i].Size := DSize[_Data[i].DType];
      If D <> _Data[i].Size Then D := -1;
      Case _Data[i].DType of
        rtByteBool, rtWordBool, rtLongBool,
        rtByte, rtWord, rtLongWord, rtWord64,
        rtShortInt, rtSmallInt, rtLongInt, rtInt64,
        rtSingle, rtDouble, rtExtended, rtCurrency, rtDateTime,
        rtUtf8String, rtAnsiString, rtWideString, rtUnicodeString,
        rtPointer, rtVariant, rtObject, rtDynArray: Begin
          i2 := _Data[i].Size;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Size);
        End;
        rtAnsiCharArray, rtBinary, rtDummy: Begin
          If D = -2 Then D := 1 Else If D <> 1 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Elements);
        End;
        rtWideCharArray: Begin
          i2 := 2;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Elements * 2);
        End;
        rtShortString: Begin

        End;
        rtRecord, rtArray: Begin

        End;
        rtAlign: Begin
          i2 := _Data[i].Elements;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
        End;
      End;
    End;
    _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 in [1, 2, 4, 8] 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 = '' Then Name := Format('rec:%d', [i]);
    If not TXHelper.CheckString(Name, xtElement_NodeName) and (IndexOf(Name) >= 0) Then
      Raise EXMLException.Create(ClassType, 'Add', @SInvalidValue, Name);
    SetLength(_Data, i + 1);
    _Data[i].Name := TWideString(Name);
    _Data[i].DType := DType;
    If DType in [rtAnsiCharArray, rtWideCharArray, rtShortString, rtBinary, rtArray, rtDummy, rtAlign] Then
      _Data[i].Elements := Elements Else _Data[i].Elements := 1;
    _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; // set by constructor
      _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);
  Const Convert: Array[0..37] of Record
      Key:     Char;
      Typ:     TXMLSerializeRDataType;
      Size:    Char;
      Elements: Boolean;
    End = (
      (Key: 'b'; Typ: rtByteBool;     Size: '1'               ),
      (Key: 'b'; Typ: rtWordBool;     Size: '2'               ),
      (Key: 'b'; Typ: rtLongBool;     Size: '4'               ),
      (Key: 'b'; Typ: rtBoolean                                ),
      (Key: 'b'; Typ: rtBOOL;         Size: 'x'               ),
      (Key: 'w'; Typ: rtByte;         Size: '1'               ),
      (Key: 'w'; Typ: rtWord;         Size: '2'               ),
      (Key: 'w'; Typ: rtLongWord;     Size: '4'               ),
      (Key: 'w'; Typ: rtWord64;       Size: '8'               ),
      (Key: 'w'; Typ: rtCardinal                               ),
      (Key: 'i'; Typ: rtShortInt;     Size: '1'               ),
      (Key: 'i'; Typ: rtSmallInt;     Size: '2'               ),
      (Key: 'i'; Typ: rtLongInt;      Size: '4'               ),
      (Key: 'i'; Typ: rtInt64;        Size: '8'               ),
      (Key: 'i'; Typ: rtInteger                                ),
      (Key: 'f'; Typ: rtSingle;       Size: '4'               ),
      (Key: 'f'; Typ: rtDouble;       Size: '8'               ),
      (Key: 'f'; Typ: rtExtended;     Size: '0'               ),
      (Key: 'f'; Typ: rtReal                                   ),
      (Key: 'y'; Typ: rtCurrency                               ),
      (Key: 't'; Typ: rtDateTime                               ),
      (Key: 'c'; Typ: rtAnsiCharArray; Size: 'a'; Elements: True),
      (Key: 'c'; Typ: rtWideCharArray; Size: 'w'; Elements: True),
      (Key: 'c'; Typ: rtCharArray;               Elements: True),
      (Key: 'u'; Typ: rtUtf8String                             ),
      (Key: 's'; Typ: rtShortString;  Size: 's'; Elements: True),
      (Key: 's'; Typ: rtAnsiString;   Size: 'a'               ),
      (Key: 's'; Typ: rtWideString;   Size: 'w'               ),
      (Key: 's'; Typ: rtUnicodeString; Size: 'u'               ),
      (Key: 's'; Typ: rtString                                 ),
      (Key: 'x'; Typ: rtBinary;                  Elements: True),
      (Key: 'v'; Typ: rtVariant                                ),
      (Key: 'o'; Typ: rtObject                                 ),
      (Key: 'r'; Typ: rtRecord                                 ),
      (Key: 'a'; Typ: rtArray;                   Elements: True),
      (Key: 'd'; Typ: rtDynArray                               ),
      (Key: 'n'; Typ: rtDummy;                   Elements: True),
      (Key: 'l'; Typ: rtAlign;                   Elements: True));

  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;
        'P', 'p':
          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) = Convert[i2].Key) and ((Convert[i2].Size = #0) or
                ((i < Length(S)) and (Char(Ord(S[i + 1]) or $20) = Convert[i2].Size))) Then Begin
              Inc(i);
              If Convert[i2].Size <> #0 Then Inc(i);
              If Convert[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, Convert[i2].Typ, i3);
              Break;
            End;
            Inc(i2);
          Until i2 > High(Convert);
          If i2 > High(Convert) Then
            Raise EXMLException.Create(ClassType, 'Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
        End;
      End;
  End;

Procedure TXMLSerializeRecordInfo.Clear;
  Var i: Integer;

  Begin
    _OffsetsOK := False;
    For i := High(_Data) downto 0 do _Data[i].SubInfo.Free;
    _Data := nil;
  End;
Und warum kann Delphi eigentlich noch kein {$ALIGN 16} :shock:

himitsu 28. Nov 2009 11:56
Re: Speicherausrichtung (Align) berechnen
 
Sooo, mußte zwar noch einen neuen "virtuellen" Typen einführen (rtSplit),
da z.B. TFileTime als UInt64 (rtWord64) angesehn werden kann, aber intern aus 2 LongWords besteht,
welches ja beim Align beachtet werden muß.
Als kann man nun eine nachfolgende Typendeplaration zwar als "großen" Typen speichern, aber für's Align aufsplitten.

Anscheinend scheint nun endlich die Behandlung "einacher" Typen zu funktionieren
und es fehlt NUR noch die Behandlung von untergeordneten Records und statischen Arrays.

[edit]
Hatte rtCharArray in .Add vergessen zu behandeln,
wodurch Elements nicht gespeichert wurde. :oops:

Jetzt stimmt erstmal alles überein und
ich müßte mal sehn, ob das mit der Array-/Record-Verschachtelung so klappt. :firejump:
[/edit]

Delphi-Quellcode:
Type
  TXMLSerializeRDataType = (
    rtByteBool, rtWordBool, rtLongBool, rtBoolean{*}, rtBOOL{*},
    rtByte, rtWord, rtLongWord, rtWord64, rtWord64LE, rtCardinal{*},
    rtShortInt, rtSmallInt, rtLongInt, rtInt64, rtInt64LE, rtInteger{*},
    rtSingle, rtDouble, rtExtended, rtReal{*}, rtCurrency, rtDateTime,
    rtAnsiCharArray, rtWideCharArray, rtCharArray{*}, rtUtf8String,
    rtShortString, rtAnsiString, rtWideString, rtUnicodeString, rtString{*},
    rtBinary, rtPointer{=rtDynBinary}, rtVariant, rtObject,
    rtRecord, rtArray, rtDynArray, rtDummy, rtAlign, rtSplit);
  TXMLSerializeTextFormat = (sfShort, sfFormat1, sfFormat2, sfFormat3, sfFormat4);
  TXMLSerializeRecordInfo = Class
  Private
    _Parent:      TXMLSerializeRecordInfo;
    _Data: Array of Record
      Offset:     Integer;
      Size:       Integer;
      ElementSize: Integer;
      Name:       TWideString;
      DType:      TXMLSerializeRDataType;
      Elements:   Integer; // for rtAnsiCharArray, rtWideCharArray, rtShortString, rtBinary, rtPointer, rtArray, rtDummy, rtAlign and rtSplit
      SubInfo:    TXMLSerializeRecordInfo; // for rtRecord, rtArray and rtDynArray
    End;
    _Align:       LongInt;
    _OffsetsOK:   Boolean;
    _Size:        LongInt;
    _ElementSize: LongInt;
    _SOptions:    TXMLSerializeOptions;
    _SerProc:     TXMLSerializeProc;
    _DeSerProc:   TXMLDeserializeProc;
    _CreateProc:  TXMLClassCreateProc;
    Procedure CheckOffsets (Intern: Boolean = False);
    Procedure CalcOffsets;
    Function GetCount:                      Integer;                Inline;
    Function GetFullOffset(Index: Integer): Integer;
    Function GetOffset   (Index: Integer): Integer;                Inline;
    Function GetSize     (Index: Integer): Integer;                Inline;
    Function GetName     (Index: Integer): String;                 Inline;
    Function GetDType    (Index: Integer): TXMLSerializeRDataType; Inline;
    Function GetElements (Index: Integer): Integer;                Inline;
    Function GetSubInfo  (Index: Integer): TXMLSerializeRecordInfo; Inline;
    Procedure Set_ObjectOpt(Source: TXMLSerializeRecordInfo);
    Procedure SetSOptions (Value: TXMLSerializeOptions); Inline;
    Procedure SetSerProc  (Value: TXMLSerializeProc);   Inline;
    Procedure SetDeSerProc (Value: TXMLDeserializeProc); Inline;
    Procedure SetCreateProc(Value: TXMLClassCreateProc); Inline;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure SetAlign (     Align: LongInt = 4 {packed = 1}); Inline;
    Function Add     (      Name: String; DType: TXMLSerializeRDataType; Elements: Integer = 1): TXMLSerializeRecordInfo;
    Function IndexOf (Const Name: String):                 Integer; Overload;
    Function IndexOf (RecordInfo: TXMLSerializeRecordInfo): Integer; Overload;
    Procedure Assign  (RecordInfo: TXMLSerializeRecordInfo);
    Procedure Parse   (Const S:   String);
    Function GetString(   DFormat: TXMLSerializeTextFormat = sfFormat1): String;
    Procedure Clear;

    Property Count:                     Integer                Read GetCount;
    Property FullOffset[Index: Integer]: Integer                Read GetFullOffset;
    Property Offset   [Index: Integer]: Integer                Read GetOffset;
    Property Size     [Index: Integer]: Integer                Read GetSize;
    Property Name     [Index: Integer]: String                 Read GetName;
    Property DType    [Index: Integer]: TXMLSerializeRDataType Read GetDType;
    Property Elements [Index: Integer]: Integer                Read GetElements;
    Property SubInfo  [Index: Integer]: TXMLSerializeRecordInfo Read GetSubInfo;
    Property Align:                     LongInt                Read _Align;

    // for (de)serialization of objects
    Property SOptions:  TXMLSerializeOptions Read _SOptions  Write SetSOptions;
    Property SerProc:   TXMLSerializeProc   Read _SerProc   Write SetSerProc;
    Property DeSerProc: TXMLDeserializeProc Read _DeSerProc Write SetDeSerProc;
    Property CreateProc: TXMLClassCreateProc Read _CreateProc Write SetCreateProc;
End;
Delphi-Quellcode:
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;
Testcode:
Delphi-Quellcode:
RI := TXMLSerializeRecordInfo.Create;
Try
  RI.Add('Time',   rtInteger);
  RI.Add('Size',   rtInt64);
  RI.Add('Attr',   rtInteger);
  RI.Add('Name',   rtString);
  RI.Add('Exclude', rtInteger);
  RI.Add('Handle', rtLongWord);
  RIx := RI.Add('Data', rtRecord);
  RIx.Add('Attributes', rtLongWord);
  RIx.Add('',          rtSplit, 4);
  RIx.Add('Creation',  rtWord64);
  RIx.Add('',          rtSplit, 4);
  RIx.Add('LastAccess', rtWord64);
  RIx.Add('',          rtSplit, 4);
  RIx.Add('LastWrite', rtWord64);
  RIx.Add('',          rtSplit, 4);
  RIx.Add('FileSize',  rtWord64LE);
  RIx.Add('Reserved0', rtLongWord);
  RIx.Add('Reserved1', rtLongWord);
  RIx.Add('FileName',  rtCharArray, 260);
  RIx.Add('Alternate', rtCharArray, 14);

  SL := TStringList.Create;
  SL.Add(Format('Align:%d', [RI.Align]));
  For i := 0 to RI.Count - 1 do
    If RI.DType[i] <> rtSplit Then
      SL.Add(Format('Offset:%d  Size:%d  Name:"%s"',
        [RI.Offset[i], RI.Size[i], RI.Name[i]]));
  SL.Add('');
  SL.Add(Format('Align:%d', [RIx.Align]));
  For i := 0 to RIx.Count - 1 do
    If RIx.DType[i] <> rtSplit Then
      SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"',
        [RIx.FullOffset[i], RIx.Offset[i], RIx.Size[i], RIx.Name[i]]));

  SL.Add('');
  SL.Add('------------------------------');
  SL.Add('');
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.Time) - Integer(@Test), SizeOf(Test.Time), 'Time']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.Size) - Integer(@Test), SizeOf(Test.Size), 'Size']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.Attr) - Integer(@Test), SizeOf(Test.Attr), 'Attr']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.Name) - Integer(@Test), SizeOf(Test.Name), 'Name']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.ExcludeAttr) - Integer(@Test), SizeOf(Test.ExcludeAttr), 'Exclude']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindHandle) - Integer(@Test), SizeOf(Test.FindHandle), 'Handle']));
  SL.Add(Format('Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData) - Integer(@Test), SizeOf(Test.FindData), 'Data']));
  SL.Add('');
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwFileAttributes) - Integer(@Test), Integer(@Test.FindData.dwFileAttributes) - Integer(@Test.FindData), SizeOf(Test.FindData.dwFileAttributes), 'Attributes']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftCreationTime) - Integer(@Test), Integer(@Test.FindData.ftCreationTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftCreationTime), 'Creation']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftLastAccessTime) - Integer(@Test), Integer(@Test.FindData.ftLastAccessTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftLastAccessTime), 'LastAccess']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftLastWriteTime) - Integer(@Test), Integer(@Test.FindData.ftLastWriteTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftLastWriteTime), 'LastWrite']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.nFileSizeHigh) - Integer(@Test), Integer(@Test.FindData.nFileSizeHigh) - Integer(@Test.FindData), SizeOf(Test.FindData.nFileSizeHigh) * 2, 'FileSize']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwReserved0) - Integer(@Test), Integer(@Test.FindData.dwReserved0) - Integer(@Test.FindData), SizeOf(Test.FindData.dwReserved0), 'Reserved0']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwReserved1) - Integer(@Test), Integer(@Test.FindData.dwReserved1) - Integer(@Test.FindData), SizeOf(Test.FindData.dwReserved1), 'Reserved1']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.cFileName) - Integer(@Test), Integer(@Test.FindData.cFileName) - Integer(@Test.FindData), SizeOf(Test.FindData.cFileName), 'FileName']));
  SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.cAlternateFileName) - Integer(@Test), Integer(@Test.FindData.cAlternateFileName) - Integer(@Test.FindData), SizeOf(Test.FindData.cAlternateFileName), 'Alternate']));
  ShowMessage(SL.Text);
  SL.Free;

  //XML.AddNode('via_Add').Serialize(Test, RI);
Finally
  RI.Free;
End;
Ergebnis: (oben = von meinem Code errechnet | unten = gemessen)
Zitat:
---------------------------
Test
---------------------------
Align:8
Offset:0 Size:4 Name:"Time"
Offset:8 Size:8 Name:"Size"
Offset:16 Size:4 Name:"Attr"
Offset:20 Size:4 Name:"Name"
Offset:24 Size:4 Name:"Exclude"
Offset:28 Size:4 Name:"Handle"
Offset:32 Size:592 Name:"Data"

Align:8
FullOffset:32 Offset:0 Size:4 Name:"Attributes"
FullOffset:36 Offset:4 Size:8 Name:"Creation"
FullOffset:44 Offset:12 Size:8 Name:"LastAccess"
FullOffset:52 Offset:20 Size:8 Name:"LastWrite"
FullOffset:60 Offset:28 Size:8 Name:"FileSize"
FullOffset:68 Offset:36 Size:4 Name:"Reserved0"
FullOffset:72 Offset:40 Size:4 Name:"Reserved1"
FullOffset:76 Offset:44 Size:520 Name:"FileName"
FullOffset:596 Offset:564 Size:28 Name:"Alternate"

------------------------------

Offset:0 Size:4 Name:"Time"
Offset:8 Size:8 Name:"Size"
Offset:16 Size:4 Name:"Attr"
Offset:20 Size:4 Name:"Name"
Offset:24 Size:4 Name:"Exclude"
Offset:28 Size:4 Name:"Handle"
Offset:32 Size:592 Name:"Data"

FullOffset:32 Offset:0 Size:4 Name:"Attributes"
FullOffset:36 Offset:4 Size:8 Name:"Creation"
FullOffset:44 Offset:12 Size:8 Name:"LastAccess"
FullOffset:52 Offset:20 Size:8 Name:"LastWrite"
FullOffset:60 Offset:28 Size:8 Name:"FileSize"
FullOffset:68 Offset:36 Size:4 Name:"Reserved0"
FullOffset:72 Offset:40 Size:4 Name:"Reserved1"
FullOffset:76 Offset:44 Size:520 Name:"FileName"
FullOffset:596 Offset:564 Size:28 Name:"Alternate"

---------------------------
OK
---------------------------

himitsu 28. Nov 2009 18:33
Re: Speicherausrichtung (Align) berechnen
 
Liste der Anhänge anzeigen (Anzahl: 1)
Das Ganze ist nun noch etwas überarbeitet und verändert worden
und ich hab's mal aus dem Projekt extrahiert und in einer eigenständigen Unit verpackt, samt ein paar notwendiger Dummytypen.

Wäre schön, wenn noch jemand hier auch einiges Tests mit machen könnte, nicht daß ich einfach zu Betriebsblind bin und was überseh.
Bei meinen bisherigen Tests scheint das Problem der verschachtelten Records korrekt behandelt zu werden,
auch wenn {$ALIGN}/{$A} unterschiedlich sind oder es sogar packed ist. :-D

Wobei ich jetzt noch mit Arrays und weiteren Records rumspielen werde.


ein Testcode:
Delphi-Quellcode:
Procedure RecordInfoToStingList(SL: TStrings; RI: TXMLSerializeRecordInfo);
  Var i: Integer;

  Begin
    SL.Add(Format('Align:%d', [RI.Align]));
    For i := 0 to RI.Count - 1 do Begin
      If not (RI.DType[i] in [rtAlign, rtSplit]) Then
        SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"',
          [RI.FullOffset[i], RI.Offset[i], RI.Size[i], RI.Name[i]]));
      If RI.DType[i] in [rtRecord, rtArray, rtDynArray] Then
        RecordInfoToStingList(SL, RI.SubInfo[i]);
    End;
  End;

Var Test: TSearchRec;
  RI, RIx: TXMLSerializeRecordInfo;
  SL:     TStrings;

Begin
  // einfach nur den Record mit irgendetwas befüllen
  FindFirst(Application.ExeName, faAnyFile, Test);
  FindClose(Test);

  RI := TXMLSerializeRecordInfo.Create;
  Try
    RI.Add('Time',   rtInteger);
    RI.Add('Size',   rtInt64);
    RI.Add('Attr',   rtInteger);
    RI.Add('Name',   rtString);
    RI.Add('Exclude', rtInteger);
    RI.Add('Handle', rtLongWord);
    RIx := RI.Add('Data', rtRecord);
    RIx.Add('Attributes', rtLongWord);
    RIx.Add('',          rtSplit, 4);
    RIx.Add('Creation',  rtWord64);
    RIx.Add('',          rtSplit, 4);
    RIx.Add('LastAccess', rtWord64);
    RIx.Add('',          rtSplit, 4);
    RIx.Add('LastWrite', rtWord64);
    RIx.Add('',          rtSplit, 4);
    RIx.Add('FileSize',  rtWord64LE);
    RIx.Add('Reserved0', rtLongWord);
    RIx.Add('Reserved1', rtLongWord);
    RIx.Add('FileName',  rtCharArray, 260);
    RIx.Add('Alternate', rtCharArray, 14);

    //RI.Parse('I"Time" I8"Size" I"Attr" S"Name" I"Exclude" W4"Handle" R"Data" ('
    //  + 'W4"Attributes" NX4W8"Creation" NX4W8"LastAccess" NX4W8"LastWrite" IE"FileSize"'
    //  + 'I4"Reserved0" I4"Reserved1" C260"FileName" C14"Alternate" )');

    //RI.Parse('I I8 I S I W4 R ( W4 NX4W8 NX4W8 NX4W8 WE I4 I4 C260 C14 )');

    //RI.Parse('ii8isiw4r(w4nx4w8nx4w8nx4w8iei4i4c260c14)');

    SL := TStringList.Create;
    RecordInfoToStingList(SL, RI);
    SL.Add('');
    SL.Add('------------------------------');
    SL.Add('');
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.Time) - Integer(@Test), SizeOf(Test.Time), 'Time']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.Size) - Integer(@Test), SizeOf(Test.Size), 'Size']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.Attr) - Integer(@Test), SizeOf(Test.Attr), 'Attr']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.Name) - Integer(@Test), SizeOf(Test.Name), 'Name']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.ExcludeAttr) - Integer(@Test), SizeOf(Test.ExcludeAttr), 'Exclude']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.FindHandle) - Integer(@Test), SizeOf(Test.FindHandle), 'Handle']));
    SL.Add(Format('FullOffset:%0:d  Offset:%0:d  Size:%d  Name:"%s"', [Integer(@Test.FindData) - Integer(@Test), SizeOf(Test.FindData), 'Data']));
    SL.Add('');
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwFileAttributes) - Integer(@Test), Integer(@Test.FindData.dwFileAttributes) - Integer(@Test.FindData), SizeOf(Test.FindData.dwFileAttributes), 'Attributes']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftCreationTime) - Integer(@Test), Integer(@Test.FindData.ftCreationTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftCreationTime), 'Creation']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftLastAccessTime) - Integer(@Test), Integer(@Test.FindData.ftLastAccessTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftLastAccessTime), 'LastAccess']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.ftLastWriteTime) - Integer(@Test), Integer(@Test.FindData.ftLastWriteTime) - Integer(@Test.FindData), SizeOf(Test.FindData.ftLastWriteTime), 'LastWrite']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.nFileSizeHigh) - Integer(@Test), Integer(@Test.FindData.nFileSizeHigh) - Integer(@Test.FindData), SizeOf(Test.FindData.nFileSizeHigh) * 2, 'FileSize']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwReserved0) - Integer(@Test), Integer(@Test.FindData.dwReserved0) - Integer(@Test.FindData), SizeOf(Test.FindData.dwReserved0), 'Reserved0']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.dwReserved1) - Integer(@Test), Integer(@Test.FindData.dwReserved1) - Integer(@Test.FindData), SizeOf(Test.FindData.dwReserved1), 'Reserved1']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.cFileName) - Integer(@Test), Integer(@Test.FindData.cFileName) - Integer(@Test.FindData), SizeOf(Test.FindData.cFileName), 'FileName']));
    SL.Add(Format('FullOffset:%d  Offset:%d  Size:%d  Name:"%s"', [Integer(@Test.FindData.cAlternateFileName) - Integer(@Test), Integer(@Test.FindData.cAlternateFileName) - Integer(@Test.FindData), SizeOf(Test.FindData.cAlternateFileName), 'Alternate']));
    SL.Add('');
    SL.Add('------------------------------');
    SL.Add('');
    SL.Add(RI.GetString(sfFormat2));
    SL.Add('');
    SL.Add(RI.GetString(sfShort));
    ShowMessage(SL.Text);
    SL.Free;
  Finally
    RI.Free;
  End;
und das zugehörige Ergebnis (ausgerechnet | gemessen | Formate )
Delphi-Quellcode:
---------------------------
Test
---------------------------
Align:8
FullOffset:0   Offset:0   Size:4   Name:"Time"
FullOffset:8   Offset:8   Size:8   Name:"Size"
FullOffset:16   Offset:16   Size:4   Name:"Attr"
FullOffset:20   Offset:20   Size:4   Name:"Name"
FullOffset:24   Offset:24   Size:4   Name:"Exclude"
FullOffset:28   Offset:28   Size:4   Name:"Handle"
FullOffset:32   Offset:32   Size:592   Name:"Data"
Align:8
FullOffset:32   Offset:0   Size:4   Name:"Attributes"
FullOffset:36   Offset:4   Size:8   Name:"Creation"
FullOffset:44   Offset:12   Size:8   Name:"LastAccess"
FullOffset:52   Offset:20   Size:8   Name:"LastWrite"
FullOffset:60   Offset:28   Size:8   Name:"FileSize"
FullOffset:68   Offset:36   Size:4   Name:"Reserved0"
FullOffset:72   Offset:40   Size:4   Name:"Reserved1"
FullOffset:76   Offset:44   Size:520   Name:"FileName"
FullOffset:596   Offset:564   Size:28   Name:"Alternate"

------------------------------

FullOffset:0   Offset:0   Size:4   Name:"Time"
FullOffset:8   Offset:8   Size:8   Name:"Size"
FullOffset:16   Offset:16   Size:4   Name:"Attr"
FullOffset:20   Offset:20   Size:4   Name:"Name"
FullOffset:24   Offset:24   Size:4   Name:"Exclude"
FullOffset:28   Offset:28   Size:4   Name:"Handle"
FullOffset:32   Offset:32   Size:592   Name:"Data"

FullOffset:32   Offset:0   Size:4   Name:"Attributes"
FullOffset:36   Offset:4   Size:8   Name:"Creation"
FullOffset:44   Offset:12   Size:8   Name:"LastAccess"
FullOffset:52   Offset:20   Size:8   Name:"LastWrite"
FullOffset:60   Offset:28   Size:8   Name:"FileSize"
FullOffset:68   Offset:36   Size:4   Name:"Reserved0"
FullOffset:72   Offset:40   Size:4   Name:"Reserved1"
FullOffset:76   Offset:44   Size:520   Name:"FileName"
FullOffset:596   Offset:564   Size:28   Name:"Alternate"

------------------------------

i"Time" i8"Size" i"Attr" s"Name" i"Exclude" w4"Handle" r"Data" ( w4"Attributes" nx4 w8"Creation" nx4 w8"LastAccess" nx4 w8"LastWrite" nx4 we"FileSize" w4"Reserved0" w4"Reserved1" c260"FileName" c14"Alternate" )

ii8isiw4r(w4nx4w8nx4w8nx4w8nx4wew4w4c260c14)

---------------------------
OK  
---------------------------


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:59 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz