XML сериализация объекта Delphi

Язык XML предоставляет нам чрезвычайно удобный и почти универсальный подход к хранению и передаче информации. Не хватает только средств, которые позволили бы удобно и просто организовать работу с XML. Предлагаемая разработка реализует очень эффективную возможность - XML сериализацию объектов любых классов Delphi и из загрузку из XML кода.

Рассматриваемый подход дает возможность наиболее удобно интегрировать обработку XML объектов в среду разработки Delphi и C++Builder. Возможность доступа к свойствам объектов определяется RTTI. Его возможности в Delphi очень велики, т.к. среда разработки сама хранит ресурсы объектов в текстовом формате.

Для начала определим ряд простых функций для формирования XML кода. Они позволят нам добавлять открывающие, закрывающие теги и значения в результирующий текст.

  { Добавляет открывающий тег с заданным именем } 
  procedure addOpenTag(const Value: string); 
  begin 
    Result := Result + '<' + Value + '>'; 
    inc(Level); 
  end; 
 
  { Добавляет закрывающий тег с заданным именем } 
  procedure addCloseTag(const Value: string; addBreak: boolean = false); 
  begin 
    dec(Level); 
    Result := Result + '</' + Value + '>'; 
  end; 
 
  { Добавляет значение в результирующую строку } 
  procedure addValue(const Value: string); 
  begin 
    Result := Result + Value; 
  end; 


Следующее, что предстоит реализовать - это перебор всех свойств объекта и формирование тегов. Сведения о свойствах получаются через интерфейс компонента. Это информация о типе. Для каждого свойства, за исключением классовых получается их имя и текстовое значение, после чего формируется XML-тег. Значение загружается через ф-ию TypInfo.GetPropValue();

 { Playing with RTTI } 
  TypeInf := Component.ClassInfo; 
  AName := TypeInf^.Name; 
  TypeData := GetTypeData(TypeInf); 
  NumProps := TypeData^.PropCount; 
 
 
  GetMem(PropList, NumProps*sizeof(pointer)); 
  try 
    { Получаем список строк } 
    GetPropInfos(TypeInf, PropList); 
 
    for i := 0 to NumProps-1 do 
    begin 
      PropName := PropList^[i]^.Name; 
 
      PropTypeInf := PropList^[i]^.PropType^; 
      PropInfo := PropList^[i]; 
 
      case PropTypeInf^.Kind of 
        tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, 
        tkWChar, tkLString, tkWString, tkVariant: 
        begin 
          { Получение значения свойства } 
	  sPropValue := GetPropValue(Component, PropName, true); 
 
          { Перевод в XML } 
          addOpenTag(PropName); 
          addValue(sPropValue); { Добавляем значение свойства в результат } 
          	 addCloseTag(PropName); 
        end;
        ...


Для классовых типов придется использовать рекурсию для загрузки всех свойств соответствующего объекта.
Более того, для ряда классов необходимо использовать особый подход. Сюда относятся, к примеру, строковые списки и коллекции. Ими и ограничимся.

Для текстового списка TStrings будем сохранять в XML его свойство CommaText, а в случае коллекции после обработки всех ее свойств сохраним в XML каждый элемент TCollectionItem отдельно. При этом в качестве контейнерного тега будем использовать имя класса TCollection(PropObject).Items[j].ClassName.

        ...
        tkClass: { Для классовых типов рекурсивная обработка } 
        	begin 
          addOpenTag(PropName); 
 
          PropObject := GetObjectProp(Component, PropInfo); 
          if Assigned(PropObject)then 
          begin 
            { Для дочерних свойств-классов - рекурсивный вызов } 
	            if (PropObject is TPersistent) then 
               Result := Result + SerializeInternal(PropObject, Level); 
 
            { Индивидуальный подход к некоторым классам } 
	            if (PropObject is TStrings) then { Текстовые списки } 
	            begin 
              Result := Result + TStrings(PropObject).CommaText; 
            end else 
            if (PropObject is TCollection) then { Коллекции } 
	            begin 
              Result := Result + SerializeInternal(PropObject, Level); 
              for j := 0 to (PropObject as TCollection).Count-1 do 
              begin 
                addOpenTag(TCollection(PropObject).Items[j].ClassName); 
                Result := Result + 
                 SerializeInternal(TCollection(PropObject).Items[j], Level); 
                addCloseTag(TCollection(PropObject).Items[j].ClassName, true); 
              end 
            end; 
            { Здесь можно добавить обработку остальных классов: TTreeNodes, TListItems } 
          end; 
          addCloseTag(PropName, true); 
        end; 


Описанные функции позволят нам получить XML код для объекта включая все его свойства. Остается только 'обернуть' полученный XML в тег верхнего уровня - имя класса объекта. Если мы поместим вышеприведенный код в функцию SerializeInternal(), то результирующая функция Serialize() будет выглядеть так:

procedure Serialize(Component: TObject;); 
...
  Result := Result + '<' + Component.ClassName + '>'; 
  Result := Result + SerializeInternal(Component);  преобразовать свойства в XML
  Result := Result + '</' + Component.ClassName + '>'; 


К вышеприведенному можно добавить еще ф-ии для форматирования генерируемого XML кода. Также можно добавить пропуск пустых значений и свойств со значениями по умолчанию.

Андрей Чудин, ЦПР ТД Библио-Глобус.