paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 00:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

reading components from XML: implemented reading properties and collections

Browse Source 
git-svn-id: trunk@9162 -
This commit is contained in:
mattias 2006-04-22 22:00:34 +00:00
parent c0fe7541cd
commit a6dce8e43a
2 changed files with 337 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

367
components/codetools/laz_xmlstreaming.pas
View File

@ -85,13 +85,14 @@ type
private
FDoc: TDOMDocument;
FElement: TDOMElement;
FElementPosition: integer;
FRootEl: TDOMElement;
function ReadNextValue(Stay: Boolean): TValueType;
public
constructor Create(ADoc: TDOMDocument; const APath: string);
destructor Destroy; override;
function GetRootClassName(out IsInherited: Boolean): string;
function GetNextElement: TDOMElement; virtual;
{ All ReadXXX methods are called _after_ the value type has been read! }
function NextValue: TValueType; override;
@ -111,7 +112,7 @@ type
function ReadInt16: SmallInt; override;
function ReadInt32: LongInt; override;
function ReadInt64: Int64; override;
function ReadSet(EnumType: Pointer): Integer; override;
function ReadSet(SetType: Pointer): Integer; override;
function ReadStr: String; override;
function ReadString(StringType: TValueType): String; override;
function ReadWideString: WideString; override;
@ -120,6 +121,7 @@ type
public
property Doc: TDOMDocument read FDoc;
property Element: TDOMElement read FElement;// current element node
property ElementPosition: integer read FElementPosition;
end;
TXMLObjectReaderClass = class of TXMLObjectReader;
@ -414,6 +416,185 @@ end;
{ TXMLObjectReader }
function TXMLObjectReader.ReadNextValue(Stay: Boolean): TValueType;
procedure RaiseUnknownNode(Node: TDOMNode);
begin
raise EReadError.Create('TXMLObjectReader: unknown node '+Node.NodeName);
end;
procedure RaiseUnknownParentNode(Node: TDOMNode);
begin
raise EReadError.Create('TXMLObjectReader: unknown parent node '+Node.NodeName);
end;
procedure RaiseInvalidElementPosition;
begin
raise EReadError.Create('TXMLObjectReader: invalid ElementPosition='+IntToStr(FElementPosition)+' Node='+FElement.NodeName);
end;
procedure RaiseNodeNotFound(const NodeName: string);
begin
raise EReadError.Create('TXMLObjectReader: invalid Node='+FElement.NodeName);
end;
var
CurValue: String;
CurInt64: Int64;
begin
writeln('TXMLObjectReader.ReadNextValue Stay=',Stay,' Element=',FElement.NodeName,' Pos=',FElementPosition);
if FElement.NodeName='properties' then begin
// FElement is at end of property list
writeln('TXMLObjectReader.ReadNextValue FElement is at end of property list');
Result:=vaNull;
end
else if FElement.NodeName='list' then begin
// FElement is a list element
// It has 2 positions:
// 0: vaList
// 1: end of list
case FElementPosition of
0:begin
writeln('TXMLObjectReader.ReadNextValue list: vaList');
Result:=vaList;
if (FElement.FirstChild is TDOMElement) then begin
// the list has childs
if not Stay then begin
FElement:=TDOMElement(FElement.FirstChild);
FElementPosition:=0;
end;
end else begin
// empty list
if not Stay then
inc(FElementPosition);
end;
end;
1:begin
// end of list
Result:=vaNull;
if not Stay then begin
if (FElement.NextSibling is TDOMElement) then begin
writeln('TXMLObjectReader.ReadNextValue list: end of childs, next list');
FElement:=TDOMElement(FElement.NextSibling);
FElementPosition:=0;
end else begin
writeln('TXMLObjectReader.ReadNextValue list: end of childs, end of collection');
FElement:=FElement.ParentNode as TDOMElement;
FElementPosition:=0;
end;
end;
end;
end;
end
else if FElement.NodeName='collection' then begin
// FElement is at end of collection
writeln('TXMLObjectReader.ReadNextValue FElement is at end of collection');
Result:=vaNull;
end
else if (FElement.ParentNode.NodeName='properties')
or (FElement.ParentNode.NodeName='list') then begin
// FElement is a property
// It has 3 positions:
// 0: name
// 1: value type
// 2: value
case FElementPosition of
0:// the property name
begin
Result:=vaString;
if not Stay then
inc(FElementPosition);
end;
1:// value type
begin
if FElement.NodeName='integer' then begin
CurValue:=FElement['value'];
CurInt64:=StrToInt64(CurValue);
if (CurInt64 >= -128) and (CurInt64 <= 127) then begin
Result:=vaInt8
end else if (CurInt64 >= -32768) and (CurInt64 <= 32767) then begin
Result:=vaInt16;
end else if (CurInt64 >= Low(Integer)) and (CurInt64 <= High(integer))
then begin
Result:=vaInt32;
end else
Result:=vaInt64;
end else if FElement.NodeName='string' then begin
CurValue:=FElement['value'];
if length(CurValue)<=255 then
Result:=vaString
else
Result:=vaLString;
end else if FElement.NodeName='ident' then
Result:=vaIdent
else if FElement.NodeName='boolean' then begin
if FElement['value']='true' then
Result:=vaTrue
else
Result:=vaFalse;
end else if FElement.NodeName='set' then
Result:=vaSet
else if FElement.NodeName='extended' then
Result:=vaExtended
else if FElement.NodeName='widestring' then
Result:=vaWString
else if FElement.NodeName='collectionproperty' then
Result:=vaCollection
else
RaiseUnknownNode(FElement);
if not Stay then begin
inc(FElementPosition);
case Result of
vaTrue, vaFalse: ReadValue;
vaCollection:
begin
// go to node 'collection'
FElement:=FElement.FirstChild as TDOMElement;
if FElement.NodeName<>'collection' then
RaiseNodeNotFound('collection');
FElementPosition:=0;
// go to node 'list'
FElement:=FElement.FirstChild as TDOMElement;
if FElement.NodeName<>'list' then
RaiseNodeNotFound('list');
end;
end;
end;
end;
2:// value
begin
if FElement.NextSibling<>nil then begin
Result:=vaString;
if not Stay then begin
FElement:=FElement.NextSibling as TDOMElement;
FElementPosition:=0;
end;
end else begin
// end of property list
Result:=vaNull;
if not Stay then begin
FElement:=FElement.ParentNode as TDOMElement;
FElementPosition:=0;
if FElement.NodeName='list' then
FElementPosition:=1;
end;
end;
end;
else
RaiseInvalidElementPosition;
end;
end else begin
RaiseUnknownParentNode(FElement.ParentNode);
end;
writeln('TXMLObjectReader.ReadNextValue Result=',GetEnumName(TypeInfo(TValueType),ord(Result)));
end;
constructor TXMLObjectReader.Create(ADoc: TDOMDocument; const APath: string);
var
Node: TDOMNode;
@ -461,6 +642,7 @@ begin
RaiseNotDOMElement;
FRootEl:=TDOMElement(Node);
FElement:=FRootEl;
FElementPosition:=0;
end;
destructor TXMLObjectReader.Destroy;
@ -488,50 +670,14 @@ begin
// TODO: IsInherited
end;
function TXMLObjectReader.GetNextElement: TDOMElement;
var
Node: TDOMNode;
begin
Result:=TDOMElement(FElement.FirstChild);
if (Result is TDOMElement) then exit;
Node:=FElement;
while Node<>nil do begin
Result:=TDOMElement(Node.NextSibling);
if Result is TDOMElement then exit;
Node:=Node.ParentNode;
end;
Result:=nil;
end;
function TXMLObjectReader.NextValue: TValueType;
var
NextElement: TDOMElement;
begin
writeln('TXMLObjectReader.NextValue START');
Result:=vaNull;
NextElement:=GetNextElement;
if NextElement<>nil then begin
writeln('TXMLObjectReader.NextValue Value=',NextElement.NodeName);
if NextElement.NodeName='extended' then
Result:=vaExtended;
end;
Result:=ReadNextValue(true);
end;
function TXMLObjectReader.ReadValue: TValueType;
var
NextElement: TDOMElement;
begin
writeln('TXMLObjectReader.ReadValue START');
Result:=vaNull;
NextElement:=GetNextElement;
if NextElement<>nil then begin
writeln('TXMLObjectReader.ReadValue Value=',NextElement.NodeName);
if NextElement.NodeName='extended' then
Result:=vaExtended;
if Result<>vaNull then begin
FElement:=NextElement;
end;
end;
Result:=ReadNextValue(false);
end;
procedure TXMLObjectReader.BeginRootComponent;
@ -574,14 +720,19 @@ begin
raise Exception.Create('properties node not found');
if not (PropertiesNode is TDOMElement) then
raise Exception.Create('properties node is not a dom element');
// if there are properties, then set FElement to the first property
FElement:=TDOMElement(PropertiesNode);
if FElement.FirstChild is TDOMElement then
FElement:=TDOMElement(FElement.FirstChild);
FElementPosition:=0;
end;
function TXMLObjectReader.BeginProperty: String;
begin
ReadValue;
Result:=FElement['name'];
writeln('TXMLObjectReader.BeginProperty Result="',Result,'"');
inc(FElementPosition);
end;
procedure TXMLObjectReader.ReadBinary(const DestData: TMemoryStream);
@ -590,90 +741,188 @@ begin
end;
function TXMLObjectReader.ReadFloat: Extended;
var
Value: String;
FloatError: integer;
Back: extended;
begin
writeln('TXMLObjectReader.ReadFloat ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadFloat ',Result);
end;
function TXMLObjectReader.ReadSingle: Single;
var
Value: String;
FloatError: integer;
Back: single;
begin
writeln('TXMLObjectReader.ReadSingle ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadSingle ',Result);
end;
function TXMLObjectReader.ReadCurrency: Currency;
var
Value: String;
FloatError: integer;
Back: currency;
begin
writeln('TXMLObjectReader.ReadCurrency ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadCurrency ',Result);
end;
function TXMLObjectReader.ReadDate: TDateTime;
var
Value: String;
FloatError: integer;
Back: Double;
begin
writeln('TXMLObjectReader.ReadDate ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadDate ',Result);
end;
function TXMLObjectReader.ReadIdent(ValueType: TValueType): String;
begin
writeln('TXMLObjectReader.ReadIdent ');
Result:='';
Result:=FElement['value'];
ReadValue;
writeln('TXMLObjectReader.ReadIdent ',Result);
end;
function TXMLObjectReader.ReadInt8: ShortInt;
var
Value: String;
FloatError: integer;
Back: ShortInt;
begin
writeln('TXMLObjectReader.ReadInt8 ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadInt8 ',Result);
end;
function TXMLObjectReader.ReadInt16: SmallInt;
var
Value: String;
FloatError: integer;
Back: SmallInt;
begin
writeln('TXMLObjectReader.ReadInt16 ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadInt16 ',Result);
end;
function TXMLObjectReader.ReadInt32: LongInt;
var
Value: String;
FloatError: integer;
Back: Longint;
begin
writeln('TXMLObjectReader.ReadInt32 ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadInt32 ',Result);
end;
function TXMLObjectReader.ReadInt64: Int64;
var
Value: String;
FloatError: integer;
Back: Int64;
begin
writeln('TXMLObjectReader.ReadInt64 ');
Result:=0;
Value:=FElement['value'];
Val(Value, Back, FloatError);
Result:=Back;
ReadValue;
writeln('TXMLObjectReader.ReadInt64 ',Result);
end;
function TXMLObjectReader.ReadSet(EnumType: Pointer): Integer;
function TXMLObjectReader.ReadSet(SetType: Pointer): Integer;
var
s: String;
StartPos: Integer;
EndPos: LongInt;
Name: String;
i: LongInt;
begin
writeln('TXMLObjectReader.ReadSet ');
Result:=0;
s:=FElement['value'];
StartPos:=1;
while (StartPos<=length(s)) do begin
EndPos:=StartPos;
while (EndPos<=length(s)) and (s[EndPos]<>',') do inc(EndPos);
if EndPos>StartPos then begin
Name:=copy(s,StartPos,EndPos-StartPos);
i:=GetEnumValue(PTypeInfo(SetType),Name);
Result:=Result or (1 shl i);
end;
StartPos:=EndPos+1;
end;
ReadValue;
writeln('TXMLObjectReader.ReadSet ',HexStr(Cardinal(Result),8));
end;
function TXMLObjectReader.ReadStr: String;
begin
writeln('TXMLObjectReader.ReadStr ');
Result:='';
Result:=FElement['value'];
ReadValue;
writeln('TXMLObjectReader.ReadStr "',Result,'"');
end;
function TXMLObjectReader.ReadString(StringType: TValueType): String;
begin
writeln('TXMLObjectReader.ReadString ');
Result:='';
Result:=FElement['value'];
if (StringType=vaString) and (length(Result)>255) then
raise Exception.Create('TXMLObjectReader.ReadString invalid StringType');
ReadValue;
writeln('TXMLObjectReader.ReadString "',Result,'"');
end;
function TXMLObjectReader.ReadWideString: WideString;
var
ValueAsUTF8: String;
begin
writeln('TXMLObjectReader.ReadWideString ');
Result:='';
ValueAsUTF8:=FElement['value'];
Result:=System.UTF8Decode(ValueAsUTF8);
ReadValue;
writeln('TXMLObjectReader.ReadWideString "',ValueAsUTF8,'"');
end;
procedure TXMLObjectReader.SkipComponent(SkipComponentInfos: Boolean);
var
NextNode: TDOMNode;
begin
NextNode:=FElement.NextSibling;
if (NextNode=nil) or (NextNode is TDOMElement) then
FElement:=TDOMElement(NextNode);
writeln('TXMLObjectReader.SkipComponent ');
end;
procedure TXMLObjectReader.SkipValue;
begin
ReadValue;
writeln('TXMLObjectReader.SkipValue ');
end;

31
examples/xmlstreaming/mainunit.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Laz_XMLStreaming, Laz_DOM, laz_xmlcfg, Buttons;
StdCtrls, Laz_XMLStreaming, Laz_DOM, laz_xmlcfg, Buttons, TypInfo;
type
TMyEnum = (myEnum1, myEnum2, myEnum3);
@ -29,6 +29,7 @@ type
FMyCollection: TCollection;
FMyDouble: Double;
FMyEnum: TMyEnum;
FMyInt64: int64;
FMyInteger: integer;
FMySet: TMySet;
FMySingle: Single;
@ -36,15 +37,17 @@ type
FMyWideString: widestring;
public
constructor Create(TheOwner: TComponent); override;
procedure WriteDebugReport;
published
property MyDouble: Double read FMyDouble write FMyDouble;
property MySingle: Single read FMySingle write FMySingle;
property MyWideString: widestring read FMyWideString write FMyWideString;
property MyInteger: integer read FMyInteger write FMyInteger;
property MyString: string read FMyString write FMyString;
property MyEnum: TMyEnum read FMyEnum write FMyEnum;
property MyInt64: int64 read FMyInt64 write FMyInt64;
property MySet: TMySet read FMySet write FMySet;
property MyBoolean: Boolean read FMyBoolean write FMyBoolean;
property MyEnum: TMyEnum read FMyEnum write FMyEnum;
property MyCollection: TCollection read FMyCollection write FMyCollection;
end;
@ -247,6 +250,8 @@ begin
NewComponent:=nil;
ReadComponentFromXMLConfig(XMLConfig,'Component',NewComponent,
@OnFindComponentClass,DestinationGroupBox);
if NewComponent is TMyComponent then
TMyComponent(NewComponent).WriteDebugReport;
XMLConfig.Flush;
finally
XMLConfig.Free;
@ -282,12 +287,34 @@ begin
MyWideString:='Some text as widestring';
MyInteger:=1234;
MyBoolean:=true;
MyInt64:=1234567890987654321;
MyCollection:=TCollection.Create(TMyCollectionItem);
TMyCollectionItem(MyCollection.Add).MyString:='First';
TMyCollectionItem(MyCollection.Add).MyString:='Second';
TMyCollectionItem(MyCollection.Add).MyString:='Third';
end;
procedure TMyComponent.WriteDebugReport;
var
i: Integer;
Item: TMyCollectionItem;
begin
writeln('TMyComponent.WriteDebugReport ');
writeln(' MyDouble=',MyDouble);
writeln(' MySingle=',MySingle);
writeln(' MyEnum=',GetEnumName(TypeInfo(TMyEnum),ord(MyEnum)));
writeln(' MySet=',HexStr(Cardinal(MySet),8));
writeln(' MyString=',MyString);
writeln(' MyWideString=',MyWideString);
writeln(' MyInteger=',MyInteger);
writeln(' MyInt64=',MyInt64);
writeln(' MyCollection.Count=',MyCollection.Count);
for i:=0 to MyCollection.Count-1 do begin
Item:=TMyCollectionItem(MyCollection.Items[i]);
writeln(' ',i,' MyString=',Item.MyString);
end;
end;
initialization
{$I mainunit.lrs}