pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ws_helper parses ( and records in procedure Register_%service%_ServiceMetadata() )

Browse Source 
- service/port for <soap:address>
  - binding/operation for "soapAction"
  
ws_helper : better parsing of "function" operations

ws_helper supports a new switch :
  -u MODE Generate the pascal translation of the WSDL input file
       MODE value may be U for used types or A for all types


Complexe types extending with simpleContent support in the runtime and ws_helper :
   sample WSDL type
  	<xs:complexType name="MeasureType">
  		<xs:simpleContent>
  			<xs:extension base="xs:decimal">
  				<xs:attribute name="UnitSystem" type="xs:token" use="optional">
  				</xs:attribute>
  				<xs:attribute name="ZeroPoint" type="string" use="optional">
  				</xs:attribute>
  			</xs:extension>
  		</xs:simpleContent>
  	</xs:complexType> 


embedded array support :
   sample WSDL type
      <xsd:complexType name="EmbeddeArraySample">
        <xsd:sequence>
          <xsd:element name="Name" type="xsd:string"/>
          <xsd:element name="Count" type="xsd:int"/>
          <xsd:element name="ArrayItem" type="xsd:string" minOccurs="0" maxOccurs="unbounded"/>
        </xsd:sequence>
      </xsd:complexType>

   sample instance of "EmbeddeArraySample"
      <example>
        <Name>WST NAME</Name>
        <Count>3</Count>
        <ArrayItem>Item 0</ArrayItem>
        <ArrayItem>Item 1</ArrayItem>
        <ArrayItem>Item 2</ArrayItem>
      </example>

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@139 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-04-02 13:19:48 +00:00
parent 77d87602b6
commit 2090bf84b2
24 changed files with 973 additions and 783 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
wst/trunk/base_binary_formatter.pas
View File

@ -266,20 +266,25 @@ type
Const ATypeInfo : PTypeInfo
);
procedure BeginArray(
Const AName : string;
Const ATypeInfo : PTypeInfo;
Const AItemTypeInfo : PTypeInfo;
Const ABounds : Array Of Integer
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);
//If the scope is an array the return value must be the array' length;
function BeginScopeRead(
function BeginObjectRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo
) : Integer;
function BeginArrayRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo;
const AScopeType : TScopeType = stObject
const AStyle : TArrayStyle;
const AItemName : string
):Integer;
procedure EndScopeRead();
@ -1001,12 +1006,13 @@ begin
end;
procedure TBaseBinaryFormatter.BeginArray(
Const AName : string;
Const ATypeInfo : PTypeInfo;
Const AItemTypeInfo : PTypeInfo;
Const ABounds : Array Of Integer
const AName : string;
const ATypeInfo : PTypeInfo;
const AItemTypeInfo : PTypeInfo;
const ABounds : Array Of Integer;
const AStyle : TArrayStyle
);
Var
var
i, j, k : Integer;
begin
If ( Length(ABounds) < 2 ) Then
@ -1044,20 +1050,39 @@ procedure TBaseBinaryFormatter.AddScopeAttribute(const AName, AValue: string);
begin
end;
function TBaseBinaryFormatter.BeginScopeRead(
function TBaseBinaryFormatter.BeginObjectRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo;
const AScopeType : TScopeType = stObject
const ATypeInfo : PTypeInfo
): Integer;
Var
var
locNode : PDataBuffer;
stk : TStackItem;
begin
stk := StackTop();
locNode := stk.Find(AScopeName);
If Not Assigned(locNode) Then
if not Assigned(locNode) then begin
Error('Scope not found : "%s"',[AScopeName]);
PushStack(locNode,AScopeType);
end;
PushStack(locNode,stObject);
Result := StackTop().GetItemCount();
end;
function TBaseBinaryFormatter.BeginArrayRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo;
const AStyle : TArrayStyle;
const AItemName : string
): Integer;
var
locNode : PDataBuffer;
stk : TStackItem;
begin
stk := StackTop();
locNode := stk.Find(AScopeName);
if not Assigned(locNode) then begin
Error('Scope not found : "%s"',[AScopeName]);
end;
PushStack(locNode,stArray);
Result := StackTop().GetItemCount();
end;

110
wst/trunk/base_service_intf.pas
View File

@ -23,6 +23,13 @@ const
stBase = 0;
stObject = stBase + 1;
stArray = stBase + 2;
sARRAY_ITEM = 'item';
sARRAY_STYLE = 'style';
// array style string
sScoped = 'scoped';
sEmbedded = 'embedded';
type
{ standart data types defines }
@ -31,6 +38,7 @@ type
float = Single;
TScopeType = Integer;
TArrayStyle = ( asScoped, asEmbeded, asNone );
THeaderDirection = ( hdOut, hdIn );
THeaderDirections = set of THeaderDirection;
const
@ -120,20 +128,25 @@ type
Const ATypeInfo : PTypeInfo
);
procedure BeginArray(
Const AName : string;
Const ATypeInfo : PTypeInfo;
Const AItemTypeInfo : PTypeInfo;
Const ABounds : Array Of Integer
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);
//If the scope is an array the return value must be the array' length;
function BeginScopeRead(
Var AScopeName : string;
Const ATypeInfo : PTypeInfo;
Const AScopeType : TScopeType = stObject
function BeginObjectRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo
) : Integer;
function BeginArrayRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo;
const AStyle : TArrayStyle;
const AItemName : string
):Integer;
procedure EndScopeRead();
property CurrentScope : String Read GetCurrentScope;
@ -509,6 +522,7 @@ type
TBaseArrayRemotable = class(TAbstractComplexRemotable)
protected
class function GetItemName():string;virtual;
class function GetStyle():TArrayStyle;virtual;
procedure CheckIndex(const AIndex : Integer);
function GetLength():Integer;virtual;abstract;
public
@ -517,7 +531,7 @@ type
procedure SetLength(const ANewSize : Integer);virtual;abstract;
property Length : Integer Read GetLength;
End;
end;
{ TBaseObjectArrayRemotable
An implementation for array handling. The array items are "owned" by
@ -1550,7 +1564,7 @@ Var
typRegItem : TTypeRegistryItem;
begin
oldSS := AStore.GetSerializationStyle();
AStore.BeginScopeRead(AName,ATypeInfo);
AStore.BeginObjectRead(AName,ATypeInfo);
try
if AStore.IsCurrentScopeNil() then
Exit; // ???? FreeAndNil(AObject);
@ -1706,7 +1720,6 @@ begin
Result := System.Length(FArray);
end;
const sARRAY_ITEM = 'item';
class procedure TBaseObjectArrayRemotable.Save(
AObject : TBaseRemotable;
AStore : IFormatterBase;
@ -1719,24 +1732,31 @@ Var
nativObj : TBaseObjectArrayRemotable;
itm : TObject;
itmName : string;
styl : TArrayStyle;
begin
If Assigned(AObject) Then Begin
if Assigned(AObject) then begin
Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable));
nativObj := AObject as TBaseObjectArrayRemotable;
j := nativObj.Length;
End Else
end else begin
j := 0;
end;
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)]);
Try
itmName := GetItemName();
For i := 0 To Pred(j) Do Begin
styl := GetStyle();
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)],styl);
try
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
end;
for i := 0 to Pred(j) do begin
itm := nativObj.Item[i];
AStore.Put(itmName,itmTypInfo,itm);
End;
Finally
end;
finally
AStore.EndScope();
End;
end;
end;
class procedure TBaseObjectArrayRemotable.Load(
@ -1751,8 +1771,16 @@ Var
s : string;
itmTypInfo : PTypeInfo;
itm : TBaseRemotable;
itmName : string;
styl : TArrayStyle;
begin
len := AStore.BeginScopeRead(AName,ATypeInfo, stArray);
styl := GetStyle();
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
end;
len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName);
Try
If Not Assigned(AObject) Then
AObject := Create();
@ -2233,6 +2261,7 @@ var
i,j : Integer;
nativObj : TBaseSimpleTypeArrayRemotable;
itmName : string;
styl : TArrayStyle;
begin
if Assigned(AObject) then begin
Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable));
@ -2241,9 +2270,14 @@ begin
end else begin
j := 0;
end;
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)]);
styl := GetStyle();
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)],styl);
try
itmName := GetItemName();
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
end;
for i := 0 to Pred(j) do begin
nativObj.SaveItem(AStore,itmName,i);
end;
@ -2261,8 +2295,16 @@ class procedure TBaseSimpleTypeArrayRemotable.Load(
Var
i, len : Integer;
nativObj : TBaseSimpleTypeArrayRemotable;
begin ;
len := AStore.BeginScopeRead(AName,ATypeInfo, stArray);
itmName : string;
styl : TArrayStyle;
begin
styl := GetStyle();
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
end;
len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName);
try
if not Assigned(AObject) then
AObject := Create();
@ -2347,6 +2389,18 @@ begin
Result := sARRAY_ITEM;
end;
class function TBaseArrayRemotable.GetStyle(): TArrayStyle;
var
tri : TTypeRegistryItem;
begin
tri := GetTypeRegistry().Find(PTypeInfo(Self.ClassInfo),False);
if Assigned(tri) and AnsiSameText(sEmbedded,Trim(tri.GetExternalPropertyName(sARRAY_STYLE))) then begin
Result := asEmbeded;
end else begin
Result := asScoped;
end;
end;
procedure TBaseArrayRemotable.CheckIndex(const AIndex : Integer);
begin
if ( AIndex < 0 ) or ( AIndex >= Length ) then
@ -3354,7 +3408,7 @@ Var
tr : TTypeRegistry;
begin
oldSS := AStore.GetSerializationStyle();
AStore.BeginScopeRead(AName,ATypeInfo);
AStore.BeginObjectRead(AName,ATypeInfo);
try
if AStore.IsCurrentScopeNil() then
Exit; // ???? FreeAndNil(AObject);
@ -3805,7 +3859,7 @@ procedure TBaseDateRemotable.Load(
var
strBuffer : string;
begin
AStore.BeginScopeRead(AName,ATypeInfo, stObject);
AStore.BeginObjectRead(AName,ATypeInfo);
try
strBuffer := '';
AStore.GetScopeInnerValue(TypeInfo(string),strBuffer);

354
wst/trunk/base_soap_formatter.pas
View File

@ -56,7 +56,8 @@ Type
FNameSpace: string;
FScopeObject: TDOMNode;
FScopeType: TScopeType;
function GetItemsCount: Integer;
protected
function GetItemsCount() : Integer;virtual;
Public
constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType);
function FindNode(var ANodeName : string):TDOMNode;virtual;abstract;
@ -74,14 +75,40 @@ Type
function FindNode(var ANodeName : string):TDOMNode;override;
End;
{ TArrayStackItem }
{ TAbstractArrayStackItem }
TArrayStackItem = class(TStackItem)
Private
TAbstractArrayStackItem = class(TStackItem)
private
FItemList : TDOMNodeList;
FIndex : Integer;
Public
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;
end;
{ TScopedArrayStackItem }
TScopedArrayStackItem = class(TAbstractArrayStackItem)
protected
function CreateList(const ANodeName : string):TDOMNodeList;override;
end;
{ TEmbeddedArrayStackItem }
TEmbeddedArrayStackItem = class(TAbstractArrayStackItem)
protected
function CreateList(const ANodeName : string):TDOMNodeList;override;
end;
TSOAPEncodingStyle = ( Encoded, Litteral );
TSOAPDocumentStyle = ( RPC, Document );
@ -185,7 +212,12 @@ Type
);
protected
function GetXmlDoc():TXMLDocument;
function PushStack(AScopeObject : TDOMNode;Const AScopeType : TScopeType = stObject):TStackItem;
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;
function PushStack(
AScopeObject : TDOMNode;
const AStyle : TArrayStyle;
const AItemName : string
):TStackItem;overload;
function FindAttributeByValueInNode(
Const AAttValue : String;
Const ANode : TDOMNode;
@ -210,9 +242,17 @@ Type
procedure ClearStack();
procedure BeginScope(
Const AScopeName,ANameSpace : string;
Const ANameSpaceShortName : string = '';
Const AScopeType : TScopeType = stObject
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;
@ -234,20 +274,26 @@ Type
Const ATypeInfo : PTypeInfo
);
procedure BeginArray(
Const AName : string;
Const ATypeInfo : PTypeInfo;
Const AItemTypeInfo : PTypeInfo;
Const ABounds : Array Of Integer
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 BeginScopeRead(
Var AScopeName : string;
Const ATypeInfo : PTypeInfo;
Const AScopeType : TScopeType = stObject
function BeginObjectRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo
) : Integer;
function BeginArrayRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo;
const AStyle : TArrayStyle;
const AItemName : string
):Integer;
procedure EndScopeRead();
@ -330,26 +376,52 @@ begin
Result:= ScopeObject.FindNode(ANodeName);
end;
{ TArrayStackItem }
{ TAbstractArrayStackItem }
function TArrayStackItem.FindNode(var ANodeName: string): TDOMNode;
var
chdLst : TDOMNodeList;
procedure TAbstractArrayStackItem.EnsureListCreated();
begin
if not ScopeObject.HasChildNodes then
raise ESOAPException.Create('This node has no children.');
chdLst := ScopeObject.ChildNodes;
try
if ( FIndex >= chdLst.Count ) then
raise ESOAPException.CreateFmt('Index out of bound : %d',[FIndex]);
Result:= chdLst.Item[FIndex];
Inc(FIndex);
ANodeName := Result.NodeName;
finally
chdLst.Release();
if ( FItemList = nil ) then begin
FItemList := CreateList(FItemName);
end;
end;
function TAbstractArrayStackItem.GetItemsCount(): Integer;
begin
EnsureListCreated();
if Assigned(FItemList) then begin
Result := FItemList.Count;
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
FItemList.Release();
inherited Destroy();
end;
function TAbstractArrayStackItem.FindNode(var ANodeName: string): TDOMNode;
begin
EnsureListCreated();
if ( FIndex >= FItemList.Count ) then
raise ESOAPException.CreateFmt('Index out of bound : %d; Node Name = "%s"',[FIndex,ANodeName]);
Result:= FItemList.Item[FIndex];
Inc(FIndex);
ANodeName := Result.NodeName;
end;
{ TSOAPBaseFormatter }
procedure TSOAPBaseFormatter.ClearStack();
@ -361,68 +433,41 @@ begin
FStack.Pop().Free();
end;
function TSOAPBaseFormatter.PushStack(
AScopeObject : TDOMNode;
Const AScopeType : TScopeType
) : TStackItem;
function TSOAPBaseFormatter.PushStack(AScopeObject : TDOMNode) : TStackItem;
begin
if ( AScopeType = stArray ) then
Result := FStack.Push(TArrayStackItem.Create(AScopeObject,AScopeType)) as TStackItem
else
Result := FStack.Push(TObjectStackItem.Create(AScopeObject,AScopeType)) as TStackItem;
Result := FStack.Push(TObjectStackItem.Create(AScopeObject,stObject)) as TStackItem;
end;
function TSOAPBaseFormatter.BeginScopeRead(
Var AScopeName : string;
Const ATypeInfo : PTypeInfo;
Const AScopeType : TScopeType = stObject
):Integer;
Var
locNode : TDOMNode;
stk : TStackItem;
typData : TTypeRegistryItem;
nmspc,nmspcSH : string;
strNodeName : string;
function TSOAPBaseFormatter.PushStack(
AScopeObject : TDOMNode;
const AStyle : TArrayStyle;
const AItemName : string
): TStackItem;
begin
if ( Style = Document ) then begin
typData := GetTypeRegistry().Find(ATypeInfo,False);
if not Assigned(typData) then
Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
nmspc := typData.NameSpace;
if IsStrEmpty(nmspc) then
nmspcSH := ''
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
strNodeName := nmspcSH + ':' + AScopeName
else
strNodeName := AScopeName;
end;
end else begin
nmspcSH := '';
strNodeName := AScopeName;
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
Assert(False);
end;
end;
stk := StackTop();
locNode := stk.FindNode(strNodeName);//(AScopeName);
If Not Assigned(locNode) Then
Error('Scope not found : "%s"',[strNodeName]);//[AScopeName]);
PushStack(locNode,AScopeType);
if ( Style = Document ) then begin
StackTop().SetNameSpace(nmspc);
end;
if locNode.HasChildNodes then
Result := GetNodeItemsCount(locNode)
else
Result := 0;
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;
procedure TSOAPBaseFormatter.EndScopeRead();
@ -435,7 +480,7 @@ begin
if ( FHeaderEnterCount <= 0 ) then begin
Inc(FHeaderEnterCount);
Prepare();
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR);
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
SetStyleAndEncoding(Document,Litteral);
end;
end;
@ -891,7 +936,7 @@ begin
strNodeName := AName;
end;
BeginScope(strNodeName,'');
BeginScope(strNodeName,'','',stObject,asNone);
If mustAddAtt Then
AddScopeAttribute('xmlns:'+nmspcSH, nmspc);
if ( EncodingStyle = Encoded ) then begin
@ -904,10 +949,11 @@ begin
end;
procedure TSOAPBaseFormatter.BeginArray(
Const AName : string;
Const ATypeInfo : PTypeInfo;
Const AItemTypeInfo : PTypeInfo;
Const ABounds : Array Of Integer
const AName : string;
const ATypeInfo : PTypeInfo;
const AItemTypeInfo : PTypeInfo;
const ABounds : Array Of Integer;
const AStyle : TArrayStyle
);
Var
typData : TTypeRegistryItem;
@ -916,21 +962,23 @@ Var
strNodeName : string;
xsiNmspcSH : string;
begin
If ( Length(ABounds) < 2 ) Then
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
if ( k < 0 ) then begin
Error('Invalid array bounds.');
k := j - i + 1;
end;
typData := GetTypeRegistry().Find(ATypeInfo,False);
If Not Assigned(typData) Then
if not Assigned(typData) then begin
Error('Array type not registered.');
end;
nmspc := typData.NameSpace;
If IsStrEmpty(nmspc) Then
if IsStrEmpty(nmspc) then begin
nmspcSH := 'tns'
Else Begin
end else begin
nmspcSH := FindAttributeByValueInScope(nmspc);
if IsStrEmpty(nmspcSH) then begin
nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter());
@ -938,7 +986,7 @@ begin
end else begin
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
end;
End;
end;
if ( Style = Document ) then begin
strNodeName := nmspcSH + ':' + AName;
@ -946,7 +994,9 @@ begin
strNodeName := AName;
end;
BeginScope(strNodeName,'');
if ( AStyle = asScoped ) then begin
BeginScope(strNodeName,'','',stArray,AStyle);
end;
if ( EncodingStyle = Encoded ) then begin
//AddScopeAttribute(sXSI_TYPE,nmspc);
@ -1002,7 +1052,8 @@ end;
procedure TSOAPBaseFormatter.BeginScope(
Const AScopeName,ANameSpace : string;
Const ANameSpaceShortName : string;
Const AScopeType : TScopeType
Const AScopeType : TScopeType;
const AStyle : TArrayStyle
);
Var
nsStr, scpStr : String;
@ -1030,13 +1081,81 @@ begin
GetCurrentScopeObject().AppendChild(e)
Else
FDoc.AppendChild(e);
PushStack(e,AScopeType);
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;
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
if ( Style = Document ) then begin
typData := GetTypeRegistry().Find(ATypeInfo,False);
if not Assigned(typData) then begin
Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
end;
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;
end else begin
nmspcSH := '';
strNodeName := AScopeName;
end;
stk := StackTop();
if ( AScopeType = stObject ) or
( ( AScopeType = stArray ) and ( AStyle = asScoped ) )
then begin
locNode := stk.FindNode(strNodeName);
end else begin
locNode := stk.ScopeObject;
end;
if not Assigned(locNode) then begin
Error('Scope not found : "%s"',[strNodeName]);
end;
if ( AScopeType = stObject ) then begin
PushStack(locNode);
end else begin
PushStack(locNode,AStyle,AItemName);
end;
if ( Style = Document ) then begin
StackTop().SetNameSpace(nmspc);
end;
Result := StackTop().GetItemsCount();
end;
procedure TSOAPBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle);
begin
FSerializationStyle := ASerializationStyle;
@ -1073,9 +1192,9 @@ begin
AnsiSameText(locDoc.DocumentElement.NodeName,( sSOAP_ENV_ABR + ':' + sENVELOPE ))
then begin
ClearStack();
PushStack(locDoc.DocumentElement,stObject);
PushStack(locDoc.DocumentElement);
end else begin
BeginScope(sENVELOPE,sSOAP_ENV,sSOAP_ENV_ABR);
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);
@ -1506,4 +1625,27 @@ begin
Raise ESOAPException.CreateFmt(AMsg,AArgs);
end;
{ TScopedArrayStackItem }
function TScopedArrayStackItem.CreateList(const ANodeName : string): TDOMNodeList;
begin
if ScopeObject.HasChildNodes() then begin
Result := ScopeObject.GetChildNodes();
end else begin
Result := nil;
end;
end;
{ TEmbeddedArrayStackItem }
function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList;
begin
if ScopeObject.HasChildNodes() then begin
Result := TDOMNodeList.Create(ScopeObject,ANodeName);
end else begin
Result := nil;
end;
end;
end.

8
wst/trunk/binary_formatter.pas
View File

@ -107,10 +107,10 @@ begin
ClearStack();
PushStack(GetRootData(),stObject);
s := 'Body';
BeginScopeRead(s,nil);
BeginObjectRead(s,nil);
s := StackTop().GetByIndex(0)^.Name;
If AnsiSameText(s,'Fault') Then Begin
BeginScopeRead(s,nil,stObject);
BeginObjectRead(s,nil);
e := EBaseRemoteException.Create('');
Try
nme := 'faultcode';
@ -127,9 +127,9 @@ begin
Raise e;
End;
FCallTarget := s;
BeginScopeRead(FCallTarget,nil);
BeginObjectRead(FCallTarget,nil);
FCallProcedureName := StackTop().GetByIndex(0)^.Name;
BeginScopeRead(FCallProcedureName,nil);
BeginObjectRead(FCallProcedureName,nil);
end;
function TBinaryFormatter.GetCallProcedureName(): String;

2
wst/trunk/metadata_repository.pas
View File

@ -108,6 +108,8 @@ type
):LongInt;
procedure ClearRepositoryData(var ARepository : PServiceRepository);
function Find(const AProps : PPropertyData; const APropName : string) : PPropertyData;
implementation
uses wst_resources_imp, binary_streamer;

6
wst/trunk/server_binary_formatter.pas
View File

@ -93,11 +93,11 @@ begin
ClearStack();
PushStack(GetRootData(),stObject);
s := 'Body';
BeginScopeRead(s,nil);
BeginObjectRead(s,nil);
FCallTarget := StackTop().GetByIndex(0)^.Name;
BeginScopeRead(FCallTarget,nil);
BeginObjectRead(FCallTarget,nil);
FCallProcedureName := StackTop().GetByIndex(0)^.Name;
BeginScopeRead(FCallProcedureName,nil);
BeginObjectRead(FCallProcedureName,nil);
end;
function TBinaryFormatter.GetCallProcedureName(): String;

20
wst/trunk/server_service_soap.pas
View File

@ -77,19 +77,11 @@ end;
procedure TSOAPFormatter.BeginCallResponse(Const AProcName,ATarget:string);
begin
{ Clear();
BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV');
AddScopeAttribute('xmlns:xsi',sXSI_NS);
AddScopeAttribute('xmlns:'+sXSD, sXSD_NS);
AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC);
BeginScope('Body',sSOAP_ENV);
BeginScope(AProcName + 'Response',ATarget);
}
Clear();
Prepare();
WriteHeaders(FCallContext);
BeginScope('Body',sSOAP_ENV);
BeginScope(AProcName + 'Response',ATarget);
BeginScope('Body',sSOAP_ENV,'',stObject,asNone);
BeginScope(AProcName + 'Response',ATarget,'',stObject,asNone);
end;
procedure TSOAPFormatter.EndCallResponse();
@ -131,7 +123,7 @@ begin
hdrNd := bdyNd;
bdyNd := hdrNd.NextSibling;
if SameText(hdrNd.NodeName,eltName) then begin
PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV);
PushStack(hdrNd,asScoped,'').SetNameSpace(sSOAP_ENV);
ReadHeaders(FCallContext);
PopStack().Free();
end;
@ -184,11 +176,11 @@ begin
Else
m := AErrorMsg;
Clear();
BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV');
BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV',stObject,asNone);
AddScopeAttribute('xmlns:xsi',sXSI_NS);
AddScopeAttribute('xmlns:'+sXSD, sXSD_NS);
BeginScope('Body',sSOAP_ENV);
BeginScope('Fault',sSOAP_ENV);
BeginScope('Body',sSOAP_ENV,'',stObject,asNone);
BeginScope('Fault',sSOAP_ENV,'',stObject,asNone);
Put('faultcode',TypeInfo(string),c);
Put('faultstring',TypeInfo(string),m);
end;

4
wst/trunk/service_intf.pas
View File

@ -105,9 +105,7 @@ Type
// ---- END >> ICallContext implementation ----
procedure ClearHeaders(const ADirection : THeaderDirection);
public
(* This is the primary constructor!
Objects passed by the parameter "AProtocol" will be freed by
this instance( the new one create by this constructor call ). *)
(* This is the primary constructor! *)
constructor Create(
Const ATarget : String; // the target service
Const AProtocol : IServiceProtocol

16
wst/trunk/soap_formatter.pas
View File

@ -90,15 +90,11 @@ procedure TSOAPFormatter.BeginCall(
ACallContext : ICallContext
);
begin
//BeginScope('Envelope',sSOAP_ENV,sSOAP_ENV_ABR);
//AddScopeAttribute('xmlns:xsi',sXSI_NS);
//AddScopeAttribute('xmlns:'+sXSD, sXSD_NS);
//AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC);
Prepare();
WriteHeaders(ACallContext);
BeginScope('Body',sSOAP_ENV);
if ( Style = RPC ) then
BeginScope(AProcName,ATarget);
Prepare();
WriteHeaders(ACallContext);
BeginScope('Body',sSOAP_ENV,'',stObject,asNone);
if ( Style = RPC ) then
BeginScope(AProcName,ATarget,'',stObject,asNone);
FCallTarget := ATarget;
FCallProcedureName := AProcName;
@ -146,7 +142,7 @@ begin
hdrNd := bdyNd;
bdyNd := hdrNd.NextSibling;
if SameText(hdrNd.NodeName,eltName) then begin
PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV);
PushStack(hdrNd,asScoped,'').SetNameSpace(sSOAP_ENV);
ReadHeaders(ACallContext);
PopStack().Free();
end;

2
wst/trunk/synapse_http_protocol.pas
View File

@ -13,7 +13,7 @@
unit synapse_http_protocol;
{$mode objfpc}{$H+}
//{$DEFINE WST_DBG}
{$DEFINE WST_DBG}
interface

202
wst/trunk/tests/ebay/test_ebay_gui.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -26,14 +26,14 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="36">
<Units Count="38">
<Unit0>
<Filename Value="test_ebay_gui.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_ebay_gui"/>
<CursorPos X="1" Y="17"/>
<CursorPos X="5" Y="8"/>
<TopLine Value="1"/>
<UsageCount Value="121"/>
<UsageCount Value="127"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
@ -41,59 +41,59 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="1" Y="10"/>
<TopLine Value="1"/>
<CursorPos X="40" Y="9"/>
<TopLine Value="4"/>
<EditorIndex Value="0"/>
<UsageCount Value="121"/>
<UsageCount Value="127"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="synapse_http_protocol"/>
<CursorPos X="42" Y="22"/>
<TopLine Value="8"/>
<UsageCount Value="121"/>
<CursorPos X="1" Y="162"/>
<TopLine Value="149"/>
<UsageCount Value="127"/>
</Unit2>
<Unit3>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="3" Y="2307"/>
<TopLine Value="2302"/>
<EditorIndex Value="10"/>
<UsageCount Value="61"/>
<CursorPos X="13" Y="3058"/>
<TopLine Value="3056"/>
<EditorIndex Value="7"/>
<UsageCount Value="63"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="15" Y="158"/>
<TopLine Value="136"/>
<EditorIndex Value="1"/>
<UsageCount Value="26"/>
<CursorPos X="1" Y="253"/>
<TopLine Value="239"/>
<EditorIndex Value="2"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\..\soap_formatter.pas"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="60" Y="159"/>
<TopLine Value="149"/>
<UsageCount Value="18"/>
<CursorPos X="1" Y="146"/>
<TopLine Value="132"/>
<UsageCount Value="20"/>
</Unit5>
<Unit6>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="11"/>
<CursorPos X="1" Y="86"/>
<TopLine Value="72"/>
<UsageCount Value="12"/>
</Unit6>
<Unit7>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="28" Y="377"/>
<TopLine Value="371"/>
<EditorIndex Value="6"/>
<UsageCount Value="54"/>
<CursorPos X="1" Y="1625"/>
<TopLine Value="1611"/>
<EditorIndex Value="4"/>
<UsageCount Value="56"/>
<Bookmarks Count="2">
<Item0 X="14" Y="670" ID="1"/>
<Item1 X="1" Y="437" ID="2"/>
@ -111,10 +111,10 @@
<Filename Value="ebay.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ebay"/>
<CursorPos X="3" Y="237"/>
<TopLine Value="223"/>
<EditorIndex Value="7"/>
<UsageCount Value="105"/>
<CursorPos X="49" Y="126"/>
<TopLine Value="124"/>
<EditorIndex Value="1"/>
<UsageCount Value="111"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
@ -127,10 +127,10 @@
<Unit11>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="17"/>
<CursorPos X="3" Y="112"/>
<TopLine Value="9"/>
<EditorIndex Value="5"/>
<UsageCount Value="19"/>
<Bookmarks Count="1">
<Item0 X="1" Y="91" ID="3"/>
</Bookmarks>
@ -140,10 +140,10 @@
<Filename Value="ebay_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ebay_proxy"/>
<CursorPos X="19" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="9"/>
<UsageCount Value="105"/>
<CursorPos X="1" Y="75"/>
<TopLine Value="61"/>
<EditorIndex Value="6"/>
<UsageCount Value="111"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
@ -253,17 +253,17 @@
<UnitName Value="binary_streamer"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="55"/>
<EditorIndex Value="11"/>
<UsageCount Value="29"/>
<EditorIndex Value="8"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit29>
<Unit30>
<Filename Value="..\files\eBayWSDL.pas"/>
<UnitName Value="eBayWSDL"/>
<CursorPos X="56" Y="16040"/>
<TopLine Value="16029"/>
<EditorIndex Value="5"/>
<UsageCount Value="16"/>
<CursorPos X="48" Y="10961"/>
<TopLine Value="10947"/>
<EditorIndex Value="3"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit30>
<Unit31>
@ -285,45 +285,53 @@
<UnitName Value="eBayWSDL_proxy"/>
<CursorPos X="41" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit33>
<Unit34>
<Filename Value="..\files\eBayWSDL_imp.pas"/>
<UnitName Value="eBayWSDL_imp"/>
<CursorPos X="39" Y="1074"/>
<TopLine Value="1327"/>
<EditorIndex Value="3"/>
<TopLine Value="1325"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit34>
<Unit35>
<Filename Value="..\files\eBayWSDL_binder.pas"/>
<UnitName Value="eBayWSDL_binder"/>
<CursorPos X="68" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="3" Y="1433"/>
<TopLine Value="1431"/>
<UsageCount Value="11"/>
</Unit36>
<Unit37>
<Filename Value="..\..\..\..\..\lazarusClean\others_package\synapse\httpsend.pas"/>
<UnitName Value="httpsend"/>
<CursorPos X="1" Y="466"/>
<TopLine Value="461"/>
<UsageCount Value="10"/>
</Unit37>
</Units>
<JumpHistory Count="21" HistoryIndex="20">
<JumpHistory Count="6" HistoryIndex="5">
<Position1>
<Filename Value="..\files\eBayWSDL_proxy.pas"/>
<Caret Line="506" Column="85" TopLine="500"/>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="33919" Column="45" TopLine="33905"/>
</Position1>
<Position2>
<Filename Value="ebay.pas"/>
<Caret Line="520" Column="27" TopLine="515"/>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="32893" Column="23" TopLine="32867"/>
</Position2>
<Position3>
<Filename Value="ebay.pas"/>
<Caret Line="1" Column="1" TopLine="249"/>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="12" Column="53" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="ebay.pas"/>
<Caret Line="519" Column="17" TopLine="511"/>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="32726" Column="1" TopLine="32699"/>
</Position4>
<Position5>
<Filename Value="..\files\eBayWSDL.pas"/>
@ -331,68 +339,8 @@
</Position5>
<Position6>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="31804" Column="8" TopLine="32688"/>
<Caret Line="503" Column="3" TopLine="489"/>
</Position6>
<Position7>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="23" Column="71" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="10951" Column="10" TopLine="10937"/>
</Position8>
<Position9>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="10958" Column="93" TopLine="10944"/>
</Position9>
<Position10>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="16072" Column="5" TopLine="16058"/>
</Position10>
<Position11>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="24735" Column="32" TopLine="24721"/>
</Position11>
<Position12>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="24765" Column="39" TopLine="24751"/>
</Position12>
<Position13>
<Filename Value="..\files\eBayWSDL_imp.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="31806" Column="19" TopLine="31802"/>
</Position14>
<Position15>
<Filename Value="..\files\eBayWSDL_binder.pas"/>
<Caret Line="11" Column="69" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="..\..\service_intf.pas"/>
<Caret Line="84" Column="29" TopLine="83"/>
</Position16>
<Position17>
<Filename Value="..\..\service_intf.pas"/>
<Caret Line="158" Column="36" TopLine="144"/>
</Position17>
<Position18>
<Filename Value="..\..\service_intf.pas"/>
<Caret Line="225" Column="15" TopLine="204"/>
</Position18>
<Position19>
<Filename Value="umain.pas"/>
<Caret Line="55" Column="36" TopLine="49"/>
</Position19>
<Position20>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="32124" Column="58" TopLine="32116"/>
</Position20>
<Position21>
<Filename Value="..\files\eBayWSDL.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position21>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -418,7 +366,7 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="10">
<BreakPoints Count="11">
<Item1>
<Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
<Line Value="15"/>
@ -457,8 +405,12 @@
</Item9>
<Item10>
<Source Value="umain.pas"/>
<Line Value="92"/>
<Line Value="77"/>
</Item10>
<Item11>
<Source Value="..\..\soap_formatter.pas"/>
<Line Value="146"/>
</Item11>
</BreakPoints>
<Watches Count="1">
<Item1>

6
wst/trunk/tests/ebay/umain.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls, ComCtrls;
Buttons, StdCtrls, ComCtrls, eBayWSDL;
type
@ -85,7 +85,7 @@ begin
end;
except
on e : ESOAPException do begin
ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]);
ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"; Msg : '#13'%s',[e.FaultCode,e.FaultString,e.Message]);
end;
end;
end;
@ -166,7 +166,7 @@ begin
end;
except
on e : ESOAPException do begin
ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]);
ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"; Msg : '#13'%s',[e.FaultCode,e.FaultString,e.Message]);
end;
end;
end;

41
wst/trunk/tests/google_api/test_google_api.lpi
View File

@ -12,7 +12,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -180,9 +180,11 @@
<Unit20>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="3" Y="225"/>
<TopLine Value="212"/>
<CursorPos X="35" Y="37"/>
<TopLine Value="33"/>
<EditorIndex Value="2"/>
<UsageCount Value="55"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
@ -230,7 +232,7 @@
<UnitName Value="soap_formatter"/>
<CursorPos X="36" Y="29"/>
<TopLine Value="12"/>
<EditorIndex Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="49"/>
<Loaded Value="True"/>
</Unit27>
@ -239,16 +241,16 @@
<UnitName Value="base_soap_formatter"/>
<CursorPos X="3" Y="694"/>
<TopLine Value="666"/>
<EditorIndex Value="2"/>
<EditorIndex Value="4"/>
<UsageCount Value="49"/>
<Loaded Value="True"/>
</Unit28>
<Unit29>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="55" Y="2854"/>
<TopLine Value="2811"/>
<EditorIndex Value="6"/>
<CursorPos X="3" Y="119"/>
<TopLine Value="135"/>
<EditorIndex Value="8"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit29>
@ -276,9 +278,11 @@
<Filename Value="googlewebapi_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="googlewebapi_proxy"/>
<CursorPos X="6" Y="38"/>
<TopLine Value="24"/>
<CursorPos X="29" Y="64"/>
<TopLine Value="47"/>
<EditorIndex Value="1"/>
<UsageCount Value="72"/>
<Loaded Value="True"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\v0.2\base_service_intf.pas"/>
@ -354,7 +358,7 @@
<UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="498"/>
<TopLine Value="139"/>
<EditorIndex Value="4"/>
<EditorIndex Value="6"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit44>
@ -364,7 +368,7 @@
<UnitName Value="wst_resources_imp"/>
<CursorPos X="23" Y="1"/>
<TopLine Value="19"/>
<EditorIndex Value="5"/>
<EditorIndex Value="7"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit45>
@ -372,16 +376,21 @@
<Filename Value="googlewebapi.wst"/>
<CursorPos X="74" Y="13"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<EditorIndex Value="5"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
<SyntaxHighlighter Value="None"/>
</Unit46>
</Units>
<JumpHistory Count="1" HistoryIndex="0">
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="googlewebapi.wst"/>
<Caret Line="13" Column="74" TopLine="1"/>
<Filename Value="googlewebapi_proxy.pas"/>
<Caret Line="64" Column="29" TopLine="47"/>
</Position1>
<Position2>
<Filename Value="..\..\service_intf.pas"/>
<Caret Line="37" Column="35" TopLine="33"/>
</Position2>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

102
wst/trunk/tests/http_server/wst_http_server.lpi
View File

@ -12,6 +12,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -43,9 +44,11 @@
<Filename Value="app_object.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="app_object"/>
<CursorPos X="46" Y="296"/>
<TopLine Value="63"/>
<CursorPos X="1" Y="238"/>
<TopLine Value="224"/>
<EditorIndex Value="2"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Core\IdSocketHandle.pas"/>
@ -244,9 +247,11 @@
<Filename Value="..\..\metadata_repository.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="31" Y="629"/>
<TopLine Value="72"/>
<CursorPos X="1" Y="309"/>
<TopLine Value="247"/>
<EditorIndex Value="3"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
</Unit28>
<Unit29>
<Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
@ -431,9 +436,11 @@
<Filename Value="..\..\metadata_service_binder.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_service_binder"/>
<CursorPos X="53" Y="11"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="53"/>
<TopLine Value="46"/>
<EditorIndex Value="1"/>
<UsageCount Value="186"/>
<Loaded Value="True"/>
</Unit56>
<Unit57>
<Filename Value="..\..\metadata_service.lrs"/>
@ -464,9 +471,11 @@
<Filename Value="..\calculator\srv\calculator_imp.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calculator_imp"/>
<CursorPos X="65" Y="3"/>
<TopLine Value="129"/>
<CursorPos X="40" Y="135"/>
<TopLine Value="111"/>
<EditorIndex Value="0"/>
<UsageCount Value="123"/>
<Loaded Value="True"/>
</Unit61>
<Unit62>
<Filename Value="..\calculator\srv\calculator_binder.pas"/>
@ -545,7 +554,64 @@
<UsageCount Value="13"/>
</Unit72>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="14" HistoryIndex="13">
<Position1>
<Filename Value="app_object.pas"/>
<Caret Line="238" Column="26" TopLine="224"/>
</Position1>
<Position2>
<Filename Value="app_object.pas"/>
<Caret Line="239" Column="1" TopLine="225"/>
</Position2>
<Position3>
<Filename Value="app_object.pas"/>
<Caret Line="240" Column="1" TopLine="226"/>
</Position3>
<Position4>
<Filename Value="app_object.pas"/>
<Caret Line="241" Column="1" TopLine="227"/>
</Position4>
<Position5>
<Filename Value="app_object.pas"/>
<Caret Line="242" Column="1" TopLine="228"/>
</Position5>
<Position6>
<Filename Value="app_object.pas"/>
<Caret Line="243" Column="1" TopLine="229"/>
</Position6>
<Position7>
<Filename Value="app_object.pas"/>
<Caret Line="245" Column="1" TopLine="240"/>
</Position7>
<Position8>
<Filename Value="app_object.pas"/>
<Caret Line="246" Column="1" TopLine="232"/>
</Position8>
<Position9>
<Filename Value="app_object.pas"/>
<Caret Line="247" Column="36" TopLine="243"/>
</Position9>
<Position10>
<Filename Value="app_object.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position10>
<Position11>
<Filename Value="app_object.pas"/>
<Caret Line="71" Column="20" TopLine="57"/>
</Position11>
<Position12>
<Filename Value="app_object.pas"/>
<Caret Line="247" Column="1" TopLine="233"/>
</Position12>
<Position13>
<Filename Value="app_object.pas"/>
<Caret Line="248" Column="1" TopLine="234"/>
</Position13>
<Position14>
<Filename Value="app_object.pas"/>
<Caret Line="238" Column="1" TopLine="224"/>
</Position14>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
@ -572,31 +638,27 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="6">
<BreakPoints Count="5">
<Item1>
<Source Value="..\..\metadata_repository.pas"/>
<Line Value="309"/>
<Source Value="..\..\metadata_wsdl.pas"/>
<Line Value="459"/>
</Item1>
<Item2>
<Source Value="..\..\metadata_wsdl.pas"/>
<Line Value="459"/>
<Line Value="468"/>
</Item2>
<Item3>
<Source Value="..\..\metadata_wsdl.pas"/>
<Line Value="468"/>
<Line Value="431"/>
</Item3>
<Item4>
<Source Value="..\..\metadata_wsdl.pas"/>
<Line Value="431"/>
<Line Value="181"/>
</Item4>
<Item5>
<Source Value="..\..\metadata_wsdl.pas"/>
<Line Value="181"/>
</Item5>
<Item6>
<Source Value="..\..\server_service_intf.pas"/>
<Line Value="630"/>
</Item6>
</Item5>
</BreakPoints>
<Exceptions Count="2">
<Item1>

5
wst/trunk/tests/metadata_browser/metadata_browser.lpi
View File

@ -7,6 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -40,9 +41,11 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="32" Y="97"/>
<CursorPos X="53" Y="97"/>
<TopLine Value="82"/>
<EditorIndex Value="0"/>
<UsageCount Value="75"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\metadata_service_proxy.pas"/>

163
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -277,6 +277,8 @@ type
property Val_Currency : Currency Read FVal_Currency Write FVal_Currency;
End;
TEmbeddedArrayOfStringRemotable = class(TArrayOfStringRemotable);
{ TTestFormatterSimpleType }
TTestFormatterSimpleType= class(TTestCase)
@ -320,6 +322,7 @@ type
procedure Test_Object();
procedure Test_Object_Nil();
procedure Test_StringArray();
procedure Test_StringArray_Embedded();
procedure Test_StringArrayZeroLength();
procedure Test_BooleanArray();
@ -458,7 +461,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_U';
f.Get(TypeInfo(Byte),x,intVal_U);
x := 'intVal_S';
@ -496,7 +499,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(Byte),intVal_U);
f.EndScopeRead();
AssertEquals(VAL_1,intVal_U);
@ -515,7 +518,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(ShortInt),intVal_S);
f.EndScopeRead();
AssertEquals(VAL_2,intVal_S);
@ -552,7 +555,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_U';
f.Get(TypeInfo(Word),x,intVal_U);
x := 'intVal_S';
@ -594,7 +597,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_U';
f.Get(TypeInfo(LongWord),x,intVal_U);
x := 'intVal_S';
@ -636,7 +639,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_U';
f.Get(TypeInfo(QWord),x,intVal_U);
x := 'intVal_S';
@ -675,7 +678,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Float));
x := 'tmpVal';
f.Get(TypeInfo(Single),x,tmpVal);
f.EndScopeRead();
@ -711,7 +714,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Float));
x := 'tmpVal';
f.Get(TypeInfo(Double),x,tmpVal);
f.EndScopeRead();
@ -747,7 +750,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Float));
x := 'tmpVal';
f.Get(TypeInfo(Currency),x,tmpVal);
f.EndScopeRead();
@ -783,7 +786,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Float));
x := 'tmpVal';
f.Get(TypeInfo(Extended),x,tmpVal);
f.EndScopeRead();
@ -822,7 +825,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_1';
f.Get(TypeInfo(string),x,intVal_1);
x := 'intVal_3';
@ -864,7 +867,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_1';
f.Get(TypeInfo(Boolean),x,intVal_1);
x := 'intVal_3';
@ -906,7 +909,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'intVal_1';
f.Get(TypeInfo(TTestEnum),x,intVal_1);
x := 'intVal_3';
@ -954,7 +957,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_Int),x,a);
f.EndScopeRead();
@ -1003,7 +1006,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Float));
x := 'o1';
f.Get(TypeInfo(TClass_Float),x,a);
f.EndScopeRead();
@ -1046,7 +1049,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Enum),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Enum));
x := 'o1';
f.Get(TypeInfo(TClass_Enum),x,a);
f.EndScopeRead();
@ -1106,7 +1109,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1179,7 +1182,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1252,7 +1255,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1325,7 +1328,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1404,7 +1407,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1471,7 +1474,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
@ -1521,7 +1524,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'o1';
f.Get(TypeInfo(TClass_B),x,a);
f.EndScopeRead();
@ -1567,7 +1570,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'o1';
f.Get(TypeInfo(TClass_B),x,a);
f.EndScopeRead();
@ -1614,7 +1617,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfStringRemotable),x,a);
f.EndScopeRead();
@ -1629,6 +1632,82 @@ begin
end;
end;
procedure TTestFormatter.Test_StringArray_Embedded();
const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1');
var
a : TArrayOfStringRemotable;
b : TEmbeddedArrayOfStringRemotable;
i, intVal : Integer;
f : IFormatterBase;
s : TMemoryStream;
x : string;
begin
b := nil;
a := TArrayOfStringRemotable.Create();
try
b := TEmbeddedArrayOfStringRemotable.Create();
AssertEquals(0,a.Length);
a.SetLength(0);
AssertEquals('Length 1', 0,a.Length);
a.SetLength(AR_LEN);
AssertEquals(AR_LEN,a.Length);
b.SetLength(AR_LEN);
AssertEquals(AR_LEN,b.Length);
for i := 0 to Pred(AR_LEN) do begin
a[i] := VAL_AR[i];
b[i] := VAL_AR[Pred(AR_LEN)-i];
end;
intVal := 1210;
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TArrayOfStringRemotable),a);
f.Put('x',TypeInfo(Integer),intVal);
f.Put('b',TypeInfo(TEmbeddedArrayOfStringRemotable),b);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s); s.SaveToFile(ClassName + '.XML');
FreeAndNil(a);
FreeAndNil(b);
intVal := 0;
a := TArrayOfStringRemotable.Create();
b := TEmbeddedArrayOfStringRemotable.Create();
a.SetLength(0);
a.SetLength(0);
a.SetLength(0);
b.SetLength(0);
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfStringRemotable),x,a);
x := 'x';
f.Get(TypeInfo(Integer),x,intVal);
x := 'b';
f.Get(TypeInfo(TEmbeddedArrayOfStringRemotable),x,b);
f.EndScopeRead();
AssertEquals('IntVal', 1210,intVal);
AssertEquals('Length 2', AR_LEN,a.Length);
AssertEquals('Length 2', AR_LEN,b.Length);
for i := 0 to Pred(AR_LEN) do begin
AssertEquals(VAL_AR[i],a[i]);
AssertEquals(VAL_AR[Pred(AR_LEN)-i],b[i]);
end;
finally
b.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_StringArrayZeroLength();
var
a : TArrayOfStringRemotable;
@ -1652,7 +1731,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfStringRemotable),x,a);
f.EndScopeRead();
@ -1700,7 +1779,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfBooleanRemotable),x,a);
f.EndScopeRead();
@ -1750,7 +1829,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt8URemotable),x,a);
f.EndScopeRead();
@ -1800,7 +1879,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt8SRemotable),x,a);
f.EndScopeRead();
@ -1850,7 +1929,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt16SRemotable),x,a);
f.EndScopeRead();
@ -1900,7 +1979,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt16URemotable),x,a);
f.EndScopeRead();
@ -1950,7 +2029,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt32URemotable),x,a);
f.EndScopeRead();
@ -2000,7 +2079,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt32SRemotable),x,a);
f.EndScopeRead();
@ -2050,7 +2129,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt64SRemotable),x,a);
f.EndScopeRead();
@ -2100,7 +2179,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfInt64URemotable),x,a);
f.EndScopeRead();
@ -2150,7 +2229,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfFloatSingleRemotable),x,a);
f.EndScopeRead();
@ -2200,7 +2279,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfFloatDoubleRemotable),x,a);
f.EndScopeRead();
@ -2250,7 +2329,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfFloatExtendedRemotable),x,a);
f.EndScopeRead();
@ -2300,7 +2379,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_B),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TArrayOfFloatCurrencyRemotable),x,a);
f.EndScopeRead();
@ -2347,7 +2426,7 @@ begin
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject);
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'a';
f.Get(TypeInfo(TComplexInt32SContentRemotable),x,a);
x := 'b';
@ -3008,6 +3087,10 @@ initialization
TClass_CplxSimpleContent.RegisterAttributeProperty('Elt_Exemple');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_CplxSimpleContent),'TClass_CplxSimpleContent').RegisterExternalPropertyName('Elt_Exemple', 'published');
with GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TEmbeddedArrayOfStringRemotable),'TEmbeddedArrayOfStringRemotable') do begin
RegisterExternalPropertyName(sARRAY_ITEM,'abc');
RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded);
end;
RegisterTest(TTestArray);
RegisterTest(TTestSOAPFormatter);

234
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -40,9 +40,9 @@
<Filename Value="testformatter_unit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testformatter_unit"/>
<CursorPos X="27" Y="3020"/>
<TopLine Value="2992"/>
<EditorIndex Value="7"/>
<CursorPos X="30" Y="1693"/>
<TopLine Value="1662"/>
<EditorIndex Value="8"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit1>
@ -50,24 +50,28 @@
<Filename Value="..\..\server_service_soap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_soap"/>
<CursorPos X="20" Y="205"/>
<TopLine Value="162"/>
<CursorPos X="34" Y="126"/>
<TopLine Value="109"/>
<EditorIndex Value="4"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="10" Y="118"/>
<TopLine Value="89"/>
<CursorPos X="34" Y="145"/>
<TopLine Value="125"/>
<EditorIndex Value="5"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\base_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="45" Y="1007"/>
<TopLine Value="1003"/>
<CursorPos X="14" Y="279"/>
<TopLine Value="268"/>
<EditorIndex Value="2"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
@ -76,12 +80,12 @@
<Filename Value="..\..\base_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="26" Y="2965"/>
<TopLine Value="665"/>
<CursorPos X="3" Y="119"/>
<TopLine Value="132"/>
<EditorIndex Value="0"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="5" Y="1161" ID="1"/>
<Item0 X="5" Y="1175" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit5>
@ -89,8 +93,8 @@
<Filename Value="..\..\base_soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="18" Y="929"/>
<TopLine Value="942"/>
<CursorPos X="14" Y="87"/>
<TopLine Value="73"/>
<EditorIndex Value="3"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
@ -99,9 +103,11 @@
<Filename Value="..\..\binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_formatter"/>
<CursorPos X="15" Y="44"/>
<TopLine Value="33"/>
<CursorPos X="22" Y="132"/>
<TopLine Value="118"/>
<EditorIndex Value="6"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\binary_streamer.pas"/>
@ -115,26 +121,26 @@
<Filename Value="..\..\server_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="5" Y="136"/>
<TopLine Value="92"/>
<CursorPos X="22" Y="100"/>
<TopLine Value="86"/>
<EditorIndex Value="7"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\metadata_repository.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="25" Y="14"/>
<TopLine Value="712"/>
<EditorIndex Value="1"/>
<TopLine Value="701"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="15" Y="579"/>
<TopLine Value="565"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit11>
<Unit12>
<Filename Value="testmetadata_unit.pas"/>
@ -142,9 +148,7 @@
<UnitName Value="testmetadata_unit"/>
<CursorPos X="50" Y="118"/>
<TopLine Value="106"/>
<EditorIndex Value="8"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="..\..\ws_helper\metadata_generator.pas"/>
@ -160,21 +164,19 @@
<UnitName Value="parserdefs"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="202"/>
<Bookmarks Count="2">
<Item0 X="45" Y="1146" ID="0"/>
<Item1 X="18" Y="1133" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="..\..\metadata_wsdl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="25" Y="759"/>
<TopLine Value="748"/>
<EditorIndex Value="4"/>
<CursorPos X="3" Y="764"/>
<TopLine Value="775"/>
<EditorIndex Value="1"/>
<UsageCount Value="206"/>
<Loaded Value="True"/>
</Unit15>
@ -183,13 +185,13 @@
<UnitName Value="DOM"/>
<CursorPos X="15" Y="429"/>
<TopLine Value="413"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit16>
<Unit17>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="13" Y="235"/>
<TopLine Value="215"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit17>
<Unit18>
<Filename Value="..\..\server_service_intf.pas"/>
@ -197,45 +199,45 @@
<UnitName Value="server_service_intf"/>
<CursorPos X="35" Y="379"/>
<TopLine Value="397"/>
<UsageCount Value="143"/>
<UsageCount Value="153"/>
</Unit18>
<Unit19>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="23"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit19>
<Unit20>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="316"/>
<TopLine Value="304"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit20>
<Unit21>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="407"/>
<TopLine Value="404"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit21>
<Unit22>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="3" Y="474"/>
<TopLine Value="471"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit22>
<Unit23>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="27" Y="121"/>
<TopLine Value="104"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit23>
<Unit24>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpas.inc"/>
<CursorPos X="9" Y="166"/>
<TopLine Value="142"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit24>
<Unit25>
<Filename Value="D:\Lazarus\components\fpcunit\guitestrunner.pas"/>
@ -244,60 +246,60 @@
<UnitName Value="GuiTestRunner"/>
<CursorPos X="34" Y="32"/>
<TopLine Value="25"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="21" Y="94"/>
<TopLine Value="83"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\DUnitCompatibleInterface.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="4"/>
<UsageCount Value="1"/>
<UsageCount Value="10"/>
</Unit27>
<Unit28>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="15" Y="36"/>
<TopLine Value="22"/>
<UsageCount Value="1"/>
<UsageCount Value="10"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="3" Y="1412"/>
<TopLine Value="1407"/>
<UsageCount Value="5"/>
<CursorPos X="3" Y="51"/>
<TopLine Value="41"/>
<UsageCount Value="10"/>
</Unit29>
<Unit30>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="33" Y="192"/>
<TopLine Value="186"/>
<UsageCount Value="4"/>
<UsageCount Value="3"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="43" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit31>
<Unit32>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\datih.inc"/>
<CursorPos X="10" Y="109"/>
<TopLine Value="107"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\dati.inc"/>
<CursorPos X="46" Y="130"/>
<TopLine Value="122"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit33>
<Unit34>
<Filename Value="test_parserdef.pas"/>
@ -305,152 +307,34 @@
<UnitName Value="test_parserdef"/>
<CursorPos X="93" Y="76"/>
<TopLine Value="11"/>
<EditorIndex Value="6"/>
<UsageCount Value="63"/>
<Loaded Value="True"/>
<UsageCount Value="73"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\testutils.pp"/>
<UnitName Value="testutils"/>
<CursorPos X="34" Y="25"/>
<TopLine Value="1"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="18" Y="17"/>
<TopLine Value="16"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit36>
<Unit37>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="26" Y="134"/>
<TopLine Value="141"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit37>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="315" Column="17" TopLine="291"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="587" Column="29" TopLine="571"/>
</Position1>
<Position2>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="230" Column="17" TopLine="216"/>
</Position2>
<Position3>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="198" Column="17" TopLine="185"/>
</Position3>
<Position4>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="230" Column="14" TopLine="220"/>
</Position4>
<Position5>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="360" Column="27" TopLine="353"/>
</Position5>
<Position6>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="54" Column="15" TopLine="39"/>
</Position7>
<Position8>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="62" Column="15" TopLine="47"/>
</Position8>
<Position9>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="108" Column="26" TopLine="93"/>
</Position9>
<Position10>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="127" Column="25" TopLine="112"/>
</Position10>
<Position11>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="198" Column="20" TopLine="192"/>
</Position11>
<Position12>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="220" Column="15" TopLine="198"/>
</Position12>
<Position13>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="264" Column="29" TopLine="252"/>
</Position13>
<Position14>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="342" Column="30" TopLine="327"/>
</Position14>
<Position15>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="54" Column="15" TopLine="39"/>
</Position16>
<Position17>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="62" Column="15" TopLine="47"/>
</Position17>
<Position18>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="108" Column="26" TopLine="93"/>
</Position18>
<Position19>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="127" Column="25" TopLine="112"/>
</Position19>
<Position20>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="220" Column="20" TopLine="195"/>
</Position20>
<Position21>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="326" Column="21" TopLine="303"/>
</Position21>
<Position22>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="343" Column="75" TopLine="328"/>
</Position22>
<Position23>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="383" Column="25" TopLine="364"/>
</Position23>
<Position24>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="423" Column="65" TopLine="413"/>
</Position24>
<Position25>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="85" Column="1" TopLine="71"/>
</Position25>
<Position26>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="429" Column="68" TopLine="426"/>
</Position26>
<Position27>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="85" Column="1" TopLine="71"/>
</Position27>
<Position28>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="621" Column="5" TopLine="586"/>
</Position28>
<Position29>
<Filename Value="..\..\metadata_repository.pas"/>
<Caret Line="635" Column="8" TopLine="617"/>
</Position29>
<Position30>
<Filename Value="testmetadata_unit.pas"/>
<Caret Line="118" Column="50" TopLine="106"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

15
wst/trunk/ws_helper/command_line_parser.pas
View File

@ -49,16 +49,19 @@ begin
end;
function ParseCmdLineOptions(out AAppOptions : TComandLineOptions):Integer;
Var
var
c : Char;
begin
AAppOptions := [];
c := #0;
Repeat
c := GetOpt('upibo:a:');
repeat
c := GetOpt('u:pibo:a:');
case c of
'u' : Include(AAppOptions,cloInterface);
'u' :
begin
Include(AAppOptions,cloInterface);
OptionsArgsMAP[cloInterface] := OptArg;
end;
'p' : Include(AAppOptions,cloProxy);
'i' : Include(AAppOptions,cloImp);
'b' : Include(AAppOptions,cloBinder);
@ -73,7 +76,7 @@ begin
OptionsArgsMAP[cloOutPutDirAbsolute] := OptArg;
End;
end;
Until ( c = EndOfOptions );
until ( c = EndOfOptions );
Result := OptInd;
end;

16
wst/trunk/ws_helper/generator.pas
View File

@ -401,8 +401,7 @@ Var
Indent();WriteLn('%s : %s;',[sLOC_SERIALIZER,sSERIALIZER_CLASS]);
Indent();WriteLn('%s : %s;',[sPRM_NAME,'string']);
//If ( AMthd.MethodType = mtFunction ) Then
//Indent();WriteLn('%s : %s;',[sRES_TYPE_INFO,'PTypeInfo']);
WriteLn('Begin');
Indent();WriteLn('%s := GetSerializer();',[sLOC_SERIALIZER]);
@ -1302,6 +1301,9 @@ procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition);
begin
Indent();
WriteLn('%s = interface',[GenerateIntfName(AIntf)]);
if not IsStrEmpty(AIntf.InterfaceGUID) then begin
Indent();Indent();WriteLn('[%s]',[QuotedStr(AIntf.InterfaceGUID)]);
end;
end;
procedure WriteMethod(AMthd : TMethodDefinition);
@ -1759,8 +1761,16 @@ begin
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]);
if ( ASymbol.ItemName <> ASymbol.ItemExternalName ) then begin
FImpTempStream.Indent();
FImpTempStream.WriteLn(
'GetTypeRegistry().ItemByTypeInfo[%s].RegisterExternalPropertyName(''item'',%s);',
'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_ITEM,%s);',
[ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)]
);
end;
if ( ASymbol.Style = asEmbeded ) then begin
FImpTempStream.Indent();
FImpTempStream.WriteLn(
'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded);',
[ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)]
);
end;

19
wst/trunk/ws_helper/parserdefs.pas
View File

@ -43,6 +43,7 @@ Type
FName: String;
FExternalAlias : string;
protected
procedure SetName(const AName : string);virtual;
procedure FixForwardTypeDefinitions(
AFrw : TForwardTypeDefinition;
Atype : TTypeDefinition
@ -129,6 +130,8 @@ Type
TForwardTypeDefinition = class(TTypeDefinition)
end;
TArrayStyle = ( asScoped, asEmbeded );
{ TArrayDefinition }
TArrayDefinition = class(TTypeDefinition)
@ -136,6 +139,7 @@ Type
FItemExternalName: string;
FItemName: string;
FItemType: TTypeDefinition;
FStyle: TArrayStyle;
protected
procedure FixForwardTypeDefinitions(
AFrw : TForwardTypeDefinition;
@ -146,12 +150,14 @@ Type
const AName : string;
AItemType : TTypeDefinition;
const AItemName,
AItemExternalName : string
AItemExternalName : string;
const AStyle : TArrayStyle
);
function NeedFinalization():Boolean;override;
property ItemName : string read FItemName;
property ItemType : TTypeDefinition read FItemType;
property ItemExternalName : string read FItemExternalName;
property Style : TArrayStyle read FStyle;
end;
TEnumTypeDefinition = class;
@ -298,8 +304,8 @@ Type
private
FMethodType: TMethodType;
FParameterList : TObjectList;
private
FProperties: TStrings;
private
function GetParameter(Index: Integer): TParameterDefinition;
function GetParameterCount: Integer;
protected
@ -460,6 +466,11 @@ begin
Result := AnsiSameText(AName,Self.Name) or AnsiSameText(AName,Self.ExternalName);
end;
procedure TAbstractSymbolDefinition.SetName(const AName: string);
begin
FName := AName;
end;
procedure TAbstractSymbolDefinition.FixForwardTypeDefinitions(
AFrw : TForwardTypeDefinition;
Atype : TTypeDefinition
@ -1280,11 +1291,13 @@ constructor TArrayDefinition.Create(
const AName : string;
AItemType : TTypeDefinition;
const AItemName,
AItemExternalName : string
AItemExternalName : string;
const AStyle : TArrayStyle
);
begin
Assert(Assigned(AItemType));
inherited Create(AName);
FStyle := AStyle;
FItemType := AItemType;
FItemName := AItemName;
FItemExternalName := AItemExternalName;

2
wst/trunk/ws_helper/test_ebay.bat
View File

@ -1 +1 @@
C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\eBayLast\eBayWSDL.WSDL" >test_res_eBayWSDL.txt
C:\Programmes\lazarus\wst\ws_helper\ws_helper -uA -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\eBayLast\eBayWSDL.WSDL" >test_res_eBayWSDL.txt

204
wst/trunk/ws_helper/ws_helper.lpi
View File

@ -33,13 +33,13 @@
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="48">
<Units Count="49">
<Unit0>
<Filename Value="ws_helper.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ws_helper"/>
<CursorPos X="30" Y="181"/>
<TopLine Value="99"/>
<CursorPos X="9" Y="77"/>
<TopLine Value="195"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
@ -50,7 +50,7 @@
<UnitName Value="ws_parser"/>
<CursorPos X="1" Y="437"/>
<TopLine Value="423"/>
<EditorIndex Value="8"/>
<EditorIndex Value="9"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit1>
@ -58,15 +58,15 @@
<Filename Value="generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="generator"/>
<CursorPos X="36" Y="1286"/>
<TopLine Value="1281"/>
<CursorPos X="53" Y="1766"/>
<TopLine Value="1756"/>
<EditorIndex Value="0"/>
<UsageCount Value="200"/>
<Bookmarks Count="4">
<Item0 X="43" Y="723" ID="0"/>
<Item1 X="69" Y="860" ID="1"/>
<Item0 X="43" Y="722" ID="0"/>
<Item1 X="69" Y="859" ID="1"/>
<Item2 X="17" Y="219" ID="2"/>
<Item3 X="23" Y="1810" ID="4"/>
<Item3 X="23" Y="1820" ID="4"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
@ -74,9 +74,9 @@
<Filename Value="parserdefs.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parserdefs"/>
<CursorPos X="58" Y="355"/>
<TopLine Value="330"/>
<EditorIndex Value="6"/>
<CursorPos X="15" Y="312"/>
<TopLine Value="298"/>
<EditorIndex Value="7"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit3>
@ -86,7 +86,7 @@
<UnitName Value="parserutils"/>
<CursorPos X="1" Y="39"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<EditorIndex Value="8"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit4>
@ -177,9 +177,11 @@
<Filename Value="command_line_parser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="command_line_parser"/>
<CursorPos X="34" Y="69"/>
<TopLine Value="19"/>
<CursorPos X="38" Y="63"/>
<TopLine Value="43"/>
<EditorIndex Value="2"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="metadata_generator.pas"/>
@ -187,8 +189,8 @@
<UnitName Value="metadata_generator"/>
<CursorPos X="3" Y="96"/>
<TopLine Value="69"/>
<EditorIndex Value="2"/>
<UsageCount Value="190"/>
<EditorIndex Value="3"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
@ -197,7 +199,7 @@
<UnitName Value="binary_streamer"/>
<CursorPos X="32" Y="344"/>
<TopLine Value="328"/>
<UsageCount Value="190"/>
<UsageCount Value="200"/>
</Unit19>
<Unit20>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\finah.inc"/>
@ -268,7 +270,7 @@
<UnitName Value="wst_resources_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="105"/>
<UsageCount Value="117"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\win32\classes.pp"/>
@ -286,9 +288,9 @@
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="15" Y="19"/>
<TopLine Value="7"/>
<UsageCount Value="5"/>
<CursorPos X="13" Y="178"/>
<TopLine Value="163"/>
<UsageCount Value="10"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\osutilsh.inc"/>
@ -314,7 +316,7 @@
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="29" Y="1641"/>
<TopLine Value="1633"/>
<UsageCount Value="97"/>
<UsageCount Value="109"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\fexpand.inc"/>
@ -334,17 +336,17 @@
<UnitName Value="dom_cursors"/>
<CursorPos X="3" Y="110"/>
<TopLine Value="108"/>
<EditorIndex Value="4"/>
<UsageCount Value="31"/>
<EditorIndex Value="5"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit40>
<Unit41>
<Filename Value="..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="3" Y="89"/>
<TopLine Value="84"/>
<EditorIndex Value="5"/>
<UsageCount Value="33"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="38"/>
<Loaded Value="True"/>
</Unit41>
<Unit42>
@ -381,137 +383,31 @@
<Unit47>
<Filename Value="wsdl2pas_imp.pas"/>
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="21" Y="514"/>
<TopLine Value="514"/>
<EditorIndex Value="3"/>
<UsageCount Value="24"/>
<CursorPos X="3" Y="543"/>
<TopLine Value="447"/>
<EditorIndex Value="4"/>
<UsageCount Value="29"/>
<Bookmarks Count="1">
<Item0 X="21" Y="646" ID="3"/>
<Item0 X="21" Y="665" ID="3"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit47>
<Unit48>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutils.inc"/>
<CursorPos X="3" Y="567"/>
<TopLine Value="565"/>
<UsageCount Value="10"/>
</Unit48>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="401" Column="34" TopLine="386"/>
<Filename Value="generator.pas"/>
<Caret Line="427" Column="75" TopLine="414"/>
</Position1>
<Position2>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1063" Column="19" TopLine="1049"/>
<Filename Value="generator.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="176" Column="63" TopLine="151"/>
</Position3>
<Position4>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1066" Column="24" TopLine="1054"/>
</Position4>
<Position5>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="559" Column="20" TopLine="544"/>
</Position5>
<Position6>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="297" Column="37" TopLine="279"/>
</Position6>
<Position7>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="193" Column="88" TopLine="175"/>
</Position7>
<Position8>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="617" Column="31" TopLine="594"/>
</Position8>
<Position9>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="561" Column="20" TopLine="553"/>
</Position9>
<Position10>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1092" Column="15" TopLine="1074"/>
</Position10>
<Position11>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="442" Column="13" TopLine="428"/>
</Position11>
<Position12>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="508" Column="20" TopLine="492"/>
</Position12>
<Position13>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="617" Column="1" TopLine="602"/>
</Position13>
<Position14>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="508" Column="14" TopLine="485"/>
</Position14>
<Position15>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="116" Column="58" TopLine="102"/>
</Position15>
<Position16>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="513" Column="68" TopLine="513"/>
</Position16>
<Position17>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="117" Column="28" TopLine="116"/>
</Position17>
<Position18>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1095" Column="15" TopLine="1071"/>
</Position18>
<Position19>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="442" Column="10" TopLine="428"/>
</Position19>
<Position20>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="499" Column="53" TopLine="471"/>
</Position20>
<Position21>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="137" Column="55" TopLine="119"/>
</Position21>
<Position22>
<Filename Value="parserdefs.pas"/>
<Caret Line="334" Column="22" TopLine="330"/>
</Position22>
<Position23>
<Filename Value="generator.pas"/>
<Caret Line="1770" Column="41" TopLine="1765"/>
</Position23>
<Position24>
<Filename Value="generator.pas"/>
<Caret Line="1812" Column="4" TopLine="1805"/>
</Position24>
<Position25>
<Filename Value="generator.pas"/>
<Caret Line="1795" Column="28" TopLine="1780"/>
</Position25>
<Position26>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="507" Column="40" TopLine="478"/>
</Position26>
<Position27>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="153" Column="56" TopLine="127"/>
</Position27>
<Position28>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="506" Column="16" TopLine="487"/>
</Position28>
<Position29>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="508" Column="1" TopLine="493"/>
</Position29>
<Position30>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="515" Column="1" TopLine="490"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -550,7 +446,7 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<BreakPoints Count="3">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
@ -563,10 +459,6 @@
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="ws_helper.pas"/>
<Line Value="85"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>

23
wst/trunk/ws_helper/ws_helper.pas
View File

@ -29,8 +29,9 @@ uses
DOM, xmlread, wsdl2pas_imp;
resourcestring
sUSAGE = 'ws_helper [-u] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE +
' -u Generate the pascal translation of the WSDL input file ' + sNEW_LINE +
sUSAGE = 'ws_helper [-uMODE] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE +
' -u MODE Generate the pascal translation of the WSDL input file ' + sNEW_LINE +
' MODE value may be U for used types or A for all types' + sNEW_LINE +
' -p Generate service proxy' + sNEW_LINE +
' -b Generate service binder' + sNEW_LINE +
' -i Generate service minimal implementation' + sNEW_LINE +
@ -51,12 +52,14 @@ Var
NextParam : Integer;
sourceType : TSourceFileType;
symtable : TSymbolTable;
parserMode : TParserMode;
function ProcessCmdLine():boolean;
begin
NextParam := ParseCmdLineOptions(AppOptions);
If ( NextParam <= Paramcount ) Then
if ( NextParam <= Paramcount ) then begin
inFileName := ParamStr(NextParam);
end;
Result := FileExists(ExpandFileName(inFileName));
if AnsiSameText(ExtractFileExt(inFileName),'.PAS') or
AnsiSameText(ExtractFileExt(inFileName),'.PP')
@ -65,11 +68,13 @@ Var
end else if AnsiSameText(ExtractFileExt(inFileName),'.WSDL') then begin
sourceType := sftWSDL;
end;
If Result Then Begin
If ( AppOptions = [] ) Then
if Result then begin
if ( AppOptions = [] ) then begin
Include(AppOptions,cloProxy);
End Else
end;
end else begin
errStr := Format('File not Found : "%s"',[inFileName]);
end;
if ( cloOutPutDirAbsolute in AppOptions ) then begin
outPath := Trim(GetOptionArg(cloOutPutDirAbsolute));
end else begin
@ -79,6 +84,10 @@ Var
end;
end;
outPath := IncludeTrailingPathDelimiter(outPath);
parserMode := pmUsedTypes;
if AnsiSameText('A',Trim(GetOptionArg(cloInterface))) then begin
parserMode := pmAllTypes;
end;
end;
function GenerateSymbolTable() : Boolean ;
@ -110,7 +119,7 @@ Var
ReadXMLFile(locDoc,inFileName);
try
prsr := TWsdlParser.Create(locDoc,symtable);
prsr.Parse();
prsr.Parse(parserMode);
finally
FreeAndNil(prsr);
FreeAndNil(locDoc);

141
wst/trunk/ws_helper/wsdl2pas_imp.pas
View File

@ -81,6 +81,8 @@ type
function Parse():TTypeDefinition;override;
end;
TParserMode = ( pmUsedTypes, pmAllTypes );
{ TWsdlParser }
TWsdlParser = class
@ -122,10 +124,11 @@ type
const ASoapBindingStyle : string
) : TMethodDefinition;
function ParseType(const AName, ATypeOrElement : string) : TTypeDefinition;
procedure ParseTypes();
public
constructor Create(ADoc : TXMLDocument; ASymbols : TSymbolTable);
destructor Destroy();override;
procedure Parse();
procedure Parse(const AMode : TParserMode);
property SymbolTable : TSymbolTable read FSymbols;
end;
@ -449,8 +452,22 @@ end;
procedure TWsdlParser.ParsePort(ANode: TDOMNode);
function FindBindingNode(const AName : WideString):TDOMNode;
var
crs : IObjectCursor;
begin
Result := FindNamedNode(FBindingCursor,AName);
if Assigned(Result) then begin
crs := CreateChildrenCursor(Result,cetRttiNode);
if Assigned(crs) then begin
crs := CreateCursorOn(crs,ParseFilter(CreateQualifiedNameFilterStr(s_binding,FSoapShortNames),TDOMNodeRttiExposer));
crs.Reset();
if not crs.MoveNext() then begin
Result := nil;
end;
end else begin
Result := nil;
end;
end;
end;
function ExtractBindingQName(out AName : WideString):Boolean ;
@ -619,6 +636,7 @@ var
locSoapBindingStyle : string;
locWStrBuffer : WideString;
locMthd : TMethodDefinition;
inft_guid : TGuid;
begin
locAttCursor := CreateAttributesCursor(ANode,cetRttiNode);
locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
@ -634,6 +652,8 @@ begin
raise;
end;
Result := locIntf;
if ( CreateGUID(inft_guid) = 0 ) then
locIntf.InterfaceGUID := GUIDToString(inft_guid);
locCursor := CreateChildrenCursor(ANode,cetRttiNode);
if Assigned(locCursor) then begin
locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer));
@ -653,34 +673,12 @@ end;
type
{ TParamDefCrack }
TParamDefCrack = class(TParameterDefinition);
TParamDefCrack = class(TParameterDefinition)
public
procedure SetModifier(const AModifier : TParameterModifier);
end;
{ TMethodDefinitionCrack }
TMethodDefinitionCrack = class(TMethodDefinition)
public
procedure SetMethodType( AMethodType : TMethodType );
end;
{ TMethodDefinitionCrack }
procedure TMethodDefinitionCrack.SetMethodType(AMethodType: TMethodType);
begin
inherited;
end;
{ TParamDefCrack }
procedure TParamDefCrack.SetModifier(const AModifier: TParameterModifier);
begin
inherited;
end;
TMethodDefinitionCrack = class(TMethodDefinition);
TTypeDefinitionCrack = class(TTypeDefinition);
function TWsdlParser.ParseOperation(
AOwner : TInterfaceDefinition;
ANode : TDOMNode;
@ -764,10 +762,11 @@ function TWsdlParser.ParseOperation(
inMsg, strBuffer : string;
inMsgNode, tmpNode : TDOMNode;
crs, tmpCrs : IObjectCursor;
prmName, prmTypeName, prmTypeType : string;
prmName, prmTypeName, prmTypeType, prmTypeInternalName : string;
prmInternameName : string;
prmHasInternameName : Boolean;
prmDef : TParameterDefinition;
prmTypeDef : TTypeDefinition;
begin
if ExtractMsgName(s_input,inMsg) then begin
inMsgNode := FindMessageNode(inMsg);
@ -775,18 +774,20 @@ function TWsdlParser.ParseOperation(
crs := CreatePartCursor(inMsgNode);
if ( crs <> nil ) then begin
crs.Reset();
While crs.MoveNext() do begin
while crs.MoveNext() do begin
tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
end;
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name);
tmpCrs := CreateCursorOn(
CreateAttributesCursor(tmpNode,cetRttiNode),
ParseFilter(strBuffer,TDOMNodeRttiExposer)
);
tmpCrs.Reset();
if not tmpCrs.MoveNext() then
if not tmpCrs.MoveNext() then begin
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
end;
prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type);
tmpCrs := CreateCursorOn(
@ -794,20 +795,31 @@ function TWsdlParser.ParseOperation(
ParseFilter(strBuffer,TDOMNodeRttiExposer)
);
tmpCrs.Reset();
if not tmpCrs.MoveNext() then
if not tmpCrs.MoveNext() then begin
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
end;
prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName;
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
end;
prmInternameName := Trim(prmName);
prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) );
if prmHasInternameName then
if prmHasInternameName then begin
prmInternameName := '_' + prmInternameName;
prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,GetDataType(prmTypeName,prmTypeType));
end;
prmTypeDef := GetDataType(prmTypeName,prmTypeType);
prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,prmTypeDef);
if prmHasInternameName then begin
prmDef.RegisterExternalAlias(prmName);
end;
if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin
prmTypeInternalName := prmTypeDef.Name + 'Type';
while ( FSymbols.IndexOf(prmTypeInternalName) >= 0 ) do begin
prmTypeInternalName := '_' + prmTypeInternalName;
end;
TTypeDefinitionCrack(prmTypeDef).SetName(prmTypeInternalName);
end;
end;
end;
end;
@ -1010,7 +1022,7 @@ var
begin
embededType := False;
Result := FSymbols.Find(ExtractNameFromQName(AName),TTypeDefinition) as TTypeDefinition;
if ( not Assigned(Result) )or ( Result is TForwardTypeDefinition ) then begin
if ( not Assigned(Result) ) or ( Result is TForwardTypeDefinition ) then begin
Result := nil;
Init();
FindTypeNode();
@ -1024,6 +1036,51 @@ begin
end;
end;
procedure TWsdlParser.ParseTypes();
var
locTypeCrs : IObjectCursor;
locObj : TDOMNodeRttiExposer;
nd : TDOMNodeRttiExposer;
schmCrsr, crsSchemaChild, typTmpCrs : IObjectCursor;
typFilterStr : string;
typNode : TDOMNode;
begin
if Assigned(FSchemaCursor) then begin
schmCrsr := FSchemaCursor.Clone() as IObjectCursor;
schmCrsr.Reset();
while schmCrsr.MoveNext() do begin
nd := schmCrsr.GetCurrent() as TDOMNodeRttiExposer;
crsSchemaChild := CreateChildrenCursor(nd.InnerObject,cetRttiNode);
if Assigned(crsSchemaChild) then begin
typFilterStr := Format(
'%s or %s or %s',
[ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames),
CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames),
CreateQualifiedNameFilterStr(s_element,FXSShortNames)
]
);
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer));
crsSchemaChild.Reset();
while crsSchemaChild.MoveNext() do begin
typNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
typTmpCrs := CreateAttributesCursor(typNode,cetRttiNode);
if Assigned(typTmpCrs) then begin
typTmpCrs.Reset();
typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
typTmpCrs.Reset();
if typTmpCrs.MoveNext() then begin
ParseType(
(typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,
ExtractNameFromQName(typNode.NodeName)
);
end;
end;
end;
end;
end;
end;
end;
constructor TWsdlParser.Create(ADoc: TXMLDocument; ASymbols : TSymbolTable);
begin
Assert(Assigned(ADoc));
@ -1044,7 +1101,7 @@ begin
inherited Destroy();
end;
procedure TWsdlParser.Parse();
procedure TWsdlParser.Parse(const AMode : TParserMode);
procedure ParseForwardDeclarations();
var
@ -1124,6 +1181,9 @@ begin
ParseService(locObj.InnerObject);
end;
if ( AMode = pmAllTypes ) then begin
ParseTypes();
end;
ParseForwardDeclarations();
ExtractNameSpace();
end;
@ -1415,7 +1475,8 @@ var
Format('%s_%sArray',[AClassName,locPropTyp.Name]),
locPropTyp.DataType,
locPropTyp.Name,
locPropTyp.ExternalName
locPropTyp.ExternalName,
asEmbeded
)
);
end;
@ -1480,7 +1541,7 @@ var
end;
if not locSym.InheritsFrom(TTypeDefinition) then
raise EWslParserException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]);
Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item,s_item);
Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item,s_item,asScoped);
if AHasInternalName then
Result.RegisterExternalAlias(ATypeName);
end;
@ -1533,7 +1594,7 @@ begin
Result := nil;
propTyp := arrayItems[0] as TPropertyDefinition;
//arrayDef := TArrayDefinition.Create(internalName,(arrayItemType as TTypeDefinition),arrayItemName);
arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName);
arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName,asScoped);
FreeAndNil(classDef);
Result := arrayDef;
if hasInternalName then