Экспорт бинарной записи в XML (RTTI#6)

Представьте, что в своей программе для хранения различной информации вы используете структуры. Структуры эти содержат только данные, и эти данные вы периодически сохраняете и загружаете. Обычно это просто решается записью структуры в соответствующий типизированный файл, и последующей загрузкой из него. Но вот в чем проблема, если вы вводите новые поля в структуру, то вы уже не можете считать старые данные. Размер структуры изменен. Конечно, если структура имеет маленький объем, сохранение можно провести в "ручном" режиме. Т.е написать процедуру сохранения полей (например в XML формат), и обратный функционал загрузки. Но в моем случае объем структуры очень велик, и я решил использовать RTTI. С помощью этого механизма мы можем получить все необходимые данные о формате данных, количеству, именам и типу полей структуры, и экспортировать их в файл. Пока что разработка класса только в начальной стадии но некоторые результаты уже есть. По завершении работы я выложу полный текст модуля. А пока что, быть может кто-нибудь даст дельный совет, о том как решать сию задачу. Приведу описание структуры, которая используется для теста:

    TInnerTest = record
        x : int64;
        y : AnsiString;
        z : char;
    end;

    TArrayRec = record
        v1 : integer;
        v2 : double;
    end;

    TEnum = (etOne, etTwo, etThree);

    TIntArray = array[1..5] of integer;
    TRecArray = array[1..3] of TArrayRec;
    T2DimArray = array[boolean, 1..4] of integer;

    TTest = record
      a : boolean;
      b : byte;
      c : integer;
      d : double;
      e : string;
      f : TInnerTest;
      g : array[1..10] of integer;
      h : TIntArray;
      i : TRecArray;
      j : TEnum;
      k : T2DimArray;
      l : array of real;
    end;

Главная запись TTest содержит поля различных типов, булевые, целые, дробные, строки, вложенные записи, массивы одномерные и двумерные, в т.ч. массивы записей. В общем - то что надо чтобы хранить лишь данные (в структуре не будет объектов, указателей и т.п.). После конвертации в XML имеем следующий результат:

<?xml version="1.0"?>
<Data>
  <a type="tkEnumeration">True</a>
  <b type="tkInteger">1</b>
  <c type="tkInteger">1024</c>
  <d type="tkFloat">3,14</d>
  <e type="tkUString">qwerty</e>
  <f type="tkRecord">
    <x type="tkInt64">123456890</x>
    <y type="tkLString">asd</y>
    <z type="tkWChar">X</z>
  </f>
  <g type="error" class="Exception" msg="field: g - fieldType undefined"/>
  <h type="tkArray" totalElements="5" dims="1" elementType="tkInteger">
    <element index="0">1</element>
    <element index="1">2</element>
    <element index="2">3</element>
    <element index="3">4</element>
    <element index="4">5</element>
  </h>
  <i type="tkArray" totalElements="3" dims="1" elementType="tkRecord">
    <element index="0">
      <v1 type="tkInteger">1</v1>
      <v2 type="tkFloat">1,5</v2>
    </element>
    <element index="1">
      <v1 type="tkInteger">2</v1>
      <v2 type="tkFloat">3</v2>
    </element>
    <element index="2">
      <v1 type="tkInteger">3</v1>
      <v2 type="tkFloat">4,5</v2>
    </element>
  </i>
  <j type="tkEnumeration">etTwo</j>
  <k type="tkArray" totalElements="8" dims="2" elementType="tkInteger">
    <element index="0">1</element>
    <element index="1">2</element>
    <element index="2">3</element>
    <element index="3">4</element>
    <element index="4">-1</element>
    <element index="5">-2</element>
    <element index="6">-3</element>
    <element index="7">-4</element>
  </k>
  <l type="tkDynArray" totalElements="0" elementType="tkFloat">
    <element index="0">0</element>
    <element index="1">10</element>
    <element index="2">20</element>
    <element index="3">30</element>
    <element index="4">40</element>
  </l>
</Data>

Для решения данной задачи я создал класс TRecToXMLConvert:

    TRec2XMLConvert = class(TObject)
      strict protected
        FContext : TRttiContext;

        FXMLDoc : IXMLDocument;
        FRoot : IXMLNode;
        FXMLData : string;

        FData : pointer;
        FDataType : PTypeInfo;

        function typeKindToString(tk : TTypeKind) : string;

        procedure ConvertArray(data : pointer; dataType : PTypeInfo; node : IXMLNode);
        procedure ConvertRecord(Data : Pointer; dataType : PTypeInfo; node : IXMLNode);
      public
        constructor Create();
        destructor Destroy(); override;
        procedure SetBinaryData(instance : pointer; dataType : PTypeInfo);
        procedure Convert();

        property XMLData : string read FXmlData;
    end;

После того как создан экземпляр объекта, устанавливаются параметры конвертации - запись и ее тип. результат конвертации доступен с использованием свойства XMLData. Алгоритм конвертации примерно таков: необходимо перебрать все поля записи. Если поле является простым типом (число, строка), то записать его в файл. Если поле - составной тип (массив, запись) то запустить соответствующую функцию разбора (ConvertArray, или рекурсивно ConvertRecord). В случае если элементы массива - простые типы, то записать их, если составные - то для каждого элемента вызвать соответствующий метод. Проблема состоит в том, что для неименованных (имеется в виду тип) членов структуры RTTI информация не генерируется. Так что если поле имеет тип array[1..5] of integer, то для него не будет сгенерирована RTTI информация. Вероятно это проблема может быть решена с использованием TValue. Перебор полей записи, определение их типа, и запись их в XML реализуется методом ConvertRecord:

procedure TRec2XMLConvert.ConvertRecord(Data: Pointer; dataType: PTypeInfo; node: IXMLNode);
var rt : TRttiRecordType;
    f : TRttiField;
    fieldName : string;
    fieldType : TRttiType;
    ftk : TTypeKind;
    ftkName : string;
    fieldPtr : pointer;
    fValue : TValue;

    n : IXMLNode;

begin
    rt := FContext.GetType(dataType) as TRttiRecordType;

    for f in rt.GetFields() do begin
        try
            fieldName := f.Name;
            fieldType := f.FieldType;

            if assigned(fieldType) then begin
                ftk := fieldType.TypeKind;
                ftkName := typeKindToString(ftk);

                n := node.AddChild(fieldName);
                n.Attributes['type'] := ftkName;

                fieldPtr := pointer( NativeInt(data) + f.offset);

                case ftk of
                    tkRecord : ConvertRecord(fieldPtr, fieldType.Handle, n);
                    tkArray,tkDynArray  : ConvertArray(fieldPtr,  fieldType.Handle, n);
                    else begin
                        fValue := f.GetValue(data);
                        n.NodeValue := fValue.toString;
                    end;
                end;
            end
            else begin
                raise Exception.Create('field: ' + fieldName + ' - fieldType undefined');
            end;
        except
            on e : Exception do begin
                n := node.AddChild(fieldName);
                n.Attributes['type'] := 'error';
                n.Attributes['class'] := e.ClassName;
                n.Attributes['msg'] := e.Message;
            end;
        end;
    end;
end;

Простые типы с помощью TValue.ToString легко переводятся в строковый вид. Исключение тут только перечисления, хотелось бы получать целочисленное представление значения, ибо не понятно как их потом загружать обратно. При рекурсивном вызове (поле - массив или запись), необходимо передавать указатель на поле, где учитывать сдвиг адреса поля относительно начала самой записи. Здесь нам помогает TRttiField.Offset. При работе с массивом, также необходимо расчитывать смещение элемента относительно начала массива. Работа с массивом, к слову сказать различается для статических и динамеческих массивов. В первом случае - работа с TRttiArrayType, который предоставляет информацию о типе элементов, размерности массива. В случае динамического массива - TRttiDynamicArrayType, который может предоставить лишь информацию о типе элементов. А для непосредственной работы с массивом необходмио использовать TValue. В моем случае динамические массивы правда не исползьуются, но все равно такую возможность я предусматриваю.

procedure TRec2XMLConvert.ConvertArray(data: pointer; dataType: PTypeInfo; node: IXMLNode);
var dt : TRttiType;
    at : TRttiArrayType;
    da : TRttiDynamicArrayType;

    et : TRttiType;
    elTypeName : string;
    elSize : NativeInt;
    elCount : integer;
    elPtr : Pointer;
    value, el : TValue;

    i : integer;
    n : IXMLNode;
begin
    dt := FContext.GetType(dataType);/

    if dt.TypeKind = tkArray then begin
        at := dt as TRttiArrayType;
        et := at.ElementType;
        elCount := at.TotalElementCount;

        node.Attributes['totalElements'] := intToStr(at.TotalElementCount);
        node.Attributes['dims'] := intToStr(at.DimensionCount);

        node.Attributes['elementType'] := typeKindToString(et.TypeKind);

        elSize := et.TypeSize;

        for i := 0 to elCount - 1 do begin
            n := node.AddChild('element');
            n.Attributes['index'] := intToStr(i);

            elPtr := pointer(NativeInt(data) + i*elSize);

            case et.TypeKind of
                tkRecord : ConvertRecord(elPtr, et.Handle, n);
                tkArray, tkDynArray  : ConvertArray(elPtr,  et.Handle, n)
                else begin
                    TValue.MakeWithoutCopy(elPtr, et.Handle, value);
                    n.NodeValue := value.ToString;
                end;
            end;
        end;
    end
    else begin
        da := dt as TRttiDynamicArrayType;
        et := da.ElementType;
        elCount := 0;
        TValue.Make(data, da.Handle, value);
        elCount := value.GetArrayLength();

        node.Attributes['totalElements'] := '0';
        node.Attributes['elementType'] := typeKindToString(et.TypeKind);


        for i := 0 to elCount - 1 do begin
            n := node.AddChild('element');
            n.Attributes['index'] := intToStr(i);

            el := value.GetArrayElement(i);

            case el.Kind of
                tkRecord : ConvertRecord(el.GetReferenceToRawData, et.Handle, n);
                tkArray, tkDynArray : ConvertArray(el.GetReferenceToRawData, et.Handle, n);
                else begin
                    n.NodeValue := el.ToString;
                end;
            end;
        end;
    end;
end;

В общем случае запись бинарной стуктуры в XML может решить некоторые проблемы, которые возникают при работе, а именно - изменение формата записи. Так же при записи записей в типизированные файлы (f : file of TTest) накладываются ограничения размеры всех полей должны быть строго определены, т.е мы не можем использовать строки и динамические массивы. Сериализация же убирает такие ограничения. Возможно правда надо было поискать готовое решение, всяко я не первый кто решает подобную проблему. Хотя лучше предусматривать возможности изменения ваших структур и последующей несовместимости версий в ваших программах, и выбирать другие способы хранения информации. Хотя при сериализации в XML, JSON или другие форматы хранение данных в виде структуры (с целью сохранения и последующей загрузки) имеет право на жизнь.