Андрей Чудин
дата публикации 01-10-2001 12:28 Загрузка XML в объект
После того, как мы рассмотрели возможность превода данных объекта в XML следует перейти к следующей задаче.
Задача состоит в реализации обратного процесса, а именно - загрузки XML данных в объект.
Загрузка XML данных в объект, или десериализация, представляет собой более сложный процесс, т.к. в ходе его
необходимо осуществить корректный разбор текстового XML документа на предмет инициализации содержащимися в нем данными заданного объекта.
Примем ряд упрощений, которые сократят число проверок корректности входящего XML документа к минимуму.
Первое, что необходимо делать, тек это проверять соответствие тега верхнего уровня имени класса нашего объекта.
Синтаксическая правильность документа будет проверяться в ходе загрузки данных. При необходимости более жесткой проверки
загружаемых XML документов можно привлечь, к примеру, парсер MSXML. Последний поможет нам проверить документ на синтаксическую,
а также семантическую корректность при наличии соответствующего DTD.
Первое, что следует реализовать, это процедура верхнего уровня, которая получает объект для инициализации, а также
потоковый источник данных с текстом XML документа.
var
Buffer: PChar; { Буфер, в котором находится XML документ }
TokenPtr: PChar; { Указатель на текущее положение парсера XML документа }
{
Загружает в компонент данные из потока с XML-кодом.
Вход:
Component - компонент для конвертации
Stream - источник загрузки XML
Предусловия:
Объект Component должен быть создан до вызова процедуры
}
procedure DeSerialize(Component: TObject; Stream: TStream);
begin
GetMem(Buffer, Stream.Size);
try
{ Получаем данные из потока }
Stream.Read(Buffer[0], Stream.Size + 1);
{ Устанавливаем текущий указатель чтения данных }
TokenPtr := Buffer;
{ Вызываем загрузчик }
DeSerializeInternal(Component, Component.ClassName);
finally
FreeMem(Buffer);
end;
end;
|
Следующий код занимается тривиальным разбором XML текста. Ищется первый открывающий тег, затем его закрывающая пара.
Найденная пара содержит в себе данные для свойств объекта.
Внутри найденной пары тегов последовательно выбираются теги (TagName) и текст их содержания (TagValue). Эти теги
предположительно соответствуют свойствам объекта, что мы тут же и проверяем. Обратите внимание, что функция StrPos заменена
на StrPosExt для ускорения обработки.
Среди свойств объекта отыскивается через FindProperty() одноименное свойство. При неудаче генерируется исключение об ошибочности
XML тега. Если для тега найдено соответвующее свойство, то передаем дальнейшую обработку процедуре SetPropertyValue(), которая
заданное свойство с именем TagName проинициализирует найденным значением TagValue.
Не забываем также передвигать указатель чтения данных TokenPtr по мере выборки данных.
{
Рекурсивная процедура загрузки объекта их текстового буфера с XML
Вызывается из:
Serialize()
Вход:
Component - компонент для конвертации
ComponentTagName - имя XML тега объекта
}
procedure DeSerializeInternal(Component: TObject; const ComponentTagName: string);
var
BlockStart, BlockEnd, TagStart, TagEnd: PChar;
TagName, TagValue: PChar;
TypeInf: PTypeInfo;
TypeData: PTypeData;
PropIndex: integer;
AName: string;
PropList: PPropList;
NumProps: word;
{ Поиск у объекта свойства с заданным именем }
function FindProperty(TagName: PChar): integer;
var i: integer;
begin
Result := -1;
for i := 0 to NumProps-1 do
if CompareText(PropList^[i]^.Name, TagName) = 0 then
begin
Result := i;
break;
end;
end;
procedure SkipSpaces(var TagEnd: PChar);
begin
while (TagEnd[0] in [#0..#20]) do inc(TagEnd);
end;
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);
{ ищем открывающий тег }
BlockStart := StrPosExt(TokenPtr, PChar('<' + ComponentTagName + '>'), BufferLength);
inc(BlockStart, length(ComponentTagName) + 2);
{ ищем закрывающий тег }
BlockEnd := StrPosExt(BlockStart, PChar('<' + ComponentTagName + '>'), BufferLength);
TagEnd := BlockStart;
SkipSpaces(TagEnd);
{ XML парсер }
while TagEnd < BlockEnd do
begin
TagStart := StrPosExt(TagEnd, '<', BufferLength);
TagEnd := StrPos(TagStart, '>', BufferLength);
GetMem(TagName, TagEnd - TagStart + 1);
try
{ TagName - имя тега }
StrLCopy(TagName, TagStart + 1, TagEnd - TagStart - 1);
TagEnd := StrPos(TagStart, PChar(''));
TokenPtr := TagStart;
inc(TagStart, length('')-1);
GetMem(TagValue, TagEnd - TagStart + 1);
try
{ TagValue - значение тега }
StrLCopy(TagValue, TagStart, TagEnd - TagStart);
{ поиск свойства, соответствующего тегу }
PropIndex := FindProperty(TagName);
if PropIndex = -1 then
raise Exception.Create(
'TglXMLSerializer.DeSerializeInternal: Uncknown property: ' + TagName);
SetPropertyValue(Component, PropList^[PropIndex], TagValue);
inc(TagEnd, length(''));
SkipSpaces(TagEnd);
finally
FreeMem(TagValue);
end;
finally
FreeMem(TagName);
end;
end;
finally
FreeMem(PropList, NumProps*sizeof(pointer));
end;
end;
|
Остается только код, который загрузит найденные данные в заданной свойство.
Процедуре SetPropertyValue() передаются данные о соответствующем свойстве (PropInfo), которое на следует проинициализировать.
Также процедура получает и текстовое значение, содержащееся в найденном теге.
В случае, если тип данные не является классовым типом, то, очевидно, текст Value следует просто загрузить в свойство.
Это реализуется вызовом процедуры TypInfo.SetPropValue(). Последняя самостоятельно разберется, как корректно преобразовать
тестовое значение в значение свойства в завистимости от его типа.
Если свойство имеет классовый тип, то его значение Value должно содержать XML код, описывающий свойства данного класса.
В этом случае воспользуемся рекурсией и передадим обработку вышеприведенной процедуре DeSerializeInternal(). При этом передаем
ей в качестве объекта ссылку на найденное свойство PropObject и его имя PropInfo^.Name.
Нам также необходимо озаботиться отдельной обработкой данных для таких классовых типов как списки TStrings и коллекции TCollection.
Данные для списков мы загружаем из значения Value как CommaText. Тут все понятно.
В сллучае же коллеций данные о элементах коллекции в XML документе содержаться в виде последовательных контейнерных тегов с именем
типа элемента коллекци. Т.е., к примеру,
... ...
... и так далее. Внутри каждой пары тегов содержатся свойства
объекта TMyCollection.
procedure SetPropertyValue(Component: TObject; PropInfo: PPropInfo; Value: PChar);
var
PropTypeInf: PTypeInfo;
PropObject: TObject;
CollectionItem: TCollectionItem;
sValue: string;
begin
PropTypeInf := PropInfo.PropType^;
case PropTypeInf^.Kind of
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
tkWChar, tkLString, tkWString, tkVariant:
begin
sValue := StrPas(Value);
{ Для корректного преобразования парсером tkSet нужны угловые скобки }
if PropTypeInf^.Kind = tkSet then sValue := '[' + sValue + ']';
SetPropValue(Component, PropInfo^.Name, sValue);
end;
tkClass:
begin
PropObject := GetObjectProp(Component, PropInfo);
if Assigned(PropObject)then
begin
{ Индивидуальный подход к некоторым классам }
if (PropObject is TStrings) then { Текстовые списки }
TStrings(PropObject).CommaText := Value
else
if (PropObject is TCollection) then { Коллекции }
begin
while true do { Заранее не известно число элементов в коллекции }
begin
CollectionItem := (PropObject as TCollection).Add;
try
DeSerializeInternal(CollectionItem, CollectionItem.ClassName);
except { Исключение, если очередной элемент не найден }
CollectionItem.Free;
break;
end;
end;
end
else { Для остальных классов - рекурсивная обработка }
DeSerializeInternal(PropObject, PropInfo^.Name);
end;
end;
end;
end;
{
StrPosExt - ищет позицию одной строки в другой с заданной длиной.
На длинных строках превосходит StrPos.
}
function StrPosExt(const Str1, Str2: PChar; Str2Len: DWORD): PChar; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
OR EAX,EAX // Str1
JE @@2 // если строка Str1 пуста - на выход
OR EDX,EDX // Str2
JE @@2 // если строка Str2 пуста - на выход
MOV EBX,EAX
MOV EDI,EDX // установим смещение для SCASB - подстрока Str2
XOR AL,AL // обнулим AL
push ECX // длина строки
MOV ECX,0FFFFFFFFH // счетчик с запасом
REPNE SCASB // ищем конец подстроки Str2
NOT ECX // инвертируем ECX - получаем длину строки+1
DEC ECX // в ECX - длина искомой подстроки Str2
JE @@2 // при нулевой длине - все на выход
MOV ESI,ECX // сохраняем длину подстроки в ESI
pop ECX
SUB ECX,ESI // ECX == разница длин строк : Str1 - Str2
JBE @@2 // если длина подсроки больше длине строки - выход
MOV EDI,EBX // EDI - начало строки Str1
LEA EBX,[ESI-1] // EBX - длина сравнения строк
@@1: MOV ESI,EDX // ESI - смещение строки Str2
LODSB // загужаем первый символ подстроки в AL
REPNE SCASB // ищем этот символ в строке EDI
JNE @@2 // если символ не обнаружен - на выход
MOV EAX,ECX // сохраним разницу длин строк
PUSH EDI // запомним текущее смещение поиска
MOV ECX,EBX
REPE CMPSB // побайтно сравниваем строки
POP EDI
MOV ECX,EAX
JNE @@1 // если строки различны - ищем следующее совпадение первого символа
LEA EAX,[EDI-1]
JMP @@3
@@2: XOR EAX,EAX
@@3: POP EBX
POP ESI
POP EDI
end;
|
К приведенному коду следует добавить еще ряд возможностей для более корректной реакции для
обработки неверного XML кода. Также можно достаточно просто реализовать автоматическую генерацию DTD
для любого класса Delphi. После этого можно собрать полноценный компонент, объединяющий в
себе всю необходимую функциональность для XML сериализации.
Продолжение:
[XML]
 Обсуждение материала нет сообщений |
