You've already forked lazarus-ccr
2cb02c46ec
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@560 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1915 lines
50 KiB
ObjectPascal
1915 lines
50 KiB
ObjectPascal
{
|
|
This file is part of the Web Service Toolkit
|
|
Copyright (c) 2006 by Inoussa OUEDRAOGO
|
|
|
|
This file is provide under modified LGPL licence
|
|
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
}
|
|
{$INCLUDE wst_global.inc}
|
|
unit base_xmlrpc_formatter;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, TypInfo, Contnrs,
|
|
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
|
|
base_service_intf;
|
|
|
|
const
|
|
sPROTOCOL_NAME = 'XMLRPC';
|
|
|
|
|
|
sCONTENT_TYPE = 'contenttype';
|
|
sFORMAT = 'format';
|
|
sXMLRPC_CONTENT_TYPE = 'text/xml';
|
|
|
|
sDATA = 'data';
|
|
sFAULT = 'fault';
|
|
sFAULT_CODE = 'faultCode';
|
|
sFAULT_STRING = 'faultString';
|
|
sMEMBER = 'member';
|
|
sMETHOD_CALL = 'methodCall';
|
|
sMETHOD_NAME = 'methodName';
|
|
sMETHOD_RESPONSE = 'methodResponse';
|
|
sNAME = 'name';
|
|
sPARAM = 'param';
|
|
sPARAMS = 'params';
|
|
sVALUE = 'value';
|
|
|
|
type
|
|
|
|
TwstXMLDocument = {$IFNDEF FPC}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF};
|
|
|
|
TEnumIntType = Int64;
|
|
|
|
TXmlRpcDataType = (
|
|
xdtString, xdtInt, xdtBoolean, xdtdouble, xdtDateTime, xdtBase64,
|
|
xdtStruct, xdtArray
|
|
);
|
|
|
|
const
|
|
XmlRpcDataTypeNames : array[TXmlRpcDataType] of string = (
|
|
'string', 'int', 'boolean', 'double', 'dateTime.iso8601', 'base64',
|
|
'struct', 'array'
|
|
);
|
|
|
|
type
|
|
{ ESOAPException }
|
|
|
|
EXmlRpcException = class(EBaseRemoteException)
|
|
end;
|
|
|
|
TFoundState = ( fsNone, fsFoundNonNil, fsFoundNil );
|
|
|
|
{ TStackItem }
|
|
|
|
TStackItem = class
|
|
private
|
|
FFoundState : TFoundState;
|
|
FScopeObject: TDOMNode;
|
|
FScopeType: TScopeType;
|
|
protected
|
|
function GetItemsCount() : Integer;virtual;
|
|
procedure SetFoundState(const AFoundState : TFoundState);
|
|
public
|
|
constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType);
|
|
function FindNode(var ANodeName : string):TDOMNode;virtual;abstract;
|
|
function CreateBuffer(
|
|
Const AName : string;
|
|
const ADataType : TXmlRpcDataType
|
|
):TDOMNode;virtual;abstract;
|
|
property ScopeObject : TDOMNode Read FScopeObject;
|
|
property ScopeType : TScopeType Read FScopeType;
|
|
property ItemsCount : Integer read GetItemsCount;
|
|
property FoundState : TFoundState read FFoundState;
|
|
|
|
function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;abstract;
|
|
end;
|
|
|
|
{ TObjectStackItem }
|
|
|
|
TObjectStackItem = class(TStackItem)
|
|
public
|
|
function FindNode(var ANodeName : string):TDOMNode;override;
|
|
function CreateBuffer(
|
|
Const AName : string;
|
|
const ADataType : TXmlRpcDataType
|
|
):TDOMNode;override;
|
|
|
|
function GetScopeItemNames(const AReturnList : TStrings) : Integer;override;
|
|
end;
|
|
|
|
TBaseArrayStackItem = class(TStackItem)
|
|
private
|
|
FItemList : TDOMNodeList;
|
|
FIndex : Integer;
|
|
FIndexStack : array of Integer;
|
|
FIndexStackIDX : Integer;
|
|
private
|
|
function PushIndex(const AValue : Integer) : Integer;
|
|
function PopIndex() : Integer;
|
|
public
|
|
destructor Destroy();override;
|
|
function GetScopeItemNames(const AReturnList : TStrings) : Integer;override;
|
|
end;
|
|
|
|
{ TArrayStackItem }
|
|
|
|
TArrayStackItem = class(TBaseArrayStackItem)
|
|
private
|
|
FDataScope : TDOMNode;
|
|
protected
|
|
procedure EnsureListCreated();
|
|
function GetItemsCount() : Integer;override;
|
|
function CreateList():TDOMNodeList;
|
|
function PushIndex(const AValue : Integer) : Integer;
|
|
function PopIndex() : Integer;
|
|
public
|
|
function FindNode(var ANodeName : string):TDOMNode;override;
|
|
function CreateBuffer(
|
|
Const AName : string;
|
|
const ADataType : TXmlRpcDataType
|
|
):TDOMNode;override;
|
|
end;
|
|
|
|
{ TParamsArrayStackItem }
|
|
|
|
TParamsArrayStackItem = class(TBaseArrayStackItem)
|
|
protected
|
|
procedure EnsureListCreated();
|
|
function GetItemsCount() : Integer;override;
|
|
function CreateList():TDOMNodeList;
|
|
public
|
|
function FindNode(var ANodeName : string):TDOMNode;override;
|
|
function CreateBuffer(
|
|
Const AName : string;
|
|
const ADataType : TXmlRpcDataType
|
|
):TDOMNode;override;
|
|
end;
|
|
|
|
{$M+}
|
|
|
|
{ TXmlRpcBaseFormatter }
|
|
|
|
TXmlRpcBaseFormatter = class(TSimpleFactoryItem,IFormatterBase)
|
|
private
|
|
FPropMngr : IPropertyManager;
|
|
FContentType: string;
|
|
FDoc : TXMLDocument;
|
|
FStack : TObjectStack;
|
|
FSerializationStyle: TSerializationStyle;
|
|
private
|
|
procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function InternalPutData(
|
|
const AName : string;
|
|
const AType : TXmlRpcDataType;
|
|
const AData : DOMString
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutEnum(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : TEnumIntType
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF FPC}
|
|
function PutBool(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : Boolean
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
function PutAnsiChar(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : AnsiChar
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutWideChar(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : WideChar
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutInt64(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : Int64
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutStr(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : String
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function PutUnicodeStr(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : UnicodeString
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF WST_UNICODESTRING}
|
|
function PutWideStr(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : WideString
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutFloat(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : Extended
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure PutObj(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : TObject
|
|
); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure PutRecord(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Pointer
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
function GetNodeValue(var AName : String):DOMString;
|
|
procedure GetEnum(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : TEnumIntType
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetAnsiChar(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : AnsiChar
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetWideChar(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : WideChar
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF FPC}
|
|
procedure GetBool(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : Boolean
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetInt(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : Integer
|
|
);
|
|
{$ENDIF}
|
|
procedure GetInt64(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : Int64
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetFloat(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : Extended
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : String
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF WST_UNICODESTRING}
|
|
procedure GetUnicodeStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : UnicodeString
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF WST_UNICODESTRING}
|
|
procedure GetWideStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : WideString
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetObj(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : TObject
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure GetRecord(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Pointer
|
|
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
protected
|
|
function GetXmlDoc():TXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PushStack(
|
|
AScopeObject : TDOMNode;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PushStackParams(AScopeObject : TDOMNode) : TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function FindAttributeByValueInNode(
|
|
Const AAttValue : String;
|
|
Const ANode : TDOMNode;
|
|
Out AResAtt : string
|
|
):boolean;
|
|
function FindAttributeByNameInNode(
|
|
Const AAttName : String;
|
|
Const ANode : TDOMNode;
|
|
Out AResAttValue : string
|
|
):boolean;
|
|
function FindAttributeByValueInScope(Const AAttValue : String):String;
|
|
function FindAttributeByNameInScope(Const AAttName : String):String;
|
|
protected
|
|
function GetCurrentScope():String;
|
|
function GetCurrentScopeObject():TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function StackTop():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PopStack():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure ClearStack();{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
procedure BeginScope(
|
|
Const AScopeName,ANameSpace : string;
|
|
Const ANameSpaceShortName : string ;
|
|
Const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
function InternalBeginScopeRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
):Integer;
|
|
|
|
procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
|
|
function GetSerializationStyle():TSerializationStyle;
|
|
public
|
|
constructor Create();override;
|
|
destructor Destroy();override;
|
|
function GetFormatName() : string;
|
|
function GetPropertyManager():IPropertyManager;
|
|
procedure Clear();
|
|
|
|
procedure BeginObject(
|
|
Const AName : string;
|
|
Const ATypeInfo : PTypeInfo
|
|
);
|
|
procedure BeginArray(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AItemTypeInfo : PTypeInfo;
|
|
const ABounds : Array Of Integer;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
|
|
procedure NilCurrentScope();
|
|
function IsCurrentScopeNil():Boolean;
|
|
procedure EndScope();
|
|
procedure AddScopeAttribute(Const AName,AValue : string);
|
|
function BeginObjectRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo
|
|
) : Integer;
|
|
function BeginArrayRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
):Integer;
|
|
function GetScopeItemNames(const AReturnList : TStrings) : Integer;
|
|
procedure EndScopeRead();
|
|
|
|
procedure BeginHeader();
|
|
procedure EndHeader();
|
|
|
|
procedure Put(
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData
|
|
);overload;
|
|
procedure Put(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData
|
|
);overload;
|
|
procedure PutScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData
|
|
);
|
|
procedure Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : string;
|
|
var AData
|
|
);overload;
|
|
procedure Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : string;
|
|
var AData
|
|
);overload;
|
|
procedure GetScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AData
|
|
);
|
|
function ReadBuffer(const AName : string) : string;
|
|
procedure WriteBuffer(const AValue : string);
|
|
|
|
procedure SaveToStream(AStream : TStream);
|
|
procedure LoadFromStream(AStream : TStream);
|
|
|
|
procedure Error(Const AMsg:string);overload;
|
|
procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
|
|
published
|
|
property ContentType : string Read FContentType Write FContentType;
|
|
end;
|
|
{$M-}
|
|
|
|
implementation
|
|
Uses {$IFNDEF FPC}XMLDoc,XMLIntf,{$ELSE}XMLWrite, XMLRead,wst_fpc_xml,{$ENDIF}
|
|
imp_utils;
|
|
|
|
{ TStackItem }
|
|
|
|
function TStackItem.GetItemsCount(): Integer;
|
|
begin
|
|
Result := GetNodeItemsCount(ScopeObject);
|
|
end;
|
|
|
|
procedure TStackItem.SetFoundState (const AFoundState : TFoundState );
|
|
begin
|
|
FFoundState := AFoundState;
|
|
end;
|
|
|
|
constructor TStackItem.Create(AScopeObject: TDOMNode; AScopeType: TScopeType);
|
|
begin
|
|
FScopeObject := AScopeObject;
|
|
FScopeType := AScopeType;
|
|
end;
|
|
|
|
{ TObjectStackItem }
|
|
|
|
function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode;
|
|
var
|
|
memberNode, tmpNode : TDOMNode;
|
|
i : Integer;
|
|
chilNodes : TDOMNodeList;
|
|
nodeFound : Boolean;
|
|
begin
|
|
Result := nil;
|
|
if ScopeObject.HasChildNodes() then begin
|
|
nodeFound := False;
|
|
memberNode := ScopeObject.FirstChild;
|
|
while ( not nodeFound ) and ( memberNode <> nil ) do begin
|
|
if memberNode.HasChildNodes() then begin
|
|
chilNodes := memberNode.ChildNodes;
|
|
for i := 0 to Pred(GetNodeListCount(chilNodes)) do begin
|
|
tmpNode := chilNodes.Item[i];
|
|
if AnsiSameText(sNAME,tmpNode.NodeName) and
|
|
( tmpNode.FirstChild <> nil ) and
|
|
AnsiSameText(ANodeName,tmpNode.FirstChild.NodeValue)
|
|
then begin
|
|
nodeFound := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if nodeFound then begin
|
|
{$IFNDEF FPC}
|
|
tmpNode := wst_delphi_xml.FindNode(memberNode,sVALUE);
|
|
{$ELSE}
|
|
tmpNode := memberNode.FindNode(sVALUE);
|
|
{$ENDIF}
|
|
if ( tmpNode <> nil ) and ( tmpNode.FirstChild <> nil ) then begin
|
|
Result := tmpNode.FirstChild;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
memberNode := memberNode.NextSibling;
|
|
end;
|
|
end;
|
|
if ( Result <> nil ) then begin
|
|
if Result.HasChildNodes() then
|
|
SetFoundState(fsFoundNonNil)
|
|
else
|
|
SetFoundState(fsFoundNil);
|
|
end else begin
|
|
SetFoundState(fsNone);
|
|
end;
|
|
end;
|
|
|
|
function TObjectStackItem.CreateBuffer(
|
|
const AName: String;
|
|
const ADataType: TXmlRpcDataType
|
|
): TDOMNode;
|
|
var
|
|
memberNode, nd : TDOMNode;
|
|
begin
|
|
memberNode := ScopeObject.OwnerDocument.CreateElement(sMEMBER);
|
|
ScopeObject.AppendChild(memberNode);
|
|
|
|
nd := ScopeObject.OwnerDocument.CreateElement(sNAME);
|
|
memberNode.AppendChild(nd);
|
|
nd.AppendChild(ScopeObject.OwnerDocument.CreateTextNode(AName));
|
|
|
|
nd := ScopeObject.OwnerDocument.CreateElement(sVALUE);
|
|
memberNode.AppendChild(nd);
|
|
Result := ScopeObject.OwnerDocument.CreateElement(XmlRpcDataTypeNames[ADataType]);
|
|
nd.AppendChild(Result);
|
|
end;
|
|
|
|
function TObjectStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
|
|
var
|
|
memberNode, tmpNode : TDOMNode;
|
|
i : Integer;
|
|
chilNodes : TDOMNodeList;
|
|
begin
|
|
AReturnList.Clear();
|
|
if ScopeObject.HasChildNodes() then begin
|
|
memberNode := ScopeObject.FirstChild;
|
|
while ( memberNode <> nil ) do begin
|
|
if memberNode.HasChildNodes() then begin
|
|
chilNodes := memberNode.ChildNodes;
|
|
for i := 0 to Pred(GetNodeListCount(chilNodes)) do begin
|
|
tmpNode := chilNodes.Item[i];
|
|
if AnsiSameText(sNAME,tmpNode.NodeName) then begin
|
|
if ( tmpNode.FirstChild <> nil ) then
|
|
AReturnList.Add(tmpNode.FirstChild.NodeValue)
|
|
else
|
|
AReturnList.Add('');
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
memberNode := memberNode.NextSibling;
|
|
end;
|
|
end;
|
|
Result := AReturnList.Count;
|
|
end;
|
|
|
|
{ TArrayStackItem }
|
|
|
|
procedure TArrayStackItem.EnsureListCreated();
|
|
begin
|
|
if ( FItemList = nil ) then begin
|
|
FItemList := CreateList();
|
|
end;
|
|
end;
|
|
|
|
function TArrayStackItem.GetItemsCount(): Integer;
|
|
begin
|
|
EnsureListCreated();
|
|
if Assigned(FItemList) then begin
|
|
Result := GetNodeListCount(FItemList);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TArrayStackItem.CreateList(): TDOMNodeList;
|
|
begin
|
|
if ScopeObject.HasChildNodes() and ScopeObject.FirstChild.HasChildNodes() then begin
|
|
Result := ScopeObject.FirstChild.ChildNodes;
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TArrayStackItem.FindNode(var ANodeName: string): TDOMNode;
|
|
begin
|
|
EnsureListCreated();
|
|
if ( FIndex >= GetNodeListCount(FItemList) ) then
|
|
raise EXmlRpcException.CreateFmt('Index out of bound : %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
|
|
Result:= FItemList.Item[FIndex];
|
|
if Result.HasChildNodes() then begin
|
|
if Result.FirstChild.HasChildNodes() then
|
|
SetFoundState(fsFoundNonNil)
|
|
else
|
|
SetFoundState(fsFoundNil);
|
|
Result := Result.FirstChild;//.FirstChild;
|
|
Inc(FIndex);
|
|
ANodeName := Result.NodeName;
|
|
end else begin
|
|
raise EXmlRpcException.CreateFmt('Invalid array item : Index = %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
|
|
end;
|
|
end;
|
|
|
|
function TArrayStackItem.CreateBuffer(
|
|
const AName: string;
|
|
const ADataType: TXmlRpcDataType
|
|
): TDOMNode;
|
|
var
|
|
nd : TDOMNode;
|
|
begin
|
|
if ( FDataScope = nil ) then begin
|
|
FDataScope := ScopeObject.OwnerDocument.CreateElement(sDATA);
|
|
ScopeObject.AppendChild(FDataScope);
|
|
end;
|
|
|
|
nd := FDataScope.OwnerDocument.CreateElement(sVALUE);
|
|
FDataScope.AppendChild(nd);
|
|
Result := ScopeObject.OwnerDocument.CreateElement(XmlRpcDataTypeNames[ADataType]);
|
|
nd.AppendChild(Result);
|
|
end;
|
|
|
|
function TArrayStackItem.PushIndex(const AValue: Integer): Integer;
|
|
begin
|
|
if ( FIndexStackIDX = Length(FIndexStack) ) then begin
|
|
if ( Length(FIndexStack) = 0 ) then
|
|
FIndexStackIDX := -1;
|
|
SetLength(FIndexStack, Length(FIndexStack) + 4);
|
|
end;
|
|
Result := FIndex;
|
|
Inc(FIndexStackIDX);
|
|
FIndexStack[FIndexStackIDX] := AValue;
|
|
end;
|
|
|
|
function TArrayStackItem.PopIndex() : Integer;
|
|
begin
|
|
if ( Length(FIndexStack) = 0 ) or ( FIndexStackIDX < 0 ) then
|
|
raise EXmlRpcException.Create('TArrayStackItem.PopIndex() >> No saved index.');
|
|
FIndex := FIndexStack[FIndexStackIDX];
|
|
Dec(FIndexStackIDX);
|
|
end;
|
|
|
|
{ TXmlRpcBaseFormatter }
|
|
|
|
procedure TXmlRpcBaseFormatter.ClearStack();
|
|
Var
|
|
i, c : Integer;
|
|
begin
|
|
c := FStack.Count;
|
|
For I := 1 To c Do
|
|
FStack.Pop().Free();
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PushStack(AScopeObject : TDOMNode) : TStackItem;
|
|
begin
|
|
Result := FStack.Push(TObjectStackItem.Create(AScopeObject,stObject)) as TStackItem;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PushStack(
|
|
AScopeObject : TDOMNode;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): TStackItem;
|
|
begin
|
|
Result := FStack.Push(TArrayStackItem.Create(AScopeObject,stArray)) as TStackItem;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PushStackParams(AScopeObject: TDOMNode): TStackItem;
|
|
begin
|
|
Result := FStack.Push(TParamsArrayStackItem.Create(AScopeObject,stArray)) as TStackItem;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.BeginObjectRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo
|
|
): Integer;
|
|
begin
|
|
Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stObject,asNone,'');
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.BeginArrayRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): Integer;
|
|
begin
|
|
Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stArray,AStyle,AItemName);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer;
|
|
begin
|
|
CheckScope();
|
|
Result := StackTop.GetScopeItemNames(AReturnList);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.EndScopeRead();
|
|
begin
|
|
PopStack().Free();
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.BeginHeader();
|
|
begin
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.EndHeader();
|
|
begin
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.InternalClear(const ACreateDoc: Boolean);
|
|
begin
|
|
ClearStack();
|
|
ReleaseDomNode(FDoc);
|
|
FDoc := nil;
|
|
if ACreateDoc then
|
|
FDoc := CreateDoc();
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.HasScope(): Boolean;
|
|
begin
|
|
Result := FStack.AtLeast(1);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.FindAttributeByValueInNode(
|
|
Const AAttValue : String;
|
|
Const ANode : TDOMNode;
|
|
Out AResAtt : string
|
|
):boolean;
|
|
Var
|
|
i,c : Integer;
|
|
begin
|
|
AResAtt := '';
|
|
If Assigned(ANode) And Assigned(ANode.Attributes) Then Begin
|
|
c := Pred(ANode.Attributes.Length);
|
|
For i := 0 To c Do Begin
|
|
If AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) Then Begin
|
|
AResAtt := ANode.Attributes.Item[i].NodeName;
|
|
Result := True;
|
|
Exit;
|
|
End;
|
|
End;
|
|
End;
|
|
Result := False;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.FindAttributeByNameInNode(
|
|
const AAttName: String;
|
|
const ANode: TDOMNode;
|
|
Out AResAttValue: string
|
|
): boolean;
|
|
var
|
|
i,c : Integer;
|
|
begin
|
|
AResAttValue := '';
|
|
If Assigned(ANode) And Assigned(ANode.Attributes) Then Begin
|
|
c := Pred(ANode.Attributes.Length);
|
|
For i := 0 To c Do Begin
|
|
If AnsiSameText(AAttName,ANode.Attributes.Item[i].NodeName) Then Begin
|
|
AResAttValue := ANode.Attributes.Item[i].NodeValue;
|
|
Result := True;
|
|
Exit;
|
|
End;
|
|
End;
|
|
End;
|
|
Result := False;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.FindAttributeByValueInScope(const AAttValue: String): String;
|
|
Var
|
|
tmpNode : TDOMNode;
|
|
begin
|
|
If HasScope() Then Begin
|
|
tmpNode := GetCurrentScopeObject();
|
|
While Assigned(tmpNode) Do Begin
|
|
If FindAttributeByValueInNode(AAttValue,tmpNode,Result) Then
|
|
Exit;
|
|
tmpNode := tmpNode.ParentNode;
|
|
End;
|
|
End;
|
|
Result := '';
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.FindAttributeByNameInScope(const AAttName: String): String;
|
|
var
|
|
tmpNode : TDOMNode;
|
|
begin
|
|
if HasScope() then begin
|
|
tmpNode := GetCurrentScopeObject();
|
|
while Assigned(tmpNode) do begin
|
|
if FindAttributeByNameInNode(AAttName,tmpNode,Result) then
|
|
Exit;
|
|
tmpNode := tmpNode.ParentNode;
|
|
end;
|
|
end;
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.CheckScope();
|
|
begin
|
|
If Not HasScope() Then
|
|
Error('There is no scope.');
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.InternalPutData(
|
|
const AName : string;
|
|
const AType : TXmlRpcDataType;
|
|
const AData : DOMString
|
|
): TDOMNode;
|
|
begin
|
|
Result := StackTop().CreateBuffer(AName,AType).AppendChild(FDoc.CreateTextNode(AData));
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PutEnum(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: TEnumIntType
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(
|
|
AName,
|
|
xdtString,
|
|
GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,AData))
|
|
);
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
function TXmlRpcBaseFormatter.PutBool(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Boolean
|
|
) : TDOMNode;
|
|
var
|
|
v : Char;
|
|
begin
|
|
if AData then
|
|
v := '1'
|
|
else
|
|
v := '0';
|
|
Result := InternalPutData(AName,xdtBoolean,v);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TXmlRpcBaseFormatter.PutAnsiChar(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: AnsiChar
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(AName,xdtString,AData);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PutWideChar(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: WideChar
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(AName,xdtString,AData);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PutInt64(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Int64
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(AName,xdtInt,IntToStr(AData));
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PutStr(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: String
|
|
):TDOMNode;
|
|
begin
|
|
Result := InternalPutData(
|
|
AName,
|
|
xdtString,
|
|
StringReplace(StringReplace(AData,'<','<',[rfReplaceAll]),'&','&',[rfReplaceAll])
|
|
);
|
|
end;
|
|
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function TXmlRpcBaseFormatter.PutUnicodeStr(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: UnicodeString
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(
|
|
AName,
|
|
xdtString,
|
|
AData//StringReplace(StringReplace(AData,'<','<',[rfReplaceAll]),'&','&',[rfReplaceAll])
|
|
);
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
|
|
function TXmlRpcBaseFormatter.PutWideStr(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: WideString
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(
|
|
AName,
|
|
xdtString,
|
|
AData//StringReplace(StringReplace(AData,'<','<',[rfReplaceAll]),'&','&',[rfReplaceAll])
|
|
);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.PutObj(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : TObject
|
|
);
|
|
begin
|
|
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Save(AData As TBaseRemotable, Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.PutRecord(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Pointer
|
|
);
|
|
begin
|
|
TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PutFloat(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Extended
|
|
):TDOMNode;
|
|
Var
|
|
s, frmt : string;
|
|
prcsn,i : Integer;
|
|
begin
|
|
Case GetTypeData(ATypeInfo)^.FloatType Of
|
|
ftSingle,
|
|
ftCurr,
|
|
ftComp : prcsn := 7;
|
|
ftDouble,
|
|
ftExtended : prcsn := 15;
|
|
End;
|
|
frmt := '#.' + StringOfChar('#',prcsn) + 'E-0';
|
|
s := FormatFloat(frmt,AData);
|
|
i := Pos(',',s);
|
|
If ( i > 0 ) Then
|
|
s[i] := '.';
|
|
Result := InternalPutData(AName,xdtdouble,s);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetNodeValue(var AName: string): DOMString;
|
|
var
|
|
locElt : TDOMNode;
|
|
stkTop : TStackItem;
|
|
begin
|
|
stkTop := StackTop();
|
|
locElt := stkTop.FindNode(AName) as TDOMElement;
|
|
|
|
if Assigned(locElt) then begin
|
|
if locElt.HasChildNodes then begin
|
|
Result := locElt.FirstChild.NodeValue
|
|
end else begin
|
|
if ( stkTop.FoundState = fsFoundNil ) then
|
|
Result := ''
|
|
else
|
|
Result := locElt.NodeValue;
|
|
end;
|
|
end else begin
|
|
Error('Param or Attribute not found : "%s"',[AName]);
|
|
end;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetEnum(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: TEnumIntType
|
|
);
|
|
Var
|
|
locBuffer : String;
|
|
begin
|
|
locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName));
|
|
If IsStrEmpty(locBuffer) Then
|
|
AData := 0
|
|
Else
|
|
AData := GetEnumValue(ATypeInfo,locBuffer)
|
|
End;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TXmlRpcBaseFormatter.GetBool(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Boolean
|
|
);
|
|
Var
|
|
locBuffer : String;
|
|
begin
|
|
locBuffer := LowerCase(Trim(GetNodeValue(AName)));
|
|
If IsStrEmpty(locBuffer) Then
|
|
AData := False
|
|
Else
|
|
AData := StrToBool(locBuffer);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetInt(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: Integer
|
|
);
|
|
begin
|
|
AData := StrToIntDef(Trim(GetNodeValue(AName)),0);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TXmlRpcBaseFormatter.GetAnsiChar(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: AnsiChar
|
|
);
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
locBuffer := GetNodeValue(AName);
|
|
if ( Length(locBuffer) = 0 ) then
|
|
AData := #0
|
|
else
|
|
AData := AnsiChar(locBuffer[1]);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetWideChar(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: WideChar
|
|
);
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
locBuffer := GetNodeValue(AName);
|
|
if ( Length(locBuffer) = 0 ) then
|
|
AData := #0
|
|
else
|
|
AData := locBuffer[1];
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetInt64(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Int64
|
|
);
|
|
begin
|
|
AData := StrToInt64Def(Trim(GetNodeValue(AName)),0);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetFloat(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Extended
|
|
);
|
|
begin
|
|
{$IFDEF HAS_FORMAT_SETTINGS}
|
|
AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings);
|
|
{$ELSE}
|
|
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0);
|
|
{$ENDIF HAS_FORMAT_SETTINGS}
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetStr(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : String
|
|
);
|
|
begin
|
|
AData := GetNodeValue(AName);
|
|
end;
|
|
|
|
{$IFDEF WST_UNICODESTRING}
|
|
procedure TXmlRpcBaseFormatter.GetUnicodeStr(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: UnicodeString
|
|
);
|
|
begin
|
|
AData := GetNodeValue(AName);
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
|
|
procedure TXmlRpcBaseFormatter.GetWideStr(
|
|
const ATypeInfo: PTypeInfo;
|
|
var AName: String;
|
|
var AData: WideString
|
|
);
|
|
begin
|
|
AData := GetNodeValue(AName);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetObj(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : TObject
|
|
);
|
|
begin
|
|
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetRecord(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Pointer
|
|
);
|
|
begin
|
|
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetXmlDoc(): TwstXMLDocument;
|
|
begin
|
|
Result := FDoc;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetCurrentScope(): String;
|
|
begin
|
|
CheckScope();
|
|
Result:= GetCurrentScopeObject().NodeName;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetCurrentScopeObject(): TDOMElement;
|
|
begin
|
|
Result := StackTop().ScopeObject As TDOMElement;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.StackTop(): TStackItem;
|
|
begin
|
|
CheckScope();
|
|
Result := FStack.Peek() as TStackItem;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.PopStack(): TStackItem;
|
|
begin
|
|
CheckScope();
|
|
Result := FStack.Pop() as TStackItem;
|
|
end;
|
|
|
|
constructor TXmlRpcBaseFormatter.Create();
|
|
begin
|
|
Inherited Create();
|
|
FContentType := sXMLRPC_CONTENT_TYPE;
|
|
FStack := TObjectStack.Create();
|
|
FDoc := CreateDoc();
|
|
end;
|
|
|
|
destructor TXmlRpcBaseFormatter.Destroy();
|
|
begin
|
|
ReleaseDomNode(FDoc);
|
|
ClearStack();
|
|
FStack.Free();
|
|
inherited Destroy();
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Clear();
|
|
begin
|
|
InternalClear(True);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.BeginObject(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo
|
|
);
|
|
begin
|
|
BeginScope(AName,'','',stObject,asNone);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.BeginArray(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AItemTypeInfo : PTypeInfo;
|
|
const ABounds : Array Of Integer;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
var
|
|
i,j, k : Integer;
|
|
begin
|
|
if ( Length(ABounds) < 2 ) then begin
|
|
Error('Invalid array bounds.');
|
|
end;
|
|
i := ABounds[0];
|
|
j := ABounds[1];
|
|
k := j - i + 1;
|
|
if ( k < 0 ) then begin
|
|
Error('Invalid array bounds.');
|
|
end;
|
|
|
|
BeginScope(AName,'','',stArray,AStyle);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.NilCurrentScope();
|
|
begin
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.IsCurrentScopeNil(): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.BeginScope(
|
|
Const AScopeName,ANameSpace : string;
|
|
Const ANameSpaceShortName : string;
|
|
Const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
Var
|
|
e : TDOMNode;
|
|
dtType : TXmlRpcDataType;
|
|
begin
|
|
if ( AScopeType = stArray ) then
|
|
dtType := xdtArray
|
|
else
|
|
dtType := xdtStruct;
|
|
if HasScope() then begin
|
|
e := StackTop().CreateBuffer(AScopeName,dtType);
|
|
end else begin
|
|
e := FDoc.CreateElement(XmlRpcDataTypeNames[dtType]);
|
|
FDoc.AppendChild(e);
|
|
end;
|
|
if ( AScopeType = stObject ) then begin
|
|
PushStack(e);
|
|
end else begin
|
|
PushStack(e,AStyle,'');
|
|
end;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.InternalBeginScopeRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): Integer;
|
|
var
|
|
locNode : TDOMNode;
|
|
stk : TStackItem;
|
|
begin
|
|
stk := StackTop();
|
|
locNode := stk.FindNode(AScopeName);
|
|
if ( locNode = nil ) then begin
|
|
Result := -1;
|
|
end else begin
|
|
if ( AScopeType = stObject ) then begin
|
|
PushStack(locNode);
|
|
end else begin
|
|
PushStack(locNode,AStyle,AItemName);
|
|
end;
|
|
Result := StackTop().GetItemsCount();
|
|
end;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle);
|
|
begin
|
|
FSerializationStyle := ASerializationStyle;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetSerializationStyle(): TSerializationStyle;
|
|
begin
|
|
Result := FSerializationStyle;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.EndScope();
|
|
begin
|
|
CheckScope();
|
|
FStack.Pop().Free();
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.AddScopeAttribute(const AName, AValue: string);
|
|
begin
|
|
// CheckScope();
|
|
//GetCurrentScopeObject().SetAttribute(AName,AValue);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Put(
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData
|
|
);
|
|
Var
|
|
int64Data : Int64;
|
|
strData : string;
|
|
objData : TObject;
|
|
{$IFDEF FPC}boolData : Boolean;{$ENDIF}
|
|
enumData : TEnumIntType;
|
|
floatDt : Extended;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
unicodeStrData : UnicodeString;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
wideStrData : WideString;
|
|
ansiCharData : AnsiChar;
|
|
wideCharData : WideChar;
|
|
begin
|
|
Case ATypeInfo^.Kind Of
|
|
tkChar :
|
|
begin
|
|
ansiCharData := AnsiChar(AData);
|
|
PutAnsiChar(AName,ATypeInfo,ansiCharData);
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
wideCharData := WideChar(AData);
|
|
PutWideChar(AName,ATypeInfo,wideCharData);
|
|
end;
|
|
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
|
|
Begin
|
|
int64Data := Int64(AData);
|
|
PutInt64(AName,ATypeInfo,int64Data);
|
|
End;
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
Begin
|
|
strData := String(AData);
|
|
PutStr(AName,ATypeInfo,strData);
|
|
End;
|
|
tkWString :
|
|
Begin
|
|
wideStrData := WideString(AData);
|
|
PutWideStr(AName,ATypeInfo,wideStrData);
|
|
End;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString :
|
|
Begin
|
|
unicodeStrData := UnicodeString(AData);
|
|
PutUnicodeStr(AName,ATypeInfo,unicodeStrData);
|
|
End;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkClass :
|
|
Begin
|
|
objData := TObject(AData);
|
|
PutObj(AName,ATypeInfo,objData);
|
|
End;
|
|
tkRecord :
|
|
begin
|
|
PutRecord(AName,ATypeInfo,Pointer(@AData));
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
Begin
|
|
boolData := Boolean(AData);
|
|
PutBool(AName,ATypeInfo,boolData);
|
|
End;
|
|
{$ENDIF}
|
|
tkInteger, tkEnumeration :
|
|
Begin
|
|
enumData := 0;
|
|
Case GetTypeData(ATypeInfo)^.OrdType Of
|
|
otSByte : enumData := ShortInt(AData);
|
|
otUByte : enumData := Byte(AData);
|
|
otSWord : enumData := SmallInt(AData);
|
|
otUWord : enumData := Word(AData);
|
|
otSLong,
|
|
otULong : enumData := LongInt(AData);
|
|
End;
|
|
If ( ATypeInfo^.Kind = tkInteger ) Then
|
|
PutInt64(AName,ATypeInfo,enumData)
|
|
Else
|
|
PutEnum(AName,ATypeInfo,enumData);
|
|
End;
|
|
tkFloat :
|
|
Begin
|
|
floatDt := 0;
|
|
Case GetTypeData(ATypeInfo)^.FloatType Of
|
|
ftSingle : floatDt := Single(AData);
|
|
ftDouble : floatDt := Double(AData);
|
|
ftExtended : floatDt := Extended(AData);
|
|
ftCurr : floatDt := Currency(AData);
|
|
ftComp : floatDt := Comp(AData);
|
|
End;
|
|
PutFloat(AName,ATypeInfo,floatDt);
|
|
End;
|
|
End;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Put(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo; const AData
|
|
);
|
|
begin
|
|
Put(AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.PutScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData
|
|
);
|
|
Var
|
|
int64SData : Int64;
|
|
{$IFDEF FPC}
|
|
int64UData : QWord;
|
|
boolData : Boolean;
|
|
{$ENDIF}
|
|
strData : string;
|
|
enumData : TEnumIntType;
|
|
floatDt : Extended;
|
|
dataBuffer : DOMString;
|
|
frmt : string;
|
|
prcsn,i : Integer;
|
|
wideStrData : WideString;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
unicodeStrData : UnicodeString;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
ansiCharData : AnsiChar;
|
|
wideCharData : WideChar;
|
|
begin
|
|
CheckScope();
|
|
Case ATypeInfo^.Kind Of
|
|
tkChar :
|
|
begin
|
|
ansiCharData := AnsiChar(AData);
|
|
dataBuffer := ansiCharData;
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
wideCharData := WideChar(AData);
|
|
dataBuffer := wideCharData;
|
|
end;
|
|
tkInt64 :
|
|
begin
|
|
int64SData := Int64(AData);
|
|
dataBuffer := IntToStr(int64SData);
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkQWord :
|
|
begin
|
|
int64UData := QWord(AData);
|
|
dataBuffer := IntToStr(int64UData);
|
|
end;
|
|
{$ENDIF}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
begin
|
|
strData := string(AData);
|
|
dataBuffer := strData;
|
|
end;
|
|
tkWString :
|
|
begin
|
|
wideStrData := WideString(AData);
|
|
dataBuffer := wideStrData;
|
|
end;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString :
|
|
begin
|
|
unicodeStrData := UnicodeString(AData);
|
|
dataBuffer := unicodeStrData;
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkClass :
|
|
begin
|
|
raise EXmlRpcException.Create('Inner Scope value must be a "simple type" value.');
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
begin
|
|
boolData := Boolean(AData);
|
|
dataBuffer := BoolToStr(boolData);
|
|
end;
|
|
{$ENDIF}
|
|
tkInteger :
|
|
begin
|
|
case GetTypeData(ATypeInfo)^.OrdType of
|
|
otSByte : enumData := ShortInt(AData);
|
|
otUByte : enumData := Byte(AData);
|
|
otSWord : enumData := SmallInt(AData);
|
|
otUWord : enumData := Word(AData);
|
|
otSLong,
|
|
otULong : enumData := LongInt(AData);
|
|
end;
|
|
dataBuffer := IntToStr(enumData);
|
|
end;
|
|
tkEnumeration :
|
|
begin
|
|
enumData := 0;
|
|
case GetTypeData(ATypeInfo)^.OrdType of
|
|
otSByte : enumData := ShortInt(AData);
|
|
otUByte : enumData := Byte(AData);
|
|
otSWord : enumData := SmallInt(AData);
|
|
otUWord : enumData := Word(AData);
|
|
otSLong,
|
|
otULong : enumData := LongInt(AData);
|
|
end;
|
|
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
|
|
end;
|
|
tkFloat :
|
|
begin
|
|
floatDt := 0;
|
|
case GetTypeData(ATypeInfo)^.FloatType of
|
|
ftSingle :
|
|
begin
|
|
floatDt := Single(AData);
|
|
prcsn := 7;
|
|
end;
|
|
ftDouble :
|
|
begin
|
|
floatDt := Double(AData);
|
|
prcsn := 15;
|
|
end;
|
|
ftExtended :
|
|
begin
|
|
floatDt := Extended(AData);
|
|
prcsn := 15;
|
|
end;
|
|
ftCurr :
|
|
begin
|
|
floatDt := Currency(AData);
|
|
prcsn := 7;
|
|
end;
|
|
ftComp :
|
|
begin
|
|
floatDt := Comp(AData);
|
|
prcsn := 7;
|
|
end;
|
|
end;
|
|
frmt := '#.' + StringOfChar('#',prcsn) + 'E-0';
|
|
dataBuffer := FormatFloat(frmt,floatDt);
|
|
i := Pos(',',dataBuffer);
|
|
if ( i > 0 ) then
|
|
dataBuffer[i] := '.';
|
|
end;
|
|
end;
|
|
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData
|
|
);
|
|
Var
|
|
int64Data : Int64;
|
|
strData : string;
|
|
objData : TObject;
|
|
{$IFDEF FPC}boolData : Boolean;{$ENDIF}
|
|
enumData : TEnumIntType;
|
|
floatDt : Extended;
|
|
recObject : Pointer;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
unicodeStrData : UnicodeString;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
wideStrData : WideString;
|
|
ansiCharData : AnsiChar;
|
|
wideCharData : WideChar;
|
|
begin
|
|
Case ATypeInfo^.Kind Of
|
|
tkChar :
|
|
begin
|
|
ansiCharData := #0;
|
|
GetAnsiChar(ATypeInfo,AName,ansiCharData);
|
|
AnsiChar(AData) := ansiCharData;
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
wideCharData := #0;
|
|
GetWideChar(ATypeInfo,AName,wideCharData);
|
|
WideChar(AData) := wideCharData;
|
|
end;
|
|
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
|
|
Begin
|
|
int64Data := 0;
|
|
GetInt64(ATypeInfo,AName,int64Data);
|
|
Int64(AData) := int64Data;
|
|
End;
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
Begin
|
|
strData := '';
|
|
GetStr(ATypeInfo,AName,strData);
|
|
String(AData) := strData;
|
|
End;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString :
|
|
begin
|
|
unicodeStrData := '';
|
|
GetUnicodeStr(ATypeInfo,AName,unicodeStrData);
|
|
UnicodeString(AData) := unicodeStrData;
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkWString :
|
|
begin
|
|
wideStrData := '';
|
|
GetWideStr(ATypeInfo,AName,wideStrData);
|
|
WideString(AData) := wideStrData;
|
|
end;
|
|
tkClass :
|
|
Begin
|
|
objData := TObject(AData);
|
|
GetObj(ATypeInfo,AName,objData);
|
|
TObject(AData) := objData;
|
|
End;
|
|
tkRecord :
|
|
begin
|
|
recObject := Pointer(@AData);
|
|
GetRecord(ATypeInfo,AName,recObject);
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
Begin
|
|
boolData := False;
|
|
GetBool(ATypeInfo,AName,boolData);
|
|
Boolean(AData) := boolData;
|
|
End;
|
|
{$ENDIF}
|
|
tkInteger, tkEnumeration :
|
|
Begin
|
|
enumData := 0;
|
|
If ( ATypeInfo^.Kind = tkInteger ) Then
|
|
GetInt64(ATypeInfo,AName,enumData)
|
|
Else
|
|
GetEnum(ATypeInfo,AName,enumData);
|
|
Case GetTypeData(ATypeInfo)^.OrdType Of
|
|
otSByte : ShortInt(AData) := enumData;
|
|
otUByte : Byte(AData) := enumData;
|
|
otSWord : SmallInt(AData) := enumData;
|
|
otUWord : Word(AData) := enumData;
|
|
otSLong,
|
|
otULong : LongInt(AData) := enumData;
|
|
End;
|
|
End;
|
|
tkFloat :
|
|
Begin
|
|
floatDt := 0;
|
|
GetFloat(ATypeInfo,AName,floatDt);
|
|
Case GetTypeData(ATypeInfo)^.FloatType Of
|
|
ftSingle : Single(AData) := floatDt;
|
|
ftDouble : Double(AData) := floatDt;
|
|
ftExtended : Extended(AData) := floatDt;
|
|
ftCurr : Currency(AData) := floatDt;
|
|
{$IFDEF HAS_COMP}
|
|
ftComp : Comp(AData) := floatDt;
|
|
{$ENDIF}
|
|
End;
|
|
End;
|
|
End;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : string;
|
|
var AData
|
|
);
|
|
begin
|
|
Get(ATypeInfo,AName,AData);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.GetScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AData
|
|
);
|
|
Var
|
|
enumData : TEnumIntType;
|
|
floatDt : Extended;
|
|
dataBuffer : DOMString;
|
|
nd : TDOMNode;
|
|
begin
|
|
CheckScope();
|
|
nd := StackTop().ScopeObject;
|
|
if nd.HasChildNodes() then
|
|
dataBuffer := nd.FirstChild.NodeValue
|
|
else
|
|
dataBuffer := StackTop().ScopeObject.NodeValue;
|
|
Case ATypeInfo^.Kind Of
|
|
tkChar :
|
|
begin
|
|
if ( Length(dataBuffer) > 0 ) then
|
|
AnsiChar(AData) := AnsiChar(dataBuffer[1])
|
|
else
|
|
AnsiChar(AData) := #0;
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
if ( Length(dataBuffer) > 0 ) then
|
|
WideChar(AData) :=dataBuffer[1]
|
|
else
|
|
WideChar(AData) := #0;
|
|
end;
|
|
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
|
|
{$IFDEF FPC}
|
|
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);
|
|
{$ENDIF}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} : string(AData) := dataBuffer;
|
|
tkWString : WideString(AData) := dataBuffer;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString : UnicodeString(AData) := dataBuffer;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkClass :
|
|
begin
|
|
raise EXmlRpcException.Create('Inner Scope value must be a "simple type" value.');
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
begin
|
|
dataBuffer := LowerCase(Trim(dataBuffer));
|
|
if IsStrEmpty(dataBuffer) then
|
|
Boolean(AData) := False
|
|
else
|
|
Boolean(AData) := StrToBool(dataBuffer);
|
|
end;
|
|
{$ENDIF}
|
|
tkInteger, tkEnumeration :
|
|
begin
|
|
if ( ATypeInfo^.Kind = tkInteger ) then
|
|
enumData := StrToIntDef(Trim(dataBuffer),0)
|
|
else
|
|
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
|
|
case GetTypeData(ATypeInfo)^.OrdType of
|
|
otSByte : ShortInt(AData) := enumData;
|
|
otUByte : Byte(AData) := enumData;
|
|
otSWord : SmallInt(AData) := enumData;
|
|
otUWord : Word(AData) := enumData;
|
|
otSLong,
|
|
otULong : LongInt(AData) := enumData;
|
|
end;
|
|
end;
|
|
tkFloat :
|
|
begin
|
|
{$IFDEF HAS_FORMAT_SETTINGS}
|
|
floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings);
|
|
{$ELSE}
|
|
floatDt := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(dataBuffer)),0);
|
|
{$ENDIF HAS_FORMAT_SETTINGS}
|
|
case GetTypeData(ATypeInfo)^.FloatType of
|
|
ftSingle : Single(AData) := floatDt;
|
|
ftDouble : Double(AData) := floatDt;
|
|
ftExtended : Extended(AData) := floatDt;
|
|
ftCurr : Currency(AData) := floatDt;
|
|
{$IFDEF HAS_COMP}
|
|
ftComp : Comp(AData) := floatDt;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.ReadBuffer (const AName : string ) : string;
|
|
var
|
|
locElt : TDOMNode;
|
|
stkTop : TStackItem;
|
|
locName : string;
|
|
begin
|
|
stkTop := StackTop();
|
|
locName := AName;
|
|
locElt := stkTop.FindNode(locName);
|
|
|
|
if Assigned(locElt) then begin
|
|
Result := NodeToBuffer(locElt);
|
|
end else begin
|
|
Error('Param or Attribute not found : "%s"',[AName]);
|
|
end;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.SaveToStream(AStream: TStream);
|
|
begin
|
|
WriteXMLFile(FDoc,AStream);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.LoadFromStream(AStream: TStream);
|
|
Var
|
|
nd : TDOMNode;
|
|
begin
|
|
InternalClear(False);
|
|
ReadXMLFile(FDoc,AStream);
|
|
nd := GetXmlDoc().DocumentElement;
|
|
If Assigned(nd) Then
|
|
PushStack(nd);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Error(const AMsg: string);
|
|
begin
|
|
Raise EXmlRpcException.Create(AMsg);
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.Error(const AMsg: string;const AArgs: array of const);
|
|
begin
|
|
Raise EXmlRpcException.CreateFmt(AMsg,AArgs);
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetFormatName() : string;
|
|
begin
|
|
Result := sPROTOCOL_NAME;
|
|
end;
|
|
|
|
function TXmlRpcBaseFormatter.GetPropertyManager() : IPropertyManager;
|
|
begin
|
|
If Not Assigned(FPropMngr) Then
|
|
FPropMngr := TPublishedPropertyManager.Create(Self);
|
|
Result := FPropMngr;
|
|
end;
|
|
|
|
procedure TXmlRpcBaseFormatter.WriteBuffer(const AValue: string);
|
|
var
|
|
strm : TStringStream;
|
|
locDoc : TwstXMLDocument;
|
|
locNode : TDOMNode;
|
|
begin
|
|
CheckScope();
|
|
locDoc := nil;
|
|
strm := TStringStream.Create(AValue);
|
|
try
|
|
ReadXMLFile(locDoc,strm);
|
|
locNode := locDoc.DocumentElement.CloneNode(True {$IFDEF FPC}, StackTop().ScopeObject.OwnerDocument{$ENDIF});
|
|
StackTop().ScopeObject.AppendChild(locNode);
|
|
finally
|
|
ReleaseDomNode(locDoc);
|
|
strm.Free();
|
|
end;
|
|
end;
|
|
|
|
{ TParamsArrayStackItem }
|
|
|
|
procedure TParamsArrayStackItem.EnsureListCreated();
|
|
begin
|
|
if ( FItemList = nil ) then begin
|
|
FItemList := CreateList();
|
|
end;
|
|
end;
|
|
|
|
function TParamsArrayStackItem.GetItemsCount(): Integer;
|
|
begin
|
|
EnsureListCreated();
|
|
if Assigned(FItemList) then begin
|
|
Result := GetNodeListCount(FItemList);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TParamsArrayStackItem.CreateList(): TDOMNodeList;
|
|
begin
|
|
if ScopeObject.HasChildNodes() then begin
|
|
Result := ScopeObject.ChildNodes;
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TParamsArrayStackItem.FindNode(var ANodeName: string): TDOMNode;
|
|
begin
|
|
EnsureListCreated();
|
|
if ( FIndex >= GetNodeListCount(FItemList) ) then
|
|
raise EXmlRpcException.CreateFmt('Index out of bound : %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
|
|
Result:= FItemList.Item[FIndex];
|
|
if Result.HasChildNodes() then begin
|
|
if Result.FirstChild.HasChildNodes() then
|
|
SetFoundState(fsFoundNonNil)
|
|
else
|
|
SetFoundState(fsFoundNil);
|
|
Result := Result.FirstChild.FirstChild;
|
|
Inc(FIndex);
|
|
ANodeName := Result.NodeName;
|
|
end else begin
|
|
raise EXmlRpcException.CreateFmt('Invalid array item : Index = %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
|
|
end;
|
|
end;
|
|
|
|
function TParamsArrayStackItem.CreateBuffer(
|
|
const AName: string;
|
|
const ADataType: TXmlRpcDataType
|
|
): TDOMNode;
|
|
var
|
|
prmNode, valueNode : TDOMNode;
|
|
begin
|
|
prmNode := ScopeObject.OwnerDocument.CreateElement(sPARAM);
|
|
ScopeObject.AppendChild(prmNode);
|
|
valueNode := ScopeObject.OwnerDocument.CreateElement(sVALUE);
|
|
prmNode.AppendChild(valueNode);
|
|
Result := ScopeObject.OwnerDocument.CreateElement(XmlRpcDataTypeNames[ADataType]);
|
|
valueNode.AppendChild(Result);
|
|
end;
|
|
|
|
{ TBaseArrayStackItem }
|
|
|
|
destructor TBaseArrayStackItem.Destroy;
|
|
begin
|
|
SetLength(FIndexStack,0);
|
|
if Assigned(FItemList) then
|
|
ReleaseDomNode(FItemList);
|
|
inherited Destroy();
|
|
end;
|
|
|
|
function TBaseArrayStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
|
|
var
|
|
i : Integer;
|
|
locName : string;
|
|
begin
|
|
AReturnList.Clear();
|
|
PushIndex(0);
|
|
try
|
|
locName := '';
|
|
for i := 0 to Pred(GetItemsCount()) do begin
|
|
FindNode(locName);
|
|
AReturnList.Add(locName);
|
|
end;
|
|
finally
|
|
PopIndex();
|
|
end;
|
|
Result := AReturnList.Count;
|
|
end;
|
|
|
|
function TBaseArrayStackItem.PopIndex() : Integer;
|
|
begin
|
|
if ( Length(FIndexStack) = 0 ) or ( FIndexStackIDX < 0 ) then
|
|
raise EXmlRpcException.Create('TArrayStackItem.PopIndex() >> No saved index.');
|
|
Result := FIndex;
|
|
FIndex := FIndexStack[FIndexStackIDX];
|
|
Dec(FIndexStackIDX);
|
|
end;
|
|
|
|
function TBaseArrayStackItem.PushIndex(const AValue: Integer): Integer;
|
|
begin
|
|
if ( FIndexStackIDX = Length(FIndexStack) ) then begin
|
|
if ( Length(FIndexStack) = 0 ) then
|
|
FIndexStackIDX := -1;
|
|
SetLength(FIndexStack, Length(FIndexStack) + 4);
|
|
end;
|
|
Inc(FIndexStackIDX);
|
|
Result := FIndex;
|
|
FIndex := AValue;
|
|
FIndexStack[FIndexStackIDX] := Result;
|
|
end;
|
|
|
|
end.
|