Рекурсивная процедура загрузки объекта их
{ Рекурсивная процедура загрузки объекта их текстового буфера с 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('</' + TagName + '>')); TokenPtr := TagStart; inc(TagStart, length('</' + TagName + '>')-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('</' + TagName + '>')); SkipSpaces(TagEnd); finally FreeMem(TagValue); end; finally FreeMem(TagName); end; end; finally FreeMem(PropList, NumProps*sizeof(pointer)); end; end;
Содержание Назад Вперед
|