это перебор всех свойств объекта

{ пишет строку в выходящий поток. Исп-ся при сериализации } procedure WriteOutStream(Value: string); begin OutStream.Write(Pchar(Value)[0], Length(Value)); end; { Добавляет открывающий тег с заданным именем } procedure addOpenTag(const Value: string); begin WriteOutStream(CR + DupStr(TAB, Level) + ''); inc(Level); end; { Добавляет закрывающий тег с заданным именем } procedure addCloseTag(const Value: string; addBreak: boolean = false); begin dec(Level); if addBreak then WriteOutStream(CR + DupStr(TAB, Level)); WriteOutStream('</' + Value + '>'); end; { Добавляет значение в результирующую строку } procedure addValue(const Value: string); begin WriteOutStream(Value); end;






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



procedure TglXMLSerializer.SerializeInternal(Component: TObject; Level: integer = 1); var PropInfo: PPropInfo; TypeInf, PropTypeInf: PTypeInfo; TypeData: PTypeData; i, j: integer; AName, PropName, sPropValue: string; PropList: PPropList; NumProps: word; PropObject: TObject; begin { 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; ...


Содержание  Назад  Вперед

---

---