1004 lines
34 KiB
ObjectPascal
1004 lines
34 KiB
ObjectPascal
|
|
{-----------------------------------------------------------------------------
|
|||
|
|
The contents of this file are subject to the Mozilla Public License
|
|||
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|||
|
|
with the License. You may obtain a copy of the License at
|
|||
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|||
|
|
|
|||
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|||
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|||
|
|
the specific language governing rights and limitations under the License.
|
|||
|
|
|
|||
|
|
The Original Code is: JvgXMLSerializer.PAS, released on 2003-01-15.
|
|||
|
|
|
|||
|
|
The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru]
|
|||
|
|
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
|
|||
|
|
All Rights Reserved.
|
|||
|
|
|
|||
|
|
Contributor(s):
|
|||
|
|
Michael Beck [mbeck att bigfoot dott com].
|
|||
|
|
Burov Dmitry, translation of russian text.
|
|||
|
|
|
|||
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|||
|
|
located at http://jvcl.sourceforge.net
|
|||
|
|
|
|||
|
|
Description:
|
|||
|
|
The component converts given component to XML and back according to
|
|||
|
|
published interface of its class.
|
|||
|
|
|
|||
|
|
XML is made of tags pairs with values put inside. Tags can have no attributes
|
|||
|
|
|
|||
|
|
Topmost tag matches class of the object. Inner tags match properties' names.
|
|||
|
|
For TCollectionItem containing tag matches the name of the class
|
|||
|
|
|
|||
|
|
Tags' nesting is unlimited and repeats(reproduces) the whole published
|
|||
|
|
interface of class of the given object
|
|||
|
|
|
|||
|
|
The following types are supported: integer numbers, floats, enumerations,
|
|||
|
|
sets, strings and chars, variants, classes, stringlists and collections.
|
|||
|
|
|
|||
|
|
Interface:
|
|||
|
|
procedure Serialize(Component: TObject; Stream: TStream);
|
|||
|
|
- Serialization TPersistent -> XML
|
|||
|
|
procedure DeSerialize(Component: TObject; Stream: TStream);
|
|||
|
|
- Loading XML -> TPersistent
|
|||
|
|
|
|||
|
|
property GenerateFormattedXML - Generate Formatted XML
|
|||
|
|
property ExcludeEmptyValues - Skip properties with empty values
|
|||
|
|
property ExcludeDefaultValues - Skip properties with default values
|
|||
|
|
property StrongConformity - Requires XML to has all the corresponding
|
|||
|
|
tags for all class types
|
|||
|
|
property IgnoreUnknownTags - ignore unknown tags when loading XML
|
|||
|
|
property OnGetXMLHeader - Allows to specifies one's own XML header //AFAIR - topmost XML tag
|
|||
|
|
|
|||
|
|
WrapCollections - Wrap collections in individual(dedicated) tags
|
|||
|
|
|
|||
|
|
Limitations:
|
|||
|
|
Each object can have only one collection per collection item class
|
|||
|
|
TStrings derivatives must have no published properties
|
|||
|
|
Procedure types are not supported
|
|||
|
|
|
|||
|
|
To generate DTD it needs object to has all class-properties, with names same
|
|||
|
|
to properties of agregated objects, of single(the same, "one") class
|
|||
|
|
|
|||
|
|
Preconditions:
|
|||
|
|
Object for de-serializatino into, is to be created prior to procedure's call.
|
|||
|
|
|
|||
|
|
Is StringConformity then loading XML must contain tags for all the class-types.
|
|||
|
|
Presence of other tags is not checked.
|
|||
|
|
|
|||
|
|
Extra:
|
|||
|
|
When loading TCollection from XML, it is not voided (?) so you can load
|
|||
|
|
TCollection as a merge of different XML sources.
|
|||
|
|
|
|||
|
|
Known Issues:
|
|||
|
|
-----------------------------------------------------------------------------}
|
|||
|
|
// $Id: JvgXMLSerializer.pas 10612 2006-05-19 19:04:09Z jfudickar $
|
|||
|
|
|
|||
|
|
unit JvgXMLSerializer;
|
|||
|
|
|
|||
|
|
{$I jvcl.inc}
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
{$IFDEF UNITVERSIONING}
|
|||
|
|
JclUnitVersioning,
|
|||
|
|
{$ENDIF UNITVERSIONING}
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
Dialogs, ComCtrls, TypInfo,
|
|||
|
|
JvComponentBase;
|
|||
|
|
{$ELSE}
|
|||
|
|
Dialogs, ComCtrls, TypInfo;
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TOnGetXMLHeader = procedure(Sender: TObject; var Value: string) of object;
|
|||
|
|
TBeforeParsingEvent = procedure(Sender: TObject; Buffer: PChar) of object;
|
|||
|
|
|
|||
|
|
EJvgXMLSerializerException = class(Exception);
|
|||
|
|
XMLSerializerException = class(Exception);
|
|||
|
|
EJvgXMLOpenTagNotFoundException = class(XMLSerializerException);
|
|||
|
|
EJvgXMLCloseTagNotFoundException = class(XMLSerializerException);
|
|||
|
|
EJvgXMLUnknownPropertyException = class(XMLSerializerException);
|
|||
|
|
|
|||
|
|
TJvgXMLSerializerException = class of XMLSerializerException;
|
|||
|
|
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
TJvgXMLSerializer = class(TJvComponent)
|
|||
|
|
{$ELSE}
|
|||
|
|
TJvgXMLSerializer = class(TComponent)
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
private
|
|||
|
|
Buffer: PChar;
|
|||
|
|
BufferEnd: PChar;
|
|||
|
|
BufferLength: DWORD;
|
|||
|
|
TokenPtr {, MaxTokenPtr}: PChar;
|
|||
|
|
OutStream: TStream;
|
|||
|
|
FOnGetXMLHeader: TOnGetXMLHeader;
|
|||
|
|
FGenerateFormattedXML: Boolean;
|
|||
|
|
FExcludeEmptyValues: Boolean;
|
|||
|
|
FExcludeDefaultValues: Boolean;
|
|||
|
|
FReplaceReservedSymbols: Boolean;
|
|||
|
|
FStrongConformity: Boolean;
|
|||
|
|
FBeforeParsing: TBeforeParsingEvent;
|
|||
|
|
FWrapCollections: Boolean;
|
|||
|
|
FIgnoreUnknownTags: Boolean;
|
|||
|
|
procedure Check(Expr: Boolean; const Msg: string; E: TJvgXMLSerializerException);
|
|||
|
|
procedure WriteOutStream(const Value: string);
|
|||
|
|
protected
|
|||
|
|
procedure SerializeInternal(Component: TObject; Level: Integer = 1);
|
|||
|
|
procedure DeSerializeInternal(Component: TObject;
|
|||
|
|
ComponentTagName: string; ParentBlockEnd: PChar = nil);
|
|||
|
|
procedure GenerateDTDInternal(Component: TObject; DTDList: TStrings;
|
|||
|
|
Stream: TStream; const ComponentTagName: string);
|
|||
|
|
procedure SetPropertyValue(Component: TObject; PropInfo: PPropInfo; Value,
|
|||
|
|
ValueEnd: PChar; ParentBlockEnd: PChar);
|
|||
|
|
public
|
|||
|
|
DefaultXMLHeader: string;
|
|||
|
|
tickCounter: DWORD;
|
|||
|
|
tickCount: DWORD;
|
|||
|
|
constructor Create(AOwner: TComponent); override;
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML }
|
|||
|
|
{ Serialization of object to XML [translated] }
|
|||
|
|
procedure Serialize(Component: TObject; Stream: TStream);
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> XML <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Loading XML into object [translated] }
|
|||
|
|
procedure DeSerialize(Component: TObject; Stream: TStream);
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DTD }
|
|||
|
|
{ Genereating DTD [translated] }
|
|||
|
|
procedure GenerateDTD(Component: TObject; Stream: TStream);
|
|||
|
|
published
|
|||
|
|
property GenerateFormattedXML: Boolean read FGenerateFormattedXML write FGenerateFormattedXML default True;
|
|||
|
|
property ExcludeEmptyValues: Boolean read FExcludeEmptyValues write FExcludeEmptyValues;
|
|||
|
|
property ExcludeDefaultValues: Boolean read FExcludeDefaultValues write FExcludeDefaultValues;
|
|||
|
|
property ReplaceReservedSymbols: Boolean read FReplaceReservedSymbols write FReplaceReservedSymbols;
|
|||
|
|
property StrongConformity: Boolean read FStrongConformity write FStrongConformity default True;
|
|||
|
|
property IgnoreUnknownTags: Boolean read FIgnoreUnknownTags write FIgnoreUnknownTags;
|
|||
|
|
property WrapCollections: Boolean read FWrapCollections write FWrapCollections default True;
|
|||
|
|
property OnGetXMLHeader: TOnGetXMLHeader read FOnGetXMLHeader write FOnGetXMLHeader;
|
|||
|
|
property BeforeParsing: TBeforeParsingEvent read FBeforeParsing write FBeforeParsing;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
{$IFDEF UNITVERSIONING}
|
|||
|
|
const
|
|||
|
|
UnitVersioning: TUnitVersionInfo = (
|
|||
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvgXMLSerializer.pas $';
|
|||
|
|
Revision: '$Revision: 10612 $';
|
|||
|
|
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
|
|||
|
|
LogPath: 'JVCL\run'
|
|||
|
|
);
|
|||
|
|
{$ENDIF UNITVERSIONING}
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
JvResources,
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
JvgUtils;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
ORDINAL_TYPES = [tkInteger, tkChar, tkEnumeration, tkSet];
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
TAB: string;
|
|||
|
|
CR: string;
|
|||
|
|
|
|||
|
|
{$IFNDEF USEJVCL}
|
|||
|
|
resourcestring
|
|||
|
|
(* RUSSIAN
|
|||
|
|
RsOpenXMLTagNotFound = '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: <%s>';
|
|||
|
|
RsCloseXMLTagNotFound = '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: </%s>';
|
|||
|
|
RsUnknownProperty = 'Unknown property: %s';
|
|||
|
|
*)
|
|||
|
|
RsOpenXMLTagNotFound = 'Open tag not found: <%s>';
|
|||
|
|
RsCloseXMLTagNotFound = 'Close tag not found: </%s>';
|
|||
|
|
RsUnknownProperty = 'Unknown property: %s';
|
|||
|
|
{$ENDIF !USEJVCL}
|
|||
|
|
|
|||
|
|
constructor TJvgXMLSerializer.Create(AOwner: TComponent);
|
|||
|
|
begin
|
|||
|
|
inherited Create(AOwner);
|
|||
|
|
//...defaults
|
|||
|
|
FGenerateFormattedXML := True;
|
|||
|
|
FStrongConformity := True;
|
|||
|
|
FWrapCollections := True;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>. <20><><EFBFBD>-<2D><> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ writes string to output stream. Used for serialization. [translated] }
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.WriteOutStream(const Value: string);
|
|||
|
|
begin
|
|||
|
|
if Value <> '' then
|
|||
|
|
OutStream.Write(PChar(Value)[0], Length(Value));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML-<2D><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// <20> published <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD>:
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD> XML <20> <20><><EFBFBD><EFBFBD><EFBFBD> Stream
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Converts component to XML, according to published interface of its class
|
|||
|
|
Input:
|
|||
|
|
Component - Component to be converted
|
|||
|
|
Output:
|
|||
|
|
XML text into Stream
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.Serialize(Component: TObject; Stream: TStream);
|
|||
|
|
var
|
|||
|
|
Result: string;
|
|||
|
|
begin
|
|||
|
|
TAB := IIF(GenerateFormattedXML, #9, '');
|
|||
|
|
CR := IIF(GenerateFormattedXML, #13#10, '');
|
|||
|
|
|
|||
|
|
Result := '';
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> XML <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Retrieving XML header [translated] }
|
|||
|
|
if Assigned(OnGetXMLHeader) then
|
|||
|
|
OnGetXMLHeader(Self, Result);
|
|||
|
|
if Result = '' then
|
|||
|
|
Result := DefaultXMLHeader;
|
|||
|
|
|
|||
|
|
OutStream := Stream;
|
|||
|
|
|
|||
|
|
WriteOutStream(PChar(Result));
|
|||
|
|
|
|||
|
|
WriteOutStream(PChar(CR + '<' + Component.ClassName + '>'));
|
|||
|
|
SerializeInternal(Component);
|
|||
|
|
WriteOutStream(PChar(CR + '</' + Component.ClassName + '>'));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>:
|
|||
|
|
// Serialize()
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// Level - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD>:
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> XML <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> WriteOutStream()
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Internal procedure Object->XML
|
|||
|
|
Is called from:
|
|||
|
|
Serialize()
|
|||
|
|
Input:
|
|||
|
|
Component - Component to be converted
|
|||
|
|
Level - Level of nesting (for formatted output)
|
|||
|
|
Output:
|
|||
|
|
XML string into output Stream via .WriteOutStream() method
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.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;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Adds opening tag with given name [translated] }
|
|||
|
|
|
|||
|
|
procedure addOpenTag(const Value: string);
|
|||
|
|
begin
|
|||
|
|
WriteOutStream(CR + DupStr(TAB, Level) + '<' + Value + '>');
|
|||
|
|
Inc(Level);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Adds closing tag with given name [translated] }
|
|||
|
|
|
|||
|
|
procedure addCloseTag(const Value: string; AddBreak: Boolean = False);
|
|||
|
|
begin
|
|||
|
|
Dec(Level);
|
|||
|
|
if AddBreak then
|
|||
|
|
WriteOutStream(CR + DupStr(TAB, Level));
|
|||
|
|
WriteOutStream('</' + Value + '>');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Adds value [in]to result string [translated] }
|
|||
|
|
|
|||
|
|
procedure addValue(const Value: string);
|
|||
|
|
begin
|
|||
|
|
WriteOutStream(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
// Result := '';
|
|||
|
|
|
|||
|
|
{ Playing with RTTI }
|
|||
|
|
TypeInf := Component.ClassInfo;
|
|||
|
|
AName := TypeInf^.Name;
|
|||
|
|
TypeData := GetTypeData(TypeInf);
|
|||
|
|
NumProps := TypeData^.PropCount;
|
|||
|
|
|
|||
|
|
GetMem(PropList, NumProps * SizeOf(Pointer));
|
|||
|
|
try
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Getting list of properties [translated] }
|
|||
|
|
GetPropInfos(TypeInf, PropList);
|
|||
|
|
|
|||
|
|
for I := 0 to NumProps - 1 do
|
|||
|
|
begin
|
|||
|
|
PropName := PropList^[I]^.Name;
|
|||
|
|
|
|||
|
|
PropTypeInf := PropList^[I]^.PropType^;
|
|||
|
|
PropInfo := PropList^[I];
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ? }
|
|||
|
|
{ Does the property wish to be saved? [translated] }
|
|||
|
|
if not IsStoredProp(Component, PropInfo) then
|
|||
|
|
Continue;
|
|||
|
|
|
|||
|
|
case PropTypeInf^.Kind of
|
|||
|
|
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
|
|||
|
|
tkWChar, tkLString, tkWString, tkVariant:
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Getting property's value [translated] }
|
|||
|
|
sPropValue := GetPropValue(Component, PropName, True);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Checking if value is empty or is default [translated] }
|
|||
|
|
if ExcludeEmptyValues and (sPropValue = '') then
|
|||
|
|
Continue;
|
|||
|
|
if ExcludeDefaultValues and (PropTypeInf^.Kind in ORDINAL_TYPES) and
|
|||
|
|
(sPropValue = IntToStr(PropInfo.Default)) then
|
|||
|
|
Continue;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ special characters placeholders [translated] }
|
|||
|
|
if FReplaceReservedSymbols then
|
|||
|
|
begin
|
|||
|
|
sPropValue := StringReplace(sPropValue, '<', '<',
|
|||
|
|
[rfReplaceAll]);
|
|||
|
|
sPropValue := StringReplace(sPropValue, '>', '>',
|
|||
|
|
[rfReplaceAll]);
|
|||
|
|
// sPropValue := StringReplace(sPropValue, '&', '&', [rfReplaceAll]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML }
|
|||
|
|
{ converting to XML [translated] }
|
|||
|
|
addOpenTag(PropName);
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ adds property's value to result [translated] }
|
|||
|
|
addValue(sPropValue);
|
|||
|
|
addCloseTag(PropName);
|
|||
|
|
end;
|
|||
|
|
tkClass:
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ make recursive call for class-types [translated] }
|
|||
|
|
begin
|
|||
|
|
PropObject := GetObjectProp(Component, PropInfo);
|
|||
|
|
if Assigned(PropObject) then
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ make recursive call for children class-types [translated] }
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Specific handlers for some certain classes [translated] }
|
|||
|
|
if PropObject is TStrings then
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ text lists [translated] }
|
|||
|
|
begin
|
|||
|
|
addOpenTag(PropName);
|
|||
|
|
WriteOutStream(TStrings(PropObject).CommaText);
|
|||
|
|
addCloseTag(PropName, True);
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
if PropObject is TCollection then
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ collections [translated] }
|
|||
|
|
begin
|
|||
|
|
if WrapCollections then
|
|||
|
|
addOpenTag(PropName);
|
|||
|
|
|
|||
|
|
SerializeInternal(PropObject, Level);
|
|||
|
|
for J := 0 to (PropObject as TCollection).Count - 1 do
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Container-tag with name of the class [translated] }
|
|||
|
|
addOpenTag(TCollection(PropObject).Items[J].ClassName);
|
|||
|
|
SerializeInternal(TCollection(PropObject).Items[J],
|
|||
|
|
Level);
|
|||
|
|
addCloseTag(TCollection(PropObject).Items[J].ClassName, True);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if WrapCollections then
|
|||
|
|
addCloseTag(PropName, True);
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
if PropObject is TPersistent then
|
|||
|
|
begin
|
|||
|
|
addOpenTag(PropName);
|
|||
|
|
SerializeInternal(PropObject, Level);
|
|||
|
|
addCloseTag(PropName, True);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: TTreeNodes, TListItems }
|
|||
|
|
{ Here one can add handling of other classes like TreeNodes, TListItems [translated] }
|
|||
|
|
end;
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Closing object's tag after proceeded its properties [translated] }
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeMem(PropList, NumProps * SizeOf(Pointer));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML-<2D><><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// Stream - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> XML
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Component <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Loads component's properties ("data") from stream, containing XML stream
|
|||
|
|
Input:
|
|||
|
|
Component - Component to be convertes.
|
|||
|
|
Stream - Stream containing XML to load
|
|||
|
|
Preconditions:
|
|||
|
|
Components object was created prior to procedure's call
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.DeSerialize(Component: TObject; Stream: TStream);
|
|||
|
|
begin
|
|||
|
|
GetMem(Buffer, Stream.Size);
|
|||
|
|
try
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Retrievign data from stream [translated] }
|
|||
|
|
Stream.Read(Buffer[0], Stream.Size + 1);
|
|||
|
|
|
|||
|
|
if Assigned(BeforeParsing) then
|
|||
|
|
BeforeParsing(Self, Buffer);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Setting current pointer of reading data [translated] }
|
|||
|
|
TokenPtr := Buffer;
|
|||
|
|
BufferLength := Stream.Size - 1;
|
|||
|
|
BufferEnd := Buffer + BufferLength;
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Calling loader [translated] }
|
|||
|
|
DeSerializeInternal(Component, Component.ClassName);
|
|||
|
|
finally
|
|||
|
|
FreeMem(Buffer);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> XML
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>:
|
|||
|
|
// Serialize()
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// ComponentTagName - <20><><EFBFBD> XML <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// ParentBlockEnd - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> XML <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Recursive procedure for loading of object from text buffer, containing XML
|
|||
|
|
Called from::
|
|||
|
|
Serialize()
|
|||
|
|
Input:
|
|||
|
|
Component - Component to be converted,
|
|||
|
|
ComponentTagName - Name of XML tag for object (Arioch: may differ from
|
|||
|
|
ClassName for CollectionItems, for XML header),
|
|||
|
|
ParentBlockEnd - Pointer to the end of XML-description of the parent tag.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.DeSerializeInternal(Component: TObject;
|
|||
|
|
ComponentTagName: string; ParentBlockEnd: PChar = nil);
|
|||
|
|
var
|
|||
|
|
BlockStart, BlockEnd, TagStart, TagEnd: PChar;
|
|||
|
|
TagName, TagValue, TagValueEnd: PChar;
|
|||
|
|
TypeInf: PTypeInfo;
|
|||
|
|
TypeData: PTypeData;
|
|||
|
|
PropIndex: Integer;
|
|||
|
|
AName: string;
|
|||
|
|
PropList: PPropList;
|
|||
|
|
NumProps: Word;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Searching object for property with given name [translated] }
|
|||
|
|
|
|||
|
|
function FindProperty(TagName: PChar): Integer;
|
|||
|
|
var
|
|||
|
|
I: Integer;
|
|||
|
|
begin
|
|||
|
|
Result := -1;
|
|||
|
|
for I := 0 to NumProps - 1 do
|
|||
|
|
if CompareStr(PropList^[I]^.Name, TagName) = 0 then
|
|||
|
|
begin
|
|||
|
|
Result := I;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SkipSpaces(var TagEnd: PChar);
|
|||
|
|
begin
|
|||
|
|
while TagEnd[0] <= #33 do
|
|||
|
|
Inc(TagEnd);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// StrPosExt - <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> StrPos.
|
|||
|
|
|
|||
|
|
function StrPosExt(const Str1, Str2: PChar; Str1Len: DWORD): PChar; assembler;
|
|||
|
|
asm
|
|||
|
|
PUSH EDI
|
|||
|
|
PUSH ESI
|
|||
|
|
PUSH EBX
|
|||
|
|
OR EAX,EAX // Str1
|
|||
|
|
JE @@2 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str1 <20><><EFBFBD><EFBFBD><EFBFBD> - <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
OR EDX,EDX // Str2
|
|||
|
|
JE @@2 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str2 <20><><EFBFBD><EFBFBD><EFBFBD> - <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
MOV EBX,EAX
|
|||
|
|
MOV EDI,EDX // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> SCASB - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str2
|
|||
|
|
XOR AL,AL // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> AL
|
|||
|
|
|
|||
|
|
push ECX // <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
|
|||
|
|
MOV ECX,0FFFFFFFFH // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
REPNE SCASB // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str2
|
|||
|
|
NOT ECX // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ECX - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>+1
|
|||
|
|
DEC ECX // <20> ECX - <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str2
|
|||
|
|
|
|||
|
|
JE @@2 // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
MOV ESI,ECX // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> ESI
|
|||
|
|
|
|||
|
|
pop ECX
|
|||
|
|
|
|||
|
|
SUB ECX,ESI // ECX == <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> : Str1 - Str2
|
|||
|
|
JBE @@2 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
MOV EDI,EBX // EDI - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str1
|
|||
|
|
LEA EBX,[ESI-1] // EBX - <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
@@1: MOV ESI,EDX // ESI - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Str2
|
|||
|
|
LODSB // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> AL
|
|||
|
|
REPNE SCASB // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> EDI
|
|||
|
|
JNE @@2 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
MOV EAX,ECX // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
PUSH EDI // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
MOV ECX,EBX
|
|||
|
|
REPE CMPSB // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
POP EDI
|
|||
|
|
MOV ECX,EAX
|
|||
|
|
JNE @@1 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
LEA EAX,[EDI-1]
|
|||
|
|
JMP @@3
|
|||
|
|
@@2: XOR EAX,EAX
|
|||
|
|
@@3: POP EBX
|
|||
|
|
POP ESI
|
|||
|
|
POP EDI
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
{ Playing with RTTI }
|
|||
|
|
TypeInf := Component.ClassInfo;
|
|||
|
|
AName := TypeInf^.Name;
|
|||
|
|
TypeData := GetTypeData(TypeInf);
|
|||
|
|
NumProps := TypeData^.PropCount;
|
|||
|
|
|
|||
|
|
if not WrapCollections and (Component is TCollection) then
|
|||
|
|
ComponentTagName := TCollection(Component).ItemClass.ClassName;
|
|||
|
|
|
|||
|
|
GetMem(PropList, NumProps * SizeOf(Pointer));
|
|||
|
|
try
|
|||
|
|
GetPropInfos(TypeInf, PropList);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> }
|
|||
|
|
{ Looking for opening tag [translated] }
|
|||
|
|
BlockStart := StrPosExt(TokenPtr, PChar('<' + ComponentTagName + '>'),
|
|||
|
|
BufferEnd - TokenPtr { = BufferLength});
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> }
|
|||
|
|
{ If tag is not found and is not required - skip it [translated] }
|
|||
|
|
if (BlockStart = nil) and not StrongConformity then
|
|||
|
|
exit;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Otherwise Check its presence [translated] }
|
|||
|
|
Check(BlockStart <> nil, Format(RsOpenXMLTagNotFound,
|
|||
|
|
[ComponentTagName]), EJvgXMLOpenTagNotFoundException);
|
|||
|
|
Inc(BlockStart, Length(ComponentTagName) + 2);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> }
|
|||
|
|
{ Looking for closing tag [translated] }
|
|||
|
|
BlockEnd := StrPosExt(BlockStart, PChar('</' + ComponentTagName + '>'),
|
|||
|
|
BufferEnd - BlockStart + 3 + Length(ComponentTagName) {BufferLength});
|
|||
|
|
Check(BlockEnd <> nil, Format(RsCloseXMLTagNotFound,
|
|||
|
|
[ComponentTagName]), EJvgXMLCloseTagNotFoundException);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>. <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> }
|
|||
|
|
{ Checking the closing tag to be nested within parent tag [translated] }
|
|||
|
|
Check((ParentBlockEnd = nil) or (BlockEnd < ParentBlockEnd),
|
|||
|
|
Format(RsCloseXMLTagNotFound, [ComponentTagName]),
|
|||
|
|
EJvgXMLCloseTagNotFoundException);
|
|||
|
|
|
|||
|
|
TagEnd := BlockStart;
|
|||
|
|
SkipSpaces(TagEnd);
|
|||
|
|
|
|||
|
|
//{ XML <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ XML parser [translated] }
|
|||
|
|
while (TagEnd < BlockEnd) { and (TagEnd >= TokenPtr)} do
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ fast search for "<" and ">" [translated] }
|
|||
|
|
asm
|
|||
|
|
MOV CL, '<'
|
|||
|
|
MOV EDX, Pointer(TagEnd)
|
|||
|
|
DEC EDX
|
|||
|
|
@@1: INC EDX
|
|||
|
|
MOV AL, Byte[EDX]
|
|||
|
|
CMP AL, CL
|
|||
|
|
JNE @@1
|
|||
|
|
MOV TagStart, EDX
|
|||
|
|
|
|||
|
|
MOV CL, '>'
|
|||
|
|
@@2: INC EDX
|
|||
|
|
MOV AL, Byte[EDX]
|
|||
|
|
CMP AL, CL
|
|||
|
|
JNE @@2
|
|||
|
|
MOV TagEnd, EDX
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
GetMem(TagName, TagEnd - TagStart + 1);
|
|||
|
|
try
|
|||
|
|
//{ TagName - <20><><EFBFBD> <20><><EFBFBD><EFBFBD> }
|
|||
|
|
{ Tag Name - Tag Name [translated] }
|
|||
|
|
StrLCopy(TagName, TagStart + 1, TagEnd - TagStart - 1);
|
|||
|
|
|
|||
|
|
//{ TagEnd - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> }
|
|||
|
|
{ TagEnd - Closing tag [translated] }
|
|||
|
|
TagEnd := StrPosExt(TagEnd, PChar('</' + TagName + '>'),
|
|||
|
|
BufferEnd - TagEnd + 3 + Length(TagName) { = BufferLength});
|
|||
|
|
|
|||
|
|
//Inc(TagStart, Length('</' + TagName + '>')-1);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> }
|
|||
|
|
{ Beginning of the next nested("children") tag [translated] }
|
|||
|
|
TagValue := TagStart + Length('</' + TagName + '>') - 1;
|
|||
|
|
TagValueEnd := TagEnd;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> }
|
|||
|
|
{ Looking for property matching the tag [translated] }
|
|||
|
|
PropIndex := FindProperty(TagName);
|
|||
|
|
|
|||
|
|
if not WrapCollections and (PropIndex = -1) then
|
|||
|
|
PropIndex := FindProperty(PChar(TagName + 's'))
|
|||
|
|
else
|
|||
|
|
TokenPtr := TagStart;
|
|||
|
|
|
|||
|
|
if not IgnoreUnknownTags then
|
|||
|
|
Check(PropIndex <> -1, Format(RsUnknownProperty, [TagName]),
|
|||
|
|
EJvgXMLUnknownPropertyException);
|
|||
|
|
|
|||
|
|
if PropIndex <> -1 then
|
|||
|
|
SetPropertyValue(Component, PropList^[PropIndex], TagValue,
|
|||
|
|
TagValueEnd, BlockEnd);
|
|||
|
|
|
|||
|
|
Inc(TagEnd, Length('</' + TagName + '>'));
|
|||
|
|
SkipSpaces(TagEnd);
|
|||
|
|
finally
|
|||
|
|
FreeMem(TagName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeMem(PropList);//, NumProps * SizeOf(Pointer));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>:
|
|||
|
|
// DeSerializeInternal()
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// PropInfo - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// Value - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// ParentBlockEnd - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> XML <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Initialisation of the object's property
|
|||
|
|
Called from:
|
|||
|
|
DeSerializeInternal()
|
|||
|
|
Input:
|
|||
|
|
Component - Component to be initialized
|
|||
|
|
PropInfo - Information about type of property to set
|
|||
|
|
Value - Value of the property
|
|||
|
|
ParentBlockEnd - Pointer to the end of XML description of parent tag. Used for recursion.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.SetPropertyValue(Component: TObject; PropInfo:
|
|||
|
|
PPropInfo; Value, ValueEnd: PChar; ParentBlockEnd: PChar);
|
|||
|
|
var
|
|||
|
|
PropTypeInf: PTypeInfo;
|
|||
|
|
PropObject: TObject;
|
|||
|
|
CollectionItem: TCollectionItem;
|
|||
|
|
SValue: string;
|
|||
|
|
TmpChar: Char;
|
|||
|
|
begin
|
|||
|
|
PropTypeInf := PropInfo.PropType^;
|
|||
|
|
|
|||
|
|
case PropTypeInf^.Kind of
|
|||
|
|
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
|
|||
|
|
tkWChar, tkLString, tkWString, tkVariant:
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> zero terminated string }
|
|||
|
|
{ simulates zero terminated string [translated] }
|
|||
|
|
TmpChar := ValueEnd[0];
|
|||
|
|
ValueEnd[0] := #0;
|
|||
|
|
SValue := StrPas(Value);
|
|||
|
|
ValueEnd[0] := TmpChar;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> XML,
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
{ Replacing specific characters (compatible only with that very component) [translated] }
|
|||
|
|
if FReplaceReservedSymbols then
|
|||
|
|
begin
|
|||
|
|
SValue := StringReplace(SValue, '<', '<', [rfReplaceAll]);
|
|||
|
|
SValue := StringReplace(SValue, '>', '>', [rfReplaceAll]);
|
|||
|
|
// SValue := StringReplace(SValue, '&', '&', [rfReplaceAll]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Changing delimiter to system-wide [translated] }
|
|||
|
|
if PropTypeInf^.Kind = tkFloat then
|
|||
|
|
if DecimalSeparator = ',' then
|
|||
|
|
SValue := StringReplace(SValue, '.', DecimalSeparator, [rfReplaceAll])
|
|||
|
|
else
|
|||
|
|
SValue := StringReplace(SValue, ',', DecimalSeparator, [rfReplaceAll]);
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> tkSet <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ tkSet parser needs "<" and ">" for correct transformation [translated] }
|
|||
|
|
if PropTypeInf^.Kind = tkSet then
|
|||
|
|
SValue := '[' + SValue + ']';
|
|||
|
|
SetPropValue(Component, PropInfo^.Name, SValue);
|
|||
|
|
end;
|
|||
|
|
tkClass:
|
|||
|
|
begin
|
|||
|
|
PropObject := GetObjectProp(Component, PropInfo);
|
|||
|
|
if Assigned(PropObject) then
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Specific(individual) handling of some specific classes [translated] }
|
|||
|
|
if PropObject is TStrings then
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ text lists [translated] }
|
|||
|
|
begin
|
|||
|
|
TmpChar := ValueEnd[0];
|
|||
|
|
ValueEnd[0] := #0;
|
|||
|
|
SValue := StrPas(Value);
|
|||
|
|
ValueEnd[0] := TmpChar;
|
|||
|
|
TStrings(PropObject).CommaText := SValue;
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
if PropObject is TCollection then
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ collections [translated] }
|
|||
|
|
begin
|
|||
|
|
while True do
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ we can't foretell number of element in TCollection [translated] }
|
|||
|
|
begin
|
|||
|
|
CollectionItem := (PropObject as TCollection).Add;
|
|||
|
|
try
|
|||
|
|
DeSerializeInternal(CollectionItem,
|
|||
|
|
CollectionItem.ClassName, ParentBlockEnd);
|
|||
|
|
except
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Exception if next element is not found [translated] }
|
|||
|
|
on E: Exception do
|
|||
|
|
begin
|
|||
|
|
// Application.MessageBox(PChar(E.Message), '', MB_OK); - debug string
|
|||
|
|
CollectionItem.Free;
|
|||
|
|
// raise; - debug string
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Other classes are just processed recursevly [translated] }
|
|||
|
|
DeSerializeInternal(PropObject, PropInfo^.Name,
|
|||
|
|
ParentBlockEnd);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DTD <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> published <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD>:
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD> DTD <20> <20><><EFBFBD><EFBFBD><EFBFBD> Stream
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
This procedure generates DTD for given object according to its published interface
|
|||
|
|
Input:
|
|||
|
|
Component - Object
|
|||
|
|
Output:
|
|||
|
|
text of DTD into Stream
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.GenerateDTD(Component: TObject; Stream: TStream);
|
|||
|
|
var
|
|||
|
|
DTDList: TStringList;
|
|||
|
|
begin
|
|||
|
|
DTDList := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
GenerateDTDInternal(Component, DTDList, Stream, Component.ClassName);
|
|||
|
|
finally
|
|||
|
|
DTDList.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DTD <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><><EFBFBD><EFBFBD>:
|
|||
|
|
// Component - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
// DTDList - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DTD
|
|||
|
|
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD>:
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD> DTD <20> <20><><EFBFBD><EFBFBD><EFBFBD> Stream
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Inner recursive procedure that generates DTD for given object
|
|||
|
|
Input:
|
|||
|
|
Component - Object
|
|||
|
|
DTDList - list of already determined describedDTD elements
|
|||
|
|
to avoid duplicating
|
|||
|
|
Output:
|
|||
|
|
DTD text into Stream
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.GenerateDTDInternal(Component: TObject; DTDList:
|
|||
|
|
TStrings; Stream: TStream; const ComponentTagName: string);
|
|||
|
|
var
|
|||
|
|
PropInfo: PPropInfo;
|
|||
|
|
TypeInf, PropTypeInf: PTypeInfo;
|
|||
|
|
TypeData: PTypeData;
|
|||
|
|
I: Integer;
|
|||
|
|
AName, PropName, TagContent: string;
|
|||
|
|
PropList: PPropList;
|
|||
|
|
NumProps: Word;
|
|||
|
|
PropObject: TObject;
|
|||
|
|
const
|
|||
|
|
PCDATA = '#PCDATA';
|
|||
|
|
|
|||
|
|
procedure addElement(const ElementName: string; Data: string);
|
|||
|
|
var
|
|||
|
|
S: string;
|
|||
|
|
begin
|
|||
|
|
if DTDList.IndexOf(ElementName) <> -1 then
|
|||
|
|
exit;
|
|||
|
|
DTDList.Add(ElementName);
|
|||
|
|
S := '<!ELEMENT ' + ElementName + ' ';
|
|||
|
|
if Data = '' then
|
|||
|
|
Data := PCDATA;
|
|||
|
|
S := S + '(' + Data + ')>'#13#10;
|
|||
|
|
Stream.Write(PChar(S)[0], Length(S));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
{ Playing with RTTI }
|
|||
|
|
TypeInf := Component.ClassInfo;
|
|||
|
|
AName := TypeInf^.Name;
|
|||
|
|
TypeData := GetTypeData(TypeInf);
|
|||
|
|
NumProps := TypeData^.PropCount;
|
|||
|
|
|
|||
|
|
GetMem(PropList, NumProps * SizeOf(Pointer));
|
|||
|
|
try
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Getting list of properties [translated] }
|
|||
|
|
GetPropInfos(TypeInf, PropList);
|
|||
|
|
TagContent := '';
|
|||
|
|
|
|||
|
|
for I := 0 to NumProps - 1 do
|
|||
|
|
begin
|
|||
|
|
PropName := PropList^[I]^.Name;
|
|||
|
|
|
|||
|
|
PropTypeInf := PropList^[I]^.PropType^;
|
|||
|
|
PropInfo := PropList^[I];
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> }
|
|||
|
|
{ Skip types that are not supported [translated] }
|
|||
|
|
if not (PropTypeInf^.Kind in [tkDynArray, tkArray, tkRecord,
|
|||
|
|
tkInterface, tkMethod]) then
|
|||
|
|
begin
|
|||
|
|
if TagContent <> '' then
|
|||
|
|
TagContent := TagContent + '|';
|
|||
|
|
TagContent := TagContent + PropName;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
case PropTypeInf^.Kind of
|
|||
|
|
tkInteger, tkChar, tkFloat, tkString,
|
|||
|
|
tkWChar, tkLString, tkWString, tkVariant, tkEnumeration, tkSet:
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> DTD. <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - #PCDATA }
|
|||
|
|
{ conversion to DTD. Theese types will have #PCDATA model of content [translated] }
|
|||
|
|
addElement(PropName, PCDATA);
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Code might be useful when using attributes [translated] }
|
|||
|
|
{
|
|||
|
|
tkEnumeration:
|
|||
|
|
begin
|
|||
|
|
TypeData:= GetTypeData(GetTypeData(PropTypeInf)^.BaseType^);
|
|||
|
|
S := '';
|
|||
|
|
for J := TypeData^.MinValue to TypeData^.MaxValue do
|
|||
|
|
begin
|
|||
|
|
if S <> '' then S := S + '|';
|
|||
|
|
S := S + GetEnumName(PropTypeInf, J);
|
|||
|
|
end;
|
|||
|
|
addElement(PropName, S);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
tkClass:
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ make recursive call for class-types [translated] }
|
|||
|
|
begin
|
|||
|
|
PropObject := GetObjectProp(Component, PropInfo);
|
|||
|
|
if Assigned(PropObject) then
|
|||
|
|
begin
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Specific(individual) handling of some specific classes [translated] }
|
|||
|
|
if PropObject is TPersistent then
|
|||
|
|
GenerateDTDInternal(PropObject, DTDList, Stream, PropName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
//{ <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Collections require item("element") type(class) to be included into
|
|||
|
|
content model [translated] }
|
|||
|
|
if Component is TCollection then
|
|||
|
|
begin
|
|||
|
|
if TagContent <> '' then
|
|||
|
|
TagContent := TagContent + '|';
|
|||
|
|
TagContent := TagContent + (Component as TCollection).ItemClass.ClassName + '*';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> }
|
|||
|
|
{ Adding content model for the element(item) [translated] }
|
|||
|
|
addElement(ComponentTagName, TagContent);
|
|||
|
|
finally
|
|||
|
|
FreeMem(PropList, NumProps * SizeOf(Pointer));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TJvgXMLSerializer.Check(Expr: Boolean; const Msg: string;
|
|||
|
|
E: TJvgXMLSerializerException);
|
|||
|
|
begin
|
|||
|
|
if not Expr then
|
|||
|
|
raise E.Create('XMLSerializerException'#13#10#13#10 + Msg);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{$IFDEF USEJVCL}
|
|||
|
|
{$IFDEF UNITVERSIONING}
|
|||
|
|
initialization
|
|||
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|||
|
|
|
|||
|
|
finalization
|
|||
|
|
UnregisterUnitVersion(HInstance);
|
|||
|
|
{$ENDIF UNITVERSIONING}
|
|||
|
|
{$ENDIF USEJVCL}
|
|||
|
|
|
|||
|
|
end.
|
|||
|
|
|