Остается только код, который загрузит
Остается только код, который загрузит найденные данные в заданной свойство. Процедуре SetPropertyValue() передаются данные о соответствующем свойстве (PropInfo), которое на следует проинициализировать. Также процедура получает и текстовое значение, содержащееся в найденном теге.
В случае, если тип данные не является классовым типом, то, очевидно, текст Value следует просто загрузить в свойство. Это реализуется вызовом процедуры TypInfo.SetPropValue(). Последняя самостоятельно разберется, как корректно преобразовать тестовое значение в значение свойства в завистимости от его типа.
Если свойство имеет классовый тип, то его значение Value должно содержать XML код, описывающий свойства данного класса. В этом случае воспользуемся рекурсией и передадим обработку вышеприведенной процедуре DeSerializeInternal(). При этом передаем ей в качестве объекта ссылку на найденное свойство PropObject и его имя PropInfo^.Name.
Нам также необходимо озаботиться отдельной обработкой данных для таких классовых типов как списки TStrings и коллекции TCollection. Данные для списков мы загружаем из значения Value как CommaText. Тут все понятно. В сллучае же коллеций данные о элементах коллекции в XML документе содержаться в виде последовательных контейнерных тегов с именем типа элемента коллекци. Т.е., к примеру, <TMyCollection> ... </TMyCollection> <TMyCollection> ... </TMyCollection> <TMyCollection> ... </TMyCollection> и так далее. Внутри каждой пары тегов <TMyCollection> содержатся свойства объекта 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 сериализации.
Продолжение
Содержание Назад Вперед
