AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi Speicherausrichtung (Align) berechnen
Thema durchsuchen
Ansicht
Themen-Optionen

Speicherausrichtung (Align) berechnen

Ein Thema von himitsu · begonnen am 23. Nov 2009 · letzter Beitrag vom 28. Nov 2009
Antwort Antwort
Seite 2 von 2     12   
Hawkeye219

Registriert seit: 18. Feb 2006
Ort: Stolberg
2.227 Beiträge
 
Delphi 2010 Professional
 
#11

Re: Speicherausrichtung (Align) berechnen

  Alt 25. Nov 2009, 21:54
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
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#12

Re: Speicherausrichtung (Align) berechnen

  Alt 25. Nov 2009, 22:08
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#13

Re: Speicherausrichtung (Align) berechnen

  Alt 26. Nov 2009, 10:37
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.

zusammenfalten · markieren
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}
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#14

Re: Speicherausrichtung (Align) berechnen

  Alt 28. Nov 2009, 11:56
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.

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

zusammenfalten · markieren
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;
zusammenfalten · markieren
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:
zusammenfalten · markieren
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
---------------------------
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#15

Re: Speicherausrichtung (Align) berechnen

  Alt 28. Nov 2009, 18:33
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.

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


ein Testcode:
zusammenfalten · markieren
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 )
zusammenfalten · markieren
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
---------------------------
Angehängte Dateien
Dateityp: pas serializerecordinfo_320.pas (23,9 KB, 2x aufgerufen)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   

« Vorheriges Thema | Nächstes Thema »

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:40 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz