12b1944b8c
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5823 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2493 lines
69 KiB
ObjectPascal
2493 lines
69 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_soap_formatter;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, TypInfo, Contnrs,
|
|
{$IFDEF WST_DELPHI}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
|
|
base_service_intf;
|
|
|
|
const
|
|
sPROTOCOL_NAME = 'SOAP';
|
|
|
|
sXML_NS = 'xmlns';
|
|
sXSI_NS = 'http://www.w3.org/1999/XMLSchema-instance';
|
|
sTYPE = 'type';
|
|
sNIL = 'nil';
|
|
|
|
sSOAP_ENC = 'http://schemas.xmlsoap.org/soap/encoding/';
|
|
sSOAP_ENC_ABR = 'SOAP-ENC';
|
|
|
|
sARRAY_TYPE = 'arrayType';
|
|
|
|
sCONTENT_TYPE = 'contenttype';
|
|
sFORMAT = 'format';
|
|
sSOAP_CONTENT_TYPE = 'text/xml';
|
|
|
|
sHEADER = 'Header';
|
|
sENVELOPE = 'Envelope';
|
|
sHREF = 'href';
|
|
|
|
type
|
|
|
|
TwstXMLDocument = {$IFDEF WST_DELPHI}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF};
|
|
|
|
TEnumIntType = Int64;
|
|
|
|
{ ESOAPException }
|
|
|
|
ESOAPException = class(EBaseRemoteException)
|
|
End;
|
|
|
|
{ TStackItem }
|
|
|
|
TStackItem = class
|
|
private
|
|
FAttributeFormUnqualified: Boolean;
|
|
FElementFormUnqualified: Boolean;
|
|
FEmbeddedScopeCount: Integer;
|
|
FNameSpace: string;
|
|
FScopeObject: TDOMNode;
|
|
FScopeType: TScopeType;
|
|
protected
|
|
function GetItemsCount : Integer;virtual;
|
|
function GetActualNodeIfIsHRef(const ANode : TDOMNode) : TDOMNode;
|
|
Public
|
|
constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType);
|
|
function FindNode(var ANodeName : string):TDOMNode;virtual;abstract;
|
|
procedure SetNameSpace(const ANameSpace : string);
|
|
property ScopeObject : TDOMNode Read FScopeObject;
|
|
property ScopeType : TScopeType Read FScopeType;
|
|
property NameSpace : string Read FNameSpace;
|
|
property ItemsCount : Integer read GetItemsCount;
|
|
|
|
property EmbeddedScopeCount : Integer read FEmbeddedScopeCount;
|
|
function BeginEmbeddedScope() : Integer;
|
|
function EndEmbeddedScope() : Integer;
|
|
|
|
function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;
|
|
|
|
property ElementFormUnqualified : Boolean read FElementFormUnqualified write FElementFormUnqualified;
|
|
property AttributeFormUnqualified : Boolean read FAttributeFormUnqualified write FAttributeFormUnqualified;
|
|
End;
|
|
|
|
{ TObjectStackItem }
|
|
|
|
TObjectStackItem = class(TStackItem)
|
|
Public
|
|
function FindNode(var ANodeName : string):TDOMNode;override;
|
|
End;
|
|
|
|
{ TAbstractArrayStackItem }
|
|
|
|
TAbstractArrayStackItem = class(TStackItem)
|
|
private
|
|
FItemList : TDOMNodeList;
|
|
FIndex : Integer;
|
|
FItemName : string;
|
|
protected
|
|
procedure EnsureListCreated();
|
|
function GetItemsCount() : Integer;override;
|
|
function CreateList(const ANodeName : string):TDOMNodeList;virtual;abstract;
|
|
public
|
|
constructor Create(
|
|
AScopeObject : TDOMNode;
|
|
const AScopeType : TScopeType;
|
|
const AItemName : string
|
|
);
|
|
destructor Destroy();override;
|
|
function FindNode(var ANodeName : string):TDOMNode;override;
|
|
end;
|
|
|
|
{ TScopedArrayStackItem }
|
|
|
|
TScopedArrayStackItem = class(TAbstractArrayStackItem)
|
|
protected
|
|
function CreateList(const ANodeName : string):TDOMNodeList;override;
|
|
public
|
|
destructor Destroy();override;
|
|
end;
|
|
|
|
{ TEmbeddedArrayStackItem }
|
|
|
|
TEmbeddedArrayStackItem = class(TAbstractArrayStackItem)
|
|
protected
|
|
function CreateList(const ANodeName : string):TDOMNodeList;override;
|
|
end;
|
|
|
|
TSOAPEncodingStyle = ( Literal, Encoded );
|
|
TSOAPDocumentStyle = ( RPC, Document );
|
|
|
|
{$M+}
|
|
|
|
{ TSOAPBaseFormatter }
|
|
|
|
TSOAPBaseFormatter = class(TSimpleFactoryItem,IFormatterBase)
|
|
private
|
|
FPropMngr : IPropertyManager;
|
|
FContentType: string;
|
|
FEncodingStyle: TSOAPEncodingStyle;
|
|
FStyle: TSOAPDocumentStyle;
|
|
FHeaderEnterCount : Integer;
|
|
|
|
FNameSpaceCounter : Integer;
|
|
FDoc : TwstXMLDocument;
|
|
FStack : TObjectStack;
|
|
|
|
FKeepedStyle : TSOAPDocumentStyle;
|
|
FKeepedEncoding : TSOAPEncodingStyle;
|
|
FSerializationStyle : TSerializationStyle;
|
|
|
|
procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
function NextNameSpaceCounter():Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function InternalPutData(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : DOMString
|
|
):TDOMNode;
|
|
function PutEnum(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : TEnumIntType
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutBool(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : Boolean
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutAnsiChar(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : AnsiChar
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutWideChar(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : WideChar
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutInt64(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : Int64
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF HAS_QWORD}
|
|
function PutUInt64(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : QWord
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF HAS_QWORD}
|
|
function PutStr(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : String
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function PutUnicodeStr(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : UnicodeString
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF WST_UNICODESTRING}
|
|
function PutWideStr(
|
|
const ANameSpace : string;
|
|
Const AName : String;
|
|
Const ATypeInfo : PTypeInfo;
|
|
Const AData : WideString
|
|
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function PutFloat(
|
|
const ANameSpace : string;
|
|
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(
|
|
const ANameSpace : string;
|
|
var AName : string;
|
|
out AResBuffer : DOMString
|
|
) : Boolean;
|
|
function GetEnum(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : TEnumIntType
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetBool(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : Boolean
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetAnsiChar(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : AnsiChar
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetWideChar(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : WideChar
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF FPC}
|
|
function GetInt(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : Integer
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
function GetInt64(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : Int64
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF HAS_QWORD}
|
|
function GetUInt64(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : QWord
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF HAS_QWORD}
|
|
function GetFloat(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : Extended
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : String
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function GetUnicodeStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : UnicodeString
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF WST_UNICODESTRING}
|
|
function GetWideStr(
|
|
Const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
Var AName : String;
|
|
Var AData : WideString
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetObj(
|
|
Const ATypeInfo : PTypeInfo;
|
|
Var AName : String;
|
|
Var AData : TObject
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function GetRecord(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Pointer
|
|
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
protected
|
|
function GetXmlDoc():TwstXMLDocument;{$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 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;
|
|
function GetNameSpaceShortName(
|
|
const ANameSpace : string;
|
|
const ACreateIfNotFound : Boolean
|
|
):shortstring;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
function FindXMLNodeWithNamespaceInSubScope(ANameSpace, ANodeName: string): TDOMNode;
|
|
protected
|
|
function GetCurrentScope():String;
|
|
function GetCurrentScopeObject():TDOMElement;
|
|
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;
|
|
procedure SetStyleAndEncoding(
|
|
const AStyle : TSOAPDocumentStyle;
|
|
const AEncoding : TSOAPEncodingStyle
|
|
);
|
|
procedure RestoreStyleAndEncoding();
|
|
procedure Prepare();
|
|
function ReadHeaders(ACallContext : ICallContext):Integer;
|
|
function WriteHeaders(ACallContext : ICallContext):Integer;
|
|
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
|
|
);
|
|
function Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : string;
|
|
var AData
|
|
) : Boolean; overload;
|
|
function Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : string;
|
|
var AData
|
|
) : Boolean;overload;
|
|
procedure GetScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AData
|
|
);
|
|
function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
|
|
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 EncodingStyle : TSOAPEncodingStyle Read FEncodingStyle Write FEncodingStyle;
|
|
property ContentType : string Read FContentType Write FContentType;
|
|
property Style : TSOAPDocumentStyle Read FStyle Write FStyle;
|
|
End;
|
|
{$M-}
|
|
|
|
|
|
function BoolToSoapBool(const AValue : Boolean) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
|
|
implementation
|
|
uses
|
|
{$IFDEF WST_DELPHI}
|
|
XMLDoc,XMLIntf,
|
|
{$ENDIF WST_DELPHI}
|
|
{$IFDEF FPC}
|
|
XMLWrite, XMLRead,wst_fpc_xml,
|
|
{$ENDIF FPC}
|
|
StrUtils, imp_utils, wst_consts;
|
|
|
|
|
|
function BoolToSoapBool(const AValue : Boolean) : string;
|
|
begin
|
|
if AValue then
|
|
Result := 'true'
|
|
else
|
|
Result := 'false';
|
|
end;
|
|
|
|
{ TStackItem }
|
|
|
|
function TStackItem.GetItemsCount: Integer;
|
|
begin
|
|
Result := GetNodeItemsCount(ScopeObject);
|
|
end;
|
|
|
|
function TStackItem.GetActualNodeIfIsHRef(const ANode: TDOMNode): TDOMNode;
|
|
var
|
|
locAttrs : TDOMNamedNodeMap;
|
|
|
|
function FollowIfNeeded() : TDOMNode;
|
|
var
|
|
locNode : TDOMNode;
|
|
locHRefValue : DOMString;
|
|
begin
|
|
locNode := locAttrs.GetNamedItem(sHREF);
|
|
if ( locNode = nil ) or ( Length(locNode.NodeValue) = 0 ) then begin
|
|
Result := ANode;
|
|
end else begin
|
|
locHRefValue := locNode.NodeValue;
|
|
if ( locHRefValue[1] = '#' ) then
|
|
locHRefValue := Copy(locHRefValue,2,Length(locHRefValue));
|
|
Result := SelectSingleNode(Format('//*[@id=%s]',[QuotedStr(locHRefValue)]),locNode.OwnerDocument,True);
|
|
//ANode.OwnerDocument.GetElementById(locHRefValue);
|
|
if ( Result = nil ) then
|
|
raise ESOAPException.CreateFmt(SERR_NodeNotFoundByID,[locHRefValue]);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if ( ANode = nil ) then begin
|
|
Result := nil;
|
|
end else begin
|
|
locAttrs := ANode.Attributes;
|
|
if ( locAttrs <> nil ) and ( locAttrs.Length > 0 ) then
|
|
Result := FollowIfNeeded()
|
|
else
|
|
Result := ANode;
|
|
end;
|
|
end;
|
|
|
|
constructor TStackItem.Create(AScopeObject: TDOMNode; AScopeType: TScopeType);
|
|
begin
|
|
FScopeObject := AScopeObject;
|
|
FScopeType := AScopeType;
|
|
end;
|
|
|
|
procedure TStackItem.SetNameSpace(const ANameSpace: string);
|
|
begin
|
|
FNameSpace := ANameSpace;
|
|
end;
|
|
|
|
function TStackItem.BeginEmbeddedScope(): Integer;
|
|
begin
|
|
Inc(FEmbeddedScopeCount);
|
|
Result := FEmbeddedScopeCount;
|
|
end;
|
|
|
|
function TStackItem.EndEmbeddedScope(): Integer;
|
|
begin
|
|
if ( FEmbeddedScopeCount < 1 ) then begin
|
|
raise Exception.Create(SERR_InvalidEmbeddedScopeOperation);
|
|
end;
|
|
Dec(FEmbeddedScopeCount);
|
|
Result := FEmbeddedScopeCount;
|
|
end;
|
|
|
|
function TStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
AReturnList.Clear();
|
|
for i := 0 to Pred(GetItemsCount()) do begin
|
|
AReturnList.Add(ScopeObject.childNodes.Item[i].nodeName);
|
|
end;
|
|
Result := AReturnList.Count;
|
|
end;
|
|
|
|
{ TObjectStackItem }
|
|
|
|
function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode;
|
|
begin
|
|
{$IFDEF WST_DELPHI}
|
|
Result := wst_delphi_xml.FindNode(ScopeObject,ANodeName);
|
|
{$ELSE}
|
|
Result := ScopeObject.FindNode(ANodeName);
|
|
{$ENDIF}
|
|
Result := GetActualNodeIfIsHRef(Result);
|
|
end;
|
|
|
|
{ TAbstractArrayStackItem }
|
|
|
|
procedure TAbstractArrayStackItem.EnsureListCreated();
|
|
begin
|
|
if ( FItemList = nil ) then begin
|
|
FItemList := CreateList(FItemName);
|
|
end;
|
|
end;
|
|
|
|
function TAbstractArrayStackItem.GetItemsCount(): Integer;
|
|
begin
|
|
EnsureListCreated();
|
|
if Assigned(FItemList) then begin
|
|
Result := GetNodeListCount(FItemList);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
constructor TAbstractArrayStackItem.Create(
|
|
AScopeObject : TDOMNode;
|
|
const AScopeType : TScopeType;
|
|
const AItemName : string
|
|
);
|
|
begin
|
|
inherited Create(AScopeObject,AScopeType);
|
|
FItemName := AItemName;
|
|
end;
|
|
|
|
destructor TAbstractArrayStackItem.Destroy();
|
|
begin
|
|
if Assigned(FItemList) then
|
|
ReleaseDomNode(FItemList);
|
|
inherited Destroy();
|
|
end;
|
|
|
|
function TAbstractArrayStackItem.FindNode(var ANodeName: string): TDOMNode;
|
|
begin
|
|
EnsureListCreated();
|
|
if ( FIndex >= GetNodeListCount(FItemList) ) then
|
|
raise ESOAPException.CreateFmt('Index out of bound : %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
|
|
Result:= FItemList.Item[FIndex];
|
|
Inc(FIndex);
|
|
ANodeName := Result.NodeName;
|
|
Result := GetActualNodeIfIsHRef(Result);
|
|
end;
|
|
|
|
{ TSOAPBaseFormatter }
|
|
|
|
procedure TSOAPBaseFormatter.ClearStack();
|
|
begin
|
|
while HasScope() do begin
|
|
EndScope();
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PushStack(AScopeObject : TDOMNode) : TStackItem;
|
|
begin
|
|
Result := FStack.Push(TObjectStackItem.Create(AScopeObject,stObject)) as TStackItem;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PushStack(
|
|
AScopeObject : TDOMNode;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): TStackItem;
|
|
begin
|
|
case AStyle of
|
|
asScoped : Result := FStack.Push(TScopedArrayStackItem.Create(AScopeObject,stArray,AItemName)) as TStackItem;
|
|
asEmbeded : Result := FStack.Push(TEmbeddedArrayStackItem.Create(AScopeObject,stArray,AItemName)) as TStackItem;
|
|
else begin
|
|
Assert(False);
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.BeginObjectRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo
|
|
): Integer;
|
|
begin
|
|
Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stObject,asNone,'');
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.BeginArrayRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): Integer;
|
|
begin
|
|
Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stArray,AStyle,AItemName);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer;
|
|
begin
|
|
CheckScope();
|
|
Result := StackTop().GetScopeItemNames(AReturnList);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.EndScopeRead();
|
|
begin
|
|
PopStack().Free();
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.BeginHeader();
|
|
begin
|
|
if ( FHeaderEnterCount <= 0 ) then begin
|
|
Inc(FHeaderEnterCount);
|
|
Prepare();
|
|
SetStyleAndEncoding(Document,Literal);
|
|
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.EndHeader();
|
|
begin
|
|
if ( FHeaderEnterCount > 0 ) then begin
|
|
Dec(FHeaderEnterCount);
|
|
RestoreStyleAndEncoding();
|
|
EndScope();
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.InternalClear(const ACreateDoc: Boolean);
|
|
begin
|
|
ClearStack();
|
|
ReleaseDomNode(FDoc);
|
|
FDoc := nil;
|
|
if ACreateDoc then
|
|
FDoc := CreateDoc();
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.NextNameSpaceCounter(): Integer;
|
|
begin
|
|
Inc(FNameSpaceCounter);
|
|
Result := FNameSpaceCounter;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.HasScope(): Boolean;
|
|
begin
|
|
Result := FStack.AtLeast(1);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.FindAttributeByValueInNode(
|
|
Const AAttValue : String;
|
|
Const ANode : TDOMNode;
|
|
Out AResAtt : string
|
|
):boolean;
|
|
Var
|
|
i,c : Integer;
|
|
begin
|
|
AResAtt := '';
|
|
if Assigned(ANode) and
|
|
Assigned(ANode.Attributes) and
|
|
( ANode.Attributes.Length > 0 )
|
|
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 TSOAPBaseFormatter.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 := ANode.Attributes.Length;
|
|
if ( c > 0 ) then begin
|
|
Dec(c);
|
|
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;
|
|
End;
|
|
Result := False;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.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 TSOAPBaseFormatter.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;
|
|
|
|
function TSOAPBaseFormatter.GetNameSpaceShortName(
|
|
const ANameSpace : string;
|
|
const ACreateIfNotFound : Boolean
|
|
): shortstring;
|
|
begin
|
|
Result := FindAttributeByValueInScope(ANameSpace);
|
|
if IsStrEmpty(Result) then begin
|
|
if ACreateIfNotFound then begin
|
|
Result := 'ns' + IntToStr(NextNameSpaceCounter());
|
|
AddScopeAttribute('xmlns:'+Result, ANameSpace);
|
|
end;
|
|
end else begin
|
|
Result := Copy(Result,Length('xmlns:')+1,MaxInt);
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.CheckScope();
|
|
begin
|
|
If Not HasScope() Then
|
|
Error(SERR_NoScope);
|
|
end;
|
|
|
|
function ExtractNameSpaceShortName(const ANameSpaceDeclaration : string):string;
|
|
var
|
|
i : integer;
|
|
begin
|
|
i := AnsiPos(sXML_NS,ANameSpaceDeclaration);
|
|
if ( i > 0 ) then begin
|
|
Result := Copy(ANameSpaceDeclaration, (i + Length(sXML_NS) + 1 ), MaxInt );
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
function TSOAPBaseFormatter.FindXMLNodeWithNamespaceInSubScope(
|
|
ANameSpace,
|
|
ANodeName : string
|
|
) : TDOMNode;
|
|
|
|
function ScanNode(ANode: TDOMNode): TDOMNode;
|
|
var
|
|
AttrName : string;
|
|
begin
|
|
Result := nil;
|
|
if FindAttributeByValueInNode(ANameSpace, ANode, AttrName) then begin
|
|
if not IsStrEmpty(AttrName) then begin
|
|
AttrName := ExtractNameSpaceShortName(AttrName);
|
|
if IsStrEmpty(AttrName) then begin
|
|
if (ANode.NodeName = ANodeName) then
|
|
Result := ANode;
|
|
end else begin
|
|
if(ANode.NodeName = AttrName + ':' + ANodeName) then
|
|
Result := ANode;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
locNode : TDOMNode;
|
|
begin
|
|
locNode := GetCurrentScopeObject();
|
|
Result := ScanNode(locNode);
|
|
if (Result <> nil) or not(locNode.HasChildNodes) then
|
|
exit;
|
|
locNode := locNode.FirstChild;
|
|
while (locNode <> nil) do begin
|
|
Result := ScanNode(locNode);
|
|
if (Result <> nil) then
|
|
Break;
|
|
locNode := locNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.InternalPutData(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : DOMString
|
|
): TDOMNode;
|
|
Var
|
|
namespaceLongName, namespaceShortName, strName, strNodeName, s : string;
|
|
regItem : TTypeRegistryItem;
|
|
begin
|
|
strNodeName := AName;
|
|
if (Style = Document) and
|
|
(ANameSpace <> '')
|
|
{( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or
|
|
( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified))
|
|
)}
|
|
then begin
|
|
namespaceLongName := ANameSpace;
|
|
if ( namespaceLongName <> '' ) then begin
|
|
s := FindAttributeByValueInScope(namespaceLongName);
|
|
if IsStrEmpty(s) then begin
|
|
namespaceShortName := 'ns' + IntToStr(NextNameSpaceCounter());
|
|
AddScopeAttribute('xmlns:'+namespaceShortName, namespaceLongName);
|
|
strNodeName := namespaceShortName + ':' + strNodeName;
|
|
end else begin
|
|
s := ExtractNameSpaceShortName(s);
|
|
if not IsStrEmpty(s) then
|
|
strNodeName := s + ':' + strNodeName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ( FSerializationStyle = ssNodeSerialization ) then begin
|
|
Result := FDoc.CreateElement(strNodeName);
|
|
Result.AppendChild(FDoc.CreateTextNode(AData));
|
|
GetCurrentScopeObject().AppendChild(Result);
|
|
If ( EncodingStyle = Encoded ) Then Begin
|
|
regItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo];
|
|
strName := regItem.DeclaredName;
|
|
namespaceLongName := regItem.NameSpace;
|
|
If Not IsStrEmpty(namespaceLongName) Then Begin
|
|
namespaceShortName := FindAttributeByValueInScope(namespaceLongName);
|
|
If IsStrEmpty(namespaceShortName) Then Begin
|
|
namespaceShortName := Format('ns%d',[NextNameSpaceCounter()]);
|
|
AddScopeAttribute(sXML_NS + ':'+namespaceShortName,namespaceLongName);
|
|
End Else Begin
|
|
namespaceShortName := ExtractNameSpaceShortName(namespaceShortName);//Copy(namespaceShortName,AnsiPos(':',namespaceShortName) + 1,MaxInt);
|
|
End;
|
|
strName := Format('%s:%s',[namespaceShortName,strName])
|
|
End;
|
|
namespaceShortName := GetNameSpaceShortName(sXSI_NS,True);
|
|
if not IsStrEmpty(namespaceShortName) then
|
|
namespaceShortName := namespaceShortName + ':';
|
|
(Result As TDOMElement).SetAttribute(namespaceShortName + sTYPE,strName);
|
|
End;
|
|
end else begin
|
|
Result := GetCurrentScopeObject();
|
|
(Result as TDOMElement).SetAttribute(strNodeName,AData);
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutEnum(
|
|
const ANameSpace : string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: TEnumIntType
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(
|
|
ANameSpace,
|
|
AName,
|
|
ATypeInfo,
|
|
GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,AData))
|
|
);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutBool(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Boolean
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,BoolToSoapBool(AData));
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutAnsiChar(
|
|
const ANameSpace: string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: AnsiChar
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutWideChar(
|
|
const ANameSpace: string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: WideChar
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutInt64(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Int64
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData));
|
|
end;
|
|
|
|
{$IFDEF HAS_QWORD}
|
|
function TSOAPBaseFormatter.PutUInt64(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : QWord
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData));
|
|
end;
|
|
{$ENDIF HAS_QWORD}
|
|
|
|
function TSOAPBaseFormatter.PutStr(
|
|
const ANameSpace : string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: String
|
|
):TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function TSOAPBaseFormatter.PutUnicodeStr(
|
|
const ANameSpace: string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: UnicodeString
|
|
): TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
|
|
function TSOAPBaseFormatter.PutWideStr(
|
|
const ANameSpace: string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData: WideString
|
|
) : TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.PutObj(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : TObject
|
|
);
|
|
begin
|
|
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Save(AData As TBaseRemotable, Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.PutRecord(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Pointer
|
|
);
|
|
begin
|
|
TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PutFloat(
|
|
const ANameSpace : string;
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData : Extended
|
|
):TDOMNode;
|
|
begin
|
|
Result := InternalPutData(ANameSpace,AName,ATypeInfo,wst_FormatFloat(ATypeInfo,AData));
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetNodeValue(
|
|
const ANameSpace : string;
|
|
var AName : string;
|
|
out AResBuffer : DOMString
|
|
): Boolean;
|
|
var
|
|
locElt : TDOMNode;
|
|
namespaceShortName, strNodeName, s : string;
|
|
begin
|
|
strNodeName := AName;
|
|
if (Style = Document) and
|
|
(ANameSpace <> '')
|
|
{( not(HasScope()) or
|
|
( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or
|
|
( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified))
|
|
)
|
|
)}
|
|
then begin
|
|
if ( ANameSpace <> '' ) then begin
|
|
{if ( ANameSpace = '' ) then
|
|
s := StackTop().NameSpace
|
|
else
|
|
s := ANameSpace;}
|
|
s := ANameSpace;
|
|
namespaceShortName := FindAttributeByValueInScope(s);
|
|
if not IsStrEmpty(namespaceShortName) then begin
|
|
s := ExtractNameSpaceShortName(namespaceShortName);
|
|
if not IsStrEmpty(s) then
|
|
strNodeName := s + ':' + strNodeName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ( FSerializationStyle = ssNodeSerialization ) then begin
|
|
locElt := StackTop().FindNode(strNodeName) As TDOMElement;
|
|
end else begin
|
|
locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName);
|
|
end;
|
|
if (locElt = nil) and (Style = Document) then
|
|
locElt := FindXMLNodeWithNamespaceInSubScope(ANameSpace,AName);
|
|
|
|
Result := ( locElt <> nil );
|
|
if Result then begin
|
|
if locElt.HasChildNodes then
|
|
AResBuffer := locElt.FirstChild.NodeValue
|
|
else
|
|
AResBuffer := locElt.NodeValue;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetEnum(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName: String;
|
|
var AData: TEnumIntType
|
|
) : Boolean;
|
|
Var
|
|
locBuffer : DOMString;
|
|
locStrBuffer : String;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then begin
|
|
locStrBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(locBuffer);
|
|
If IsStrEmpty(locStrBuffer) Then
|
|
AData := 0
|
|
Else
|
|
AData := GetEnumValue(ATypeInfo,locStrBuffer)
|
|
end;
|
|
End;
|
|
|
|
function TSOAPBaseFormatter.GetBool(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData : Boolean
|
|
) : Boolean;
|
|
Var
|
|
locBuffer : DOMString;
|
|
locStrBuffer : String;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then begin
|
|
locStrBuffer := LowerCase(Trim(locBuffer));
|
|
If IsStrEmpty(locStrBuffer) Then
|
|
AData := False
|
|
Else
|
|
AData := StrToBool(locStrBuffer);
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetAnsiChar(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace: string;
|
|
var AName: String;
|
|
var AData: AnsiChar
|
|
) : Boolean;
|
|
var
|
|
tmpString : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,tmpString);
|
|
if Result then begin
|
|
if ( Length(tmpString) > 0 ) then
|
|
AData := AnsiChar(tmpString[1])
|
|
else
|
|
AData := #0;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetWideChar(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace: string;
|
|
var AName: String;
|
|
var AData: WideChar
|
|
) : Boolean;
|
|
var
|
|
tmpString : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,tmpString);
|
|
if Result then begin
|
|
if ( Length(tmpString) > 0 ) then
|
|
AData := tmpString[1]
|
|
else
|
|
AData := #0;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
function TSOAPBaseFormatter.GetInt(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName: String;
|
|
var AData: Integer
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData := StrToIntDef(Trim(locBuffer),0);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TSOAPBaseFormatter.GetInt64(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData : Int64
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData :=StrToInt64Def(Trim(locBuffer),0);
|
|
end;
|
|
|
|
{$IFDEF HAS_QWORD}
|
|
function TSOAPBaseFormatter.GetUInt64(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData : QWord
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData := StrToQWordDef(Trim(locBuffer),0);
|
|
end;
|
|
{$ENDIF HAS_QWORD}
|
|
|
|
function TSOAPBaseFormatter.GetFloat(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData : Extended
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then begin
|
|
{$IFDEF HAS_FORMAT_SETTINGS}
|
|
AData := StrToFloatDef(Trim(locBuffer),0,wst_FormatSettings);
|
|
{$ELSE}
|
|
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(locBuffer)),0);
|
|
{$ENDIF HAS_FORMAT_SETTINGS}
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetStr(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData : String
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData := locBuffer;
|
|
end;
|
|
|
|
{$IFDEF WST_UNICODESTRING}
|
|
function TSOAPBaseFormatter.GetUnicodeStr(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace: string;
|
|
var AName: String;
|
|
var AData: UnicodeString
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData := locBuffer;
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
|
|
function TSOAPBaseFormatter.GetWideStr(
|
|
const ATypeInfo: PTypeInfo;
|
|
const ANameSpace: string;
|
|
var AName: String;
|
|
var AData: WideString
|
|
) : Boolean;
|
|
var
|
|
locBuffer : DOMString;
|
|
begin
|
|
Result := GetNodeValue(ANameSpace,AName,locBuffer);
|
|
if Result then
|
|
AData := locBuffer;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetObj(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : TObject
|
|
) : Boolean;
|
|
begin
|
|
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
|
|
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
|
|
Result := True;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetRecord(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : String;
|
|
var AData : Pointer
|
|
) : Boolean;
|
|
begin
|
|
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
|
|
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
|
|
Result := True;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetXmlDoc(): TwstXMLDocument;
|
|
begin
|
|
Result := FDoc;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetCurrentScope(): String;
|
|
begin
|
|
CheckScope();
|
|
Result:= GetCurrentScopeObject().NodeName;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetCurrentScopeObject(): TDOMElement;
|
|
begin
|
|
Result := StackTop().ScopeObject As TDOMElement;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.StackTop(): TStackItem;
|
|
begin
|
|
CheckScope();
|
|
Result := FStack.Peek() as TStackItem;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.PopStack(): TStackItem;
|
|
begin
|
|
CheckScope();
|
|
Result := FStack.Pop() as TStackItem;
|
|
end;
|
|
|
|
constructor TSOAPBaseFormatter.Create();
|
|
begin
|
|
Inherited Create();
|
|
FContentType := sSOAP_CONTENT_TYPE;
|
|
FStack := TObjectStack.Create();
|
|
FDoc := CreateDoc();
|
|
end;
|
|
|
|
destructor TSOAPBaseFormatter.Destroy();
|
|
begin
|
|
ClearStack();
|
|
ReleaseDomNode(FDoc);
|
|
FStack.Free();
|
|
inherited Destroy();
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Clear();
|
|
begin
|
|
InternalClear(True);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.BeginObject(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo
|
|
);
|
|
Var
|
|
typData : TTypeRegistryItem;
|
|
nmspc,nmspcSH, xsiNmspcSH : string;
|
|
mustAddAtt : Boolean;
|
|
strNodeName : string;
|
|
begin
|
|
typData := GetTypeRegistry().Find(ATypeInfo,False);
|
|
If Not Assigned(typData) Then
|
|
Error(SERR_TypeNotRegistered,[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
|
|
mustAddAtt := False;
|
|
if ( ATypeInfo^.Kind = tkClass ) and
|
|
GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TAbstractSimpleRemotable) and
|
|
HasScope()
|
|
then
|
|
nmspc := StackTop().NameSpace
|
|
else
|
|
nmspc := typData.NameSpace;
|
|
If IsStrEmpty(nmspc) Then
|
|
nmspcSH := 'tns'
|
|
Else Begin
|
|
nmspcSH := FindAttributeByValueInScope(nmspc);
|
|
If IsStrEmpty(nmspcSH) Then Begin
|
|
nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter());
|
|
If HasScope() Then
|
|
AddScopeAttribute('xmlns:'+nmspcSH, nmspc)
|
|
Else Begin
|
|
mustAddAtt := True;
|
|
End;
|
|
End Else Begin
|
|
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
|
|
End;
|
|
End;
|
|
|
|
if not(HasScope()) or
|
|
( (Style = Document) and
|
|
not(StackTop().ElementFormUnqualified)
|
|
)
|
|
then begin
|
|
strNodeName := nmspcSH + ':' + AName;
|
|
end else begin
|
|
strNodeName := AName;
|
|
end;
|
|
|
|
BeginScope(strNodeName,'','',stObject,asNone);
|
|
If mustAddAtt Then
|
|
AddScopeAttribute('xmlns:'+nmspcSH, nmspc);
|
|
if ( EncodingStyle = Encoded ) then begin
|
|
xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True);
|
|
if not IsStrEmpty(xsiNmspcSH) then
|
|
xsiNmspcSH := xsiNmspcSH + ':';
|
|
AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[GetNameSpaceShortName(typData.NameSpace,True),typData.DeclaredName]));
|
|
end;
|
|
StackTop().SetNameSpace(nmspc);
|
|
StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options;
|
|
StackTop().AttributeFormUnqualified := not(trioQualifiedAttribute in typData.Options);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.BeginArray(
|
|
const AName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AItemTypeInfo : PTypeInfo;
|
|
const ABounds : Array Of Integer;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
Var
|
|
typData : TTypeRegistryItem;
|
|
nmspc,nmspcSH : string;
|
|
i,j, k : Integer;
|
|
strNodeName : string;
|
|
xsiNmspcSH : string;
|
|
begin
|
|
if ( Length(ABounds) < 2 ) then begin
|
|
Error(SERR_InvalidArrayBounds);
|
|
end;
|
|
i := ABounds[0];
|
|
j := ABounds[1];
|
|
k := j - i + 1;
|
|
if ( k < 0 ) then begin
|
|
Error(SERR_InvalidArrayBounds);
|
|
end;
|
|
typData := GetTypeRegistry().Find(ATypeInfo,False);
|
|
if not Assigned(typData) then begin
|
|
Error(SERR_TypeNotRegistered,[ATypeInfo^.Name]);
|
|
end;
|
|
nmspc := typData.NameSpace;
|
|
if IsStrEmpty(nmspc) then begin
|
|
nmspcSH := 'tns'
|
|
end else begin
|
|
nmspcSH := FindAttributeByValueInScope(nmspc);
|
|
if IsStrEmpty(nmspcSH) then begin
|
|
nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter());
|
|
AddScopeAttribute('xmlns:'+nmspcSH, nmspc);
|
|
end else begin
|
|
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
|
|
end;
|
|
end;
|
|
|
|
if ( Style = Document ) then begin
|
|
strNodeName := nmspcSH + ':' + AName;
|
|
end else begin
|
|
strNodeName := AName;
|
|
end;
|
|
|
|
//if ( AStyle = asScoped ) then begin
|
|
BeginScope(strNodeName,'','',stArray,AStyle);
|
|
//end;
|
|
|
|
if ( EncodingStyle = Encoded ) then begin
|
|
//AddScopeAttribute(sXSI_TYPE,nmspc);
|
|
//SOAP-ENC:arrayType="xsd:int[2]"
|
|
{AddScopeAttribute(
|
|
Format('%s:%s',[sSOAP_ENC_ABR,sARRAY_TYPE]) ,
|
|
Format('%s:%s[%d]',[nmspcSH,typData.DeclaredName,k])
|
|
);}
|
|
xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True);
|
|
if not IsStrEmpty(xsiNmspcSH) then
|
|
xsiNmspcSH := xsiNmspcSH + ':';
|
|
AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName]));
|
|
end;
|
|
StackTop().SetNameSpace(nmspc);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.NilCurrentScope();
|
|
var
|
|
nmspcSH : shortstring;
|
|
begin
|
|
CheckScope();
|
|
nmspcSH := FindAttributeByValueInScope(sXSI_NS);
|
|
if IsStrEmpty(nmspcSH) then begin
|
|
nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter());
|
|
AddScopeAttribute('xmlns:'+nmspcSH, sXSI_NS);
|
|
end else begin
|
|
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
|
|
end;
|
|
GetCurrentScopeObject().SetAttribute(nmspcSH + ':' + sNIL,'true');
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.IsCurrentScopeNil(): Boolean;
|
|
Var
|
|
s,nsShortName,nilName : shortstring;
|
|
begin
|
|
CheckScope();
|
|
nsShortName := FindAttributeByValueInScope(sXSI_NS);
|
|
Result := False;
|
|
if IsStrEmpty(nsShortName) then begin
|
|
nilName := 'nil';
|
|
end else begin
|
|
nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt);
|
|
if not IsStrEmpty(nsShortName) Then
|
|
nsShortName := nsShortName + ':';
|
|
nilName := nsShortName + 'nil';
|
|
end;
|
|
s := Trim(GetCurrentScopeObject().GetAttribute(nilName));
|
|
if ( Length(s) > 0 ) and ( AnsiSameText(s,'true') or AnsiSameText(s,'"true"') ) then begin
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.BeginScope(
|
|
Const AScopeName,ANameSpace : string;
|
|
Const ANameSpaceShortName : string;
|
|
Const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle
|
|
);
|
|
Var
|
|
nsStr, scpStr : String;
|
|
e : TDOMElement;
|
|
hasNmspc, addAtt : Boolean;
|
|
begin
|
|
if ( AScopeType = stObject ) or
|
|
( ( AScopeType = stArray ) and ( AStyle = asScoped ) )
|
|
then begin
|
|
addAtt := False;
|
|
scpStr := AScopeName;
|
|
hasNmspc := Not IsStrEmpty(ANameSpace);
|
|
If hasNmspc Then Begin
|
|
nsStr := FindAttributeByValueInScope(ANameSpace);
|
|
addAtt := IsStrEmpty(nsStr);
|
|
If addAtt Then Begin
|
|
If IsStrEmpty(ANameSpaceShortName) Then
|
|
nsStr := 'ns' + IntToStr(NextNameSpaceCounter())
|
|
Else
|
|
nsStr := Trim(ANameSpaceShortName);
|
|
End Else Begin
|
|
nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt);
|
|
End;
|
|
if not(HasScope()) or
|
|
( (Style = Document) {and
|
|
not(StackTop().ElementFormUnqualified) }
|
|
)
|
|
then begin
|
|
scpStr := nsStr + ':' + scpStr;
|
|
end;
|
|
End;
|
|
|
|
e := FDoc.CreateElement(scpStr);
|
|
If HasScope() Then
|
|
GetCurrentScopeObject().AppendChild(e)
|
|
Else
|
|
FDoc.AppendChild(e);
|
|
if ( AScopeType = stObject ) then begin
|
|
PushStack(e);
|
|
end else begin
|
|
PushStack(e,AStyle,'');
|
|
end;
|
|
if hasNmspc and addAtt then begin
|
|
e.SetAttribute('xmlns:'+nsStr,ANameSpace);
|
|
StackTop().SetNameSpace(ANameSpace);
|
|
end;
|
|
end else if ( ( AScopeType = stArray ) and ( AStyle = asEmbeded ) ) then begin
|
|
StackTop().BeginEmbeddedScope();
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.InternalBeginScopeRead(
|
|
var AScopeName : string;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AScopeType : TScopeType;
|
|
const AStyle : TArrayStyle;
|
|
const AItemName : string
|
|
): Integer;
|
|
var
|
|
locNode : TDOMNode;
|
|
stk : TStackItem;
|
|
typData : TTypeRegistryItem;
|
|
nmspc,nmspcSH : string;
|
|
strNodeName : string;
|
|
begin
|
|
nmspcSH := '';
|
|
strNodeName := AScopeName;
|
|
if ( Style = Document ) then begin
|
|
typData := GetTypeRegistry().Find(ATypeInfo,False);
|
|
if not Assigned(typData) then begin
|
|
Error(SERR_TypeNotRegistered,[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
|
|
end;
|
|
if ( ATypeInfo^.Kind = tkClass ) and
|
|
GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TAbstractSimpleRemotable) and
|
|
HasScope()
|
|
then
|
|
nmspc := StackTop().NameSpace
|
|
else
|
|
nmspc := typData.NameSpace;
|
|
if IsStrEmpty(nmspc) then begin
|
|
nmspcSH := ''
|
|
end else begin
|
|
nmspcSH := FindAttributeByValueInScope(nmspc);
|
|
if not IsStrEmpty(nmspcSH) then begin
|
|
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
|
|
end;
|
|
end;
|
|
{if IsStrEmpty(nmspcSH) then begin
|
|
strNodeName := AScopeName
|
|
end else begin
|
|
if ( Pos(':',AScopeName) < 1 ) then begin
|
|
strNodeName := nmspcSH + ':' + AScopeName
|
|
end else begin
|
|
strNodeName := AScopeName;
|
|
end;
|
|
end;}
|
|
if not(IsStrEmpty(nmspcSH)) and
|
|
( not(HasScope()) or
|
|
not(StackTop().ElementFormUnqualified)
|
|
)
|
|
then begin
|
|
if ( Pos(':',AScopeName) < 1 ) then
|
|
strNodeName := nmspcSH + ':' + AScopeName;
|
|
end;
|
|
end;
|
|
|
|
stk := StackTop();
|
|
if ( AScopeType = stObject ) or
|
|
( ( AScopeType = stArray ) and ( AStyle = asScoped ) )
|
|
then begin
|
|
locNode := stk.FindNode(strNodeName);
|
|
if (locNode = nil) and (Style = Document) then
|
|
locNode := FindXMLNodeWithNamespaceInSubScope(nmspc,AScopeName);
|
|
end else begin
|
|
locNode := stk.ScopeObject;
|
|
end;
|
|
|
|
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;
|
|
if ( Style = Document ) then begin
|
|
StackTop().SetNameSpace(nmspc);
|
|
if (AScopeType = stObject) or
|
|
( (AScopeType = stArray) and (AStyle = asScoped) )
|
|
then begin
|
|
StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options;
|
|
StackTop().AttributeFormUnqualified := not(trioQualifiedAttribute in typData.Options);
|
|
end;
|
|
end;
|
|
Result := StackTop().GetItemsCount();
|
|
if ( Result = 0 ) and ( AScopeType = stArray ) then begin
|
|
PopStack().Free();
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle);
|
|
begin
|
|
FSerializationStyle := ASerializationStyle;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetSerializationStyle(): TSerializationStyle;
|
|
begin
|
|
Result := FSerializationStyle;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.SetStyleAndEncoding(
|
|
const AStyle: TSOAPDocumentStyle;
|
|
const AEncoding: TSOAPEncodingStyle
|
|
);
|
|
begin
|
|
FKeepedStyle := Style;
|
|
FKeepedEncoding := EncodingStyle;
|
|
Style := AStyle;
|
|
EncodingStyle := AEncoding;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.RestoreStyleAndEncoding();
|
|
begin
|
|
EncodingStyle := FKeepedEncoding;
|
|
Style := FKeepedStyle;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Prepare();
|
|
var
|
|
locDoc : TwstXMLDocument;
|
|
begin
|
|
locDoc := GetXmlDoc();
|
|
if Assigned(locDoc.DocumentElement) and
|
|
AnsiSameText(locDoc.DocumentElement.NodeName,( sSOAP_ENV_ABR + ':' + sENVELOPE ))
|
|
then begin
|
|
ClearStack();
|
|
PushStack(locDoc.DocumentElement);
|
|
end else begin
|
|
BeginScope(sENVELOPE,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
|
|
AddScopeAttribute('xmlns:xsi',sXSI_NS);
|
|
AddScopeAttribute('xmlns:'+sXSD, sXSD_NS);
|
|
AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC);
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.ReadHeaders(ACallContext: ICallContext): Integer;
|
|
|
|
function ExtractTypeInfo(ANode : TDOMElement) : TTypeRegistryItem;
|
|
var
|
|
j : Integer;
|
|
ndName, nsSN, nsLN, s : string;
|
|
begin
|
|
ndName := ANode.NodeName;
|
|
j := Pos(':',ndName);
|
|
if ( j > 0 ) then
|
|
nsSN := Copy(ndName,1,Pred(j))
|
|
else
|
|
nsSN := '';
|
|
if IsStrEmpty(nsSN) then
|
|
s := sXML_NS
|
|
else
|
|
s := sXML_NS + ':' + nsSN;
|
|
if not FindAttributeByNameInNode(s,ANode,nsLN) then
|
|
nsLN := FindAttributeByNameInScope(s);
|
|
Result := GetTypeRegistry().FindByDeclaredName(
|
|
Copy(ndName,Succ(j),MaxInt),
|
|
nsLN,
|
|
[trsoIncludeExternalSynonyms]
|
|
);
|
|
end;
|
|
|
|
var
|
|
i : Integer;
|
|
nd : TDOMElement;
|
|
typItm : TTypeRegistryItem;
|
|
tmpHeader : THeaderBlock;
|
|
locName : string;
|
|
chdLst : TDOMNodeList;
|
|
typData : PTypeData;
|
|
tmpObj : TBaseRemotable;
|
|
begin
|
|
SetStyleAndEncoding(Document,Literal);
|
|
try
|
|
Result := StackTop().ItemsCount;
|
|
if ( Result > 0 ) then begin
|
|
chdLst := StackTop().ScopeObject.ChildNodes;
|
|
try
|
|
for i := 0 to Pred(Result) do begin
|
|
nd := chdLst.Item[i] as TDOMElement;
|
|
typItm := ExtractTypeInfo(nd);
|
|
if Assigned(typItm) then begin
|
|
if ( typItm.DataType^.Kind = tkClass ) then begin
|
|
tmpHeader := nil;
|
|
locName := nd.NodeName;
|
|
typData := GetTypeData(typItm.DataType);
|
|
if typData^.ClassType.InheritsFrom(THeaderBlock) then begin
|
|
Get(typItm.DataType,locName,tmpHeader);
|
|
if Assigned(tmpHeader) then begin
|
|
tmpHeader.Direction := hdIn;
|
|
ACallContext.AddHeader(tmpHeader,True);
|
|
tmpHeader.Name := ExtractNameFromQualifiedName(locName);
|
|
end;
|
|
end else if typData^.ClassType.InheritsFrom(TBaseRemotable) then begin
|
|
tmpObj := nil;
|
|
Get(typItm.DataType,locName,tmpObj);
|
|
if Assigned(tmpObj) then begin
|
|
tmpHeader := THeaderBlockProxy.Create();
|
|
THeaderBlockProxy(tmpHeader).ActualObject := tmpObj;
|
|
THeaderBlockProxy(tmpHeader).OwnObject := True;
|
|
tmpHeader.Direction := hdIn;
|
|
ACallContext.AddHeader(tmpHeader,True);
|
|
tmpHeader.Name := ExtractNameFromQualifiedName(locName);
|
|
end;
|
|
end else begin
|
|
Error(SERR_ExpectingRemotableObjectClass,[typItm.DataType^.Name]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
ReleaseDomNode(chdLst);
|
|
end;
|
|
end;
|
|
finally
|
|
RestoreStyleAndEncoding();
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.WriteHeaders(ACallContext : ICallContext): Integer;
|
|
var
|
|
ptyp : PTypeInfo;
|
|
h : THeaderBlock;
|
|
i, c : Integer;
|
|
regItem : TTypeRegistryItem;
|
|
begin
|
|
Result := ACallContext.GetHeaderCount([hdOut]);
|
|
if ( Result > 0 ) then begin
|
|
BeginHeader();
|
|
try
|
|
c := ACallContext.GetHeaderCount(AllHeaderDirection);
|
|
for i := 0 to Pred(c) do begin
|
|
h := ACallContext.GetHeader(i);
|
|
if ( h.Direction = hdOut ) then begin
|
|
if h.InheritsFrom(THeaderBlockProxy) then
|
|
ptyp := PTypeInfo(THeaderBlockProxy(h).ActualObject.ClassInfo)
|
|
else
|
|
ptyp := PTypeInfo(h.ClassInfo);
|
|
regItem := GetTypeRegistry().Find(ptyp,True);
|
|
//Put(GetTypeRegistry().ItemByTypeInfo[ptyp].DeclaredName,ptyp,h);
|
|
if ( regItem <> nil) then
|
|
Put(regItem.NameSpace,h.Name,PTypeInfo(h.ClassInfo),h)
|
|
else
|
|
Put(h.Name,ptyp,h);
|
|
end;
|
|
end;
|
|
finally
|
|
EndHeader();
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.EndScope();
|
|
begin
|
|
CheckScope();
|
|
if ( StackTop().EmbeddedScopeCount = 0 ) then begin
|
|
FStack.Pop().Free();
|
|
end else begin
|
|
StackTop().EndEmbeddedScope();
|
|
end;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.AddScopeAttribute(const AName, AValue: string);
|
|
begin
|
|
CheckScope();
|
|
GetCurrentScopeObject().SetAttribute(AName,AValue);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Put(
|
|
const ANameSpace : string;
|
|
const AName: String;
|
|
const ATypeInfo: PTypeInfo;
|
|
const AData
|
|
);
|
|
Var
|
|
int64Data : Int64;
|
|
{$IFDEF HAS_QWORD}
|
|
uint64Data : QWord;
|
|
{$ENDIF HAS_QWORD}
|
|
strData : string;
|
|
objData : TObject;
|
|
boolData : Boolean;
|
|
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(ANameSpace,AName,ATypeInfo,ansiCharData);
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
wideCharData := WideChar(AData);
|
|
PutWideChar(ANameSpace,AName,ATypeInfo,wideCharData);
|
|
end;
|
|
tkInt64 :
|
|
Begin
|
|
int64Data := Int64(AData);
|
|
PutInt64(ANameSpace,AName,ATypeInfo,int64Data);
|
|
End;
|
|
{$IFDEF HAS_QWORD}
|
|
tkQWord :
|
|
Begin
|
|
uint64Data := QWord(AData);
|
|
PutUInt64(ANameSpace,AName,ATypeInfo,uint64Data);
|
|
End;
|
|
{$ENDIF HAS_QWORD}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
Begin
|
|
strData := AnsiString(AData);
|
|
PutStr(ANameSpace,AName,ATypeInfo,strData);
|
|
End;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString :
|
|
Begin
|
|
unicodeStrData := UnicodeString(AData);
|
|
PutUnicodeStr(ANameSpace,AName,ATypeInfo,unicodeStrData);
|
|
End;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkWString :
|
|
Begin
|
|
wideStrData := WideString(AData);
|
|
PutWideStr(ANameSpace,AName,ATypeInfo,wideStrData);
|
|
End;
|
|
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(ANameSpace,AName,ATypeInfo,boolData);
|
|
End;
|
|
{$ENDIF}
|
|
tkInteger, tkEnumeration :
|
|
begin
|
|
{$IFDEF WST_DELPHI}
|
|
if ( ATypeInfo^.Kind = tkEnumeration ) and
|
|
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
|
|
then begin
|
|
boolData := Boolean(AData);
|
|
PutBool(ANameSpace,AName,ATypeInfo,boolData);
|
|
end else begin
|
|
{$ENDIF}
|
|
enumData := 0;
|
|
Case GetTypeData(ATypeInfo)^.OrdType Of
|
|
otSByte : enumData := ShortInt(AData);
|
|
otUByte : enumData := Byte(AData);
|
|
otSWord : enumData := SmallInt(AData);
|
|
otUWord : enumData := Word(AData);
|
|
otSLong : enumData := LongInt(AData);
|
|
otULong : enumData := LongWord(AData);
|
|
End;
|
|
If ( ATypeInfo^.Kind = tkInteger ) Then
|
|
PutInt64(ANameSpace,AName,ATypeInfo,enumData)
|
|
Else
|
|
PutEnum(ANameSpace,AName,ATypeInfo,enumData);
|
|
{$IFDEF WST_DELPHI}
|
|
end;
|
|
{$ENDIF}
|
|
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(ANameSpace,AName,ATypeInfo,floatDt);
|
|
End;
|
|
End;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Put(
|
|
const AName : String;
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData
|
|
);
|
|
begin
|
|
Put('',AName,ATypeInfo,AData);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.PutScopeInnerValue(
|
|
const ATypeInfo : PTypeInfo;
|
|
const AData
|
|
);
|
|
Var
|
|
int64SData : Int64;
|
|
boolData : Boolean;
|
|
{$IFDEF HAS_QWORD}
|
|
uint64Data : QWord;
|
|
{$ENDIF HAS_QWORD}
|
|
strData : string;
|
|
enumData : TEnumIntType;
|
|
floatDt : Extended;
|
|
dataBuffer : DOMString;
|
|
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 HAS_QWORD}
|
|
tkQWord :
|
|
begin
|
|
uint64Data := QWord(AData);
|
|
dataBuffer := IntToStr(uint64Data);
|
|
end;
|
|
{$ENDIF HAS_QWORD}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
begin
|
|
strData := AnsiString(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 ESOAPException.Create(SERR_InnerScopeMustBeSimpleType);
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
begin
|
|
boolData := Boolean(AData);
|
|
dataBuffer := BoolToSoapBool(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 : enumData := LongInt(AData);
|
|
otULong : enumData := LongWord(AData);
|
|
else
|
|
enumData := 0;
|
|
end;
|
|
dataBuffer := IntToStr(enumData);
|
|
end;
|
|
tkEnumeration :
|
|
begin
|
|
{$IFDEF WST_DELPHI}
|
|
if ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin
|
|
boolData := Boolean(AData);
|
|
dataBuffer := BoolToSoapBool(boolData);
|
|
end else begin
|
|
{$ENDIF}
|
|
enumData := 0;
|
|
case GetTypeData(ATypeInfo)^.OrdType of
|
|
otSByte : enumData := ShortInt(AData);
|
|
otUByte : enumData := Byte(AData);
|
|
otSWord : enumData := SmallInt(AData);
|
|
otUWord : enumData := Word(AData);
|
|
otSLong : enumData := LongInt(AData);
|
|
otULong : enumData := LongWord(AData);
|
|
end;
|
|
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
|
|
{$IFDEF WST_DELPHI}
|
|
end;
|
|
{$ENDIF}
|
|
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;
|
|
dataBuffer := wst_FormatFloat(ATypeInfo,floatDt);
|
|
end;
|
|
end;
|
|
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
const ANameSpace : string;
|
|
var AName : String;
|
|
var AData
|
|
) : Boolean;
|
|
Var
|
|
int64Data : Int64;
|
|
{$IFDEF HAS_QWORD}
|
|
uint64Data : QWord;
|
|
{$ENDIF HAS_QWORD}
|
|
strData : string;
|
|
objData : TObject;
|
|
boolData : Boolean;
|
|
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;
|
|
Result := GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData);
|
|
if Result then
|
|
AnsiChar(AData) := ansiCharData;
|
|
end;
|
|
tkWChar :
|
|
begin
|
|
wideCharData := #0;
|
|
Result := GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData);
|
|
if Result then
|
|
WideChar(AData) := wideCharData;
|
|
end;
|
|
tkInt64 :
|
|
Begin
|
|
int64Data := 0;
|
|
Result := GetInt64(ATypeInfo,ANameSpace,AName,int64Data);
|
|
if Result then
|
|
Int64(AData) := int64Data;
|
|
End;
|
|
{$IFDEF HAS_QWORD}
|
|
tkQWord :
|
|
Begin
|
|
uint64Data := 0;
|
|
Result := GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data);
|
|
if Result then
|
|
QWord(AData) := uint64Data;
|
|
End;
|
|
{$ENDIF HAS_QWORD}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
|
Begin
|
|
strData := '';
|
|
Result := GetStr(ATypeInfo,ANameSpace,AName,strData);
|
|
if Result then
|
|
AnsiString(AData) := strData;
|
|
End;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString :
|
|
begin
|
|
unicodeStrData := '';
|
|
Result := GetUnicodeStr(ATypeInfo,ANameSpace,AName,unicodeStrData);
|
|
if Result then
|
|
UnicodeString(AData) := unicodeStrData;
|
|
end;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkWString :
|
|
begin
|
|
wideStrData := '';
|
|
Result := GetWideStr(ATypeInfo,ANameSpace,AName,wideStrData);
|
|
if Result then
|
|
WideString(AData) := wideStrData;
|
|
end;
|
|
tkClass :
|
|
Begin
|
|
objData := TObject(AData);
|
|
Result := GetObj(ATypeInfo,AName,objData);
|
|
if Result then
|
|
TObject(AData) := objData;
|
|
End;
|
|
tkRecord :
|
|
begin
|
|
recObject := Pointer(@AData);
|
|
Result := GetRecord(ATypeInfo,AName,recObject);
|
|
end;
|
|
{$IFDEF FPC}
|
|
tkBool :
|
|
Begin
|
|
boolData := False;
|
|
Result := GetBool(ATypeInfo,ANameSpace,AName,boolData);
|
|
if Result then
|
|
Boolean(AData) := boolData;
|
|
End;
|
|
{$ENDIF}
|
|
tkInteger, tkEnumeration :
|
|
begin
|
|
{$IFDEF WST_DELPHI}
|
|
if ( ATypeInfo^.Kind = tkEnumeration ) and
|
|
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
|
|
then begin
|
|
boolData := False;
|
|
Result := GetBool(ATypeInfo,ANameSpace,AName,boolData);
|
|
if Result then
|
|
Boolean(AData) := boolData;
|
|
end else begin
|
|
{$ENDIF}
|
|
enumData := 0;
|
|
if ( ATypeInfo^.Kind = tkInteger ) then
|
|
Result := GetInt64(ATypeInfo,ANameSpace,AName,enumData)
|
|
else
|
|
Result := GetEnum(ATypeInfo,ANameSpace,AName,enumData);
|
|
if Result then begin
|
|
case GetTypeData(ATypeInfo)^.OrdType of
|
|
otSByte : ShortInt(AData) := enumData;
|
|
otUByte : Byte(AData) := enumData;
|
|
otSWord : SmallInt(AData) := enumData;
|
|
otUWord : Word(AData) := enumData;
|
|
otSLong : LongInt(AData) := enumData;
|
|
otULong : LongWord(AData) := enumData;
|
|
end;
|
|
end;
|
|
{$IFDEF WST_DELPHI}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
tkFloat :
|
|
begin
|
|
floatDt := 0;
|
|
Result := GetFloat(ATypeInfo,ANameSpace,AName,floatDt);
|
|
if Result then begin
|
|
case GetTypeData(ATypeInfo)^.FloatType of
|
|
ftSingle : Single(AData) := floatDt;
|
|
ftDouble : Double(AData) := floatDt;
|
|
ftExtended : Extended(AData) := floatDt;
|
|
ftCurr : Currency(AData) := floatDt;
|
|
{$IFDEF CPU86}
|
|
ftComp : Comp(AData) := floatDt;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.Get(
|
|
const ATypeInfo : PTypeInfo;
|
|
var AName : string;
|
|
var AData
|
|
) : Boolean;
|
|
begin
|
|
Result := Get(ATypeInfo,'',AName,AData);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.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 HAS_QWORD}
|
|
tkQWord : QWord(AData) := StrToQWordDef(Trim(dataBuffer),0);
|
|
{$ENDIF HAS_QWORD}
|
|
tkLString{$IFDEF FPC},tkAString{$ENDIF} : AnsiString(AData) := dataBuffer;
|
|
tkWString : WideString(AData) := dataBuffer;
|
|
{$IFDEF WST_UNICODESTRING}
|
|
tkUString : UnicodeString(AData) := dataBuffer;
|
|
{$ENDIF WST_UNICODESTRING}
|
|
tkClass :
|
|
begin
|
|
raise ESOAPException.Create(SERR_InnerScopeMustBeSimpleType);
|
|
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
|
|
{$IFDEF WST_DELPHI}
|
|
if ( ATypeInfo^.Kind = tkEnumeration ) and
|
|
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
|
|
then begin
|
|
dataBuffer := LowerCase(Trim(dataBuffer));
|
|
if IsStrEmpty(dataBuffer) then
|
|
Boolean(AData) := False
|
|
else
|
|
Boolean(AData) := StrToBool(dataBuffer);
|
|
end else begin
|
|
{$ENDIF}
|
|
if ( ATypeInfo^.Kind = tkInteger ) then
|
|
enumData := StrToInt64Def(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 : LongInt(AData) := enumData;
|
|
otULong : LongWord(AData) := enumData;
|
|
end;
|
|
{$IFDEF WST_DELPHI}
|
|
end;
|
|
{$ENDIF}
|
|
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 CPU86}
|
|
ftComp : Comp(AData) := floatDt;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
|
|
Var
|
|
locElt : TDOMNode;
|
|
namespaceShortName, strNodeName : string;
|
|
i : Integer;
|
|
begin
|
|
strNodeName := AName;
|
|
if ( Style = Document ) then begin
|
|
namespaceShortName := FindAttributeByValueInScope(StackTop().NameSpace);
|
|
i := Pos(':',namespaceShortName);
|
|
if ( i > 0 ) then
|
|
namespaceShortName := Copy(namespaceShortName,i + 1,MaxInt)
|
|
else
|
|
namespaceShortName := '';
|
|
if not IsStrEmpty(namespaceShortName) then
|
|
strNodeName := namespaceShortName + ':' + strNodeName;
|
|
end;
|
|
|
|
if ( FSerializationStyle = ssNodeSerialization ) then begin
|
|
locElt := StackTop().FindNode(strNodeName);
|
|
end else begin
|
|
locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName);
|
|
end;
|
|
|
|
Result := ( locElt <> nil );
|
|
if Result then
|
|
AResBuffer := NodeToBuffer(locElt);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream);
|
|
begin
|
|
WriteXMLFile(FDoc,AStream);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.LoadFromStream(AStream: TStream);
|
|
Var
|
|
nd : TDOMNode;
|
|
begin
|
|
InternalClear(False);
|
|
ReadXMLFile(FDoc,AStream);
|
|
nd := GetXmlDoc().DocumentElement;
|
|
If Assigned(nd) Then
|
|
PushStack(nd);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Error(const AMsg: string);
|
|
begin
|
|
Raise ESOAPException.Create(AMsg);
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.Error(const AMsg: string;const AArgs: array of const);
|
|
begin
|
|
Raise ESOAPException.CreateFmt(AMsg,AArgs);
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetFormatName() : string;
|
|
begin
|
|
Result := sPROTOCOL_NAME;
|
|
end;
|
|
|
|
function TSOAPBaseFormatter.GetPropertyManager() : IPropertyManager;
|
|
begin
|
|
If Not Assigned(FPropMngr) Then
|
|
FPropMngr := TPublishedPropertyManager.Create(Self);
|
|
Result := FPropMngr;
|
|
end;
|
|
|
|
procedure TSOAPBaseFormatter.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;
|
|
|
|
{ TScopedArrayStackItem }
|
|
|
|
destructor TScopedArrayStackItem.Destroy();
|
|
begin
|
|
if ( FItemList <> nil ) then
|
|
FItemList := nil;
|
|
inherited Destroy();
|
|
end;
|
|
|
|
function TScopedArrayStackItem.CreateList(const ANodeName : string): TDOMNodeList;
|
|
begin
|
|
if ScopeObject.HasChildNodes() then begin
|
|
Result := ScopeObject.ChildNodes;
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
{ TEmbeddedArrayStackItem }
|
|
|
|
function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList;
|
|
begin
|
|
if ScopeObject.HasChildNodes() then begin
|
|
Result := FilterList(ScopeObject,ANodeName);
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
end.
|