You've already forked lazarus-ccr
+Serialization of compound element ( TBaseComplexRemotable ) is now handle by TObjectSerializer that can read/write elements of different name spaces
+Fix server side SOAP headers reading. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@533 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
@ -175,6 +175,7 @@ type
|
||||
FRootData : PDataBuffer;
|
||||
FStack : TObjectStack;
|
||||
FSerializationStyle : TSerializationStyle;
|
||||
FPropMngr : IPropertyManager;
|
||||
{$IFDEF wst_binary_header}
|
||||
FHeaderEnterCount : Integer;
|
||||
{$ENDIF}
|
||||
@ -278,6 +279,7 @@ type
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetFormatName() : string;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure Clear();
|
||||
|
||||
@ -318,16 +320,28 @@ type
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);
|
||||
);overload;
|
||||
procedure Put(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
procedure Get(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Var AName : String;
|
||||
Var AData
|
||||
);
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -361,7 +375,9 @@ type
|
||||
procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
imp_utils;
|
||||
|
||||
{$INCLUDE wst_rtl_imp.inc}
|
||||
|
||||
procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc);
|
||||
@ -1253,6 +1269,16 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TBaseBinaryFormatter.Put(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
begin
|
||||
Put(AName,ATypeInfo,AData);
|
||||
end;
|
||||
|
||||
procedure TBaseBinaryFormatter.PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
@ -1482,6 +1508,16 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TBaseBinaryFormatter.Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);
|
||||
begin
|
||||
Get(ATypeInfo,AName,AData);
|
||||
end;
|
||||
|
||||
procedure TBaseBinaryFormatter.GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -1627,6 +1663,13 @@ begin
|
||||
Result := sBINARY_FORMAT_NAME;
|
||||
end;
|
||||
|
||||
function TBaseBinaryFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TBaseBinaryFormatter.WriteBuffer(const AValue: string);
|
||||
var
|
||||
locStore : IDataStoreReader;
|
||||
|
||||
@ -180,6 +180,7 @@ type
|
||||
|
||||
TJsonRpcBaseFormatter = class(TSimpleFactoryItem,IFormatterBase)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FRootData : TJSONData;
|
||||
FSerializationStyle : TSerializationStyle;
|
||||
FStack : TObjectStack;
|
||||
@ -276,6 +277,7 @@ type
|
||||
procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
|
||||
function GetSerializationStyle():TSerializationStyle;
|
||||
function GetFormatName() : string;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure Clear();
|
||||
|
||||
procedure BeginObject(
|
||||
@ -314,16 +316,28 @@ type
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);
|
||||
);overload;
|
||||
procedure Put(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
procedure Get(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Var AName : String;
|
||||
Var AData
|
||||
);
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -344,7 +358,7 @@ type
|
||||
|
||||
|
||||
implementation
|
||||
uses jsonparser;
|
||||
uses jsonparser, imp_utils;
|
||||
|
||||
|
||||
{ TJsonRpcBaseFormatter }
|
||||
@ -556,6 +570,13 @@ begin
|
||||
Result := s_json;
|
||||
end;
|
||||
|
||||
function TJsonRpcBaseFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
function TJsonRpcBaseFormatter.GetCurrentScope : string;
|
||||
begin
|
||||
CheckScope();
|
||||
@ -785,6 +806,16 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TJsonRpcBaseFormatter.Put(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
begin
|
||||
Put(AName,ATypeInfo,AData);
|
||||
end;
|
||||
|
||||
procedure TJsonRpcBaseFormatter.PutScopeInnerValue(const ATypeInfo : PTypeInfo; const AData);
|
||||
var
|
||||
locName : string;
|
||||
@ -951,6 +982,16 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TJsonRpcBaseFormatter.Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);
|
||||
begin
|
||||
Get(ATypeInfo,AName,AData);
|
||||
end;
|
||||
|
||||
procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var AData);
|
||||
var
|
||||
locName : string;
|
||||
|
||||
@ -132,6 +132,7 @@ type
|
||||
|
||||
IFormatterBase = Interface
|
||||
['{2AB3BF54-B7D6-4C46-8245-133C8775E9C1}']
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
function GetFormatName() : string;
|
||||
procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
|
||||
function GetSerializationStyle():TSerializationStyle;
|
||||
@ -174,16 +175,28 @@ type
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);
|
||||
);overload;
|
||||
procedure Put(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
procedure Get(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Var AName : String;
|
||||
Var AData
|
||||
);
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -294,6 +307,10 @@ type
|
||||
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
|
||||
procedure LoadFromStream(AStream : TStream);
|
||||
procedure LoadFromFile(const AFileName : string);
|
||||
procedure SaveToStream(AStream : TStream);
|
||||
procedure SaveToFile(const AFileName : string);
|
||||
property BinaryData : TBinaryString read FBinaryData write FBinaryData;
|
||||
property EncodedString : string read GetEncodedString write SetEncodedString;
|
||||
end;
|
||||
@ -621,7 +638,7 @@ type
|
||||
private
|
||||
FBinaryData : TBinaryString;
|
||||
private
|
||||
function GetEncodedString() : string;
|
||||
function GetEncodedString : string;
|
||||
procedure SetEncodedString(const AValue : string);
|
||||
protected
|
||||
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
|
||||
@ -629,6 +646,10 @@ type
|
||||
public
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
|
||||
procedure LoadFromStream(AStream : TStream);
|
||||
procedure LoadFromFile(const AFileName : string);
|
||||
procedure SaveToStream(AStream : TStream);
|
||||
procedure SaveToFile(const AFileName : string);
|
||||
property BinaryData : TBinaryString read FBinaryData write FBinaryData;
|
||||
property EncodedString : string read GetEncodedString write SetEncodedString;
|
||||
end;
|
||||
@ -1277,11 +1298,31 @@ type
|
||||
|
||||
TTypeRegistryItemOption = ( trioNonVisibleToMetadataService );
|
||||
TTypeRegistryItemOptions = set of TTypeRegistryItemOption;
|
||||
TTypeRegistry = class;
|
||||
TTypeRegistryItem = class;
|
||||
TTypeRegistryItemClass = class of TTypeRegistryItem;
|
||||
|
||||
TRemotableTypeInitializerClass = class of TRemotableTypeInitializer;
|
||||
|
||||
{ TRemotableTypeInitializer }
|
||||
|
||||
TRemotableTypeInitializer = class
|
||||
public
|
||||
class function CanHandle(ATypeInfo : PTypeInfo) : Boolean;virtual;
|
||||
class function GetItemClass(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;virtual;
|
||||
{$IFDEF TRemotableTypeInitializer_Initialize}
|
||||
class function Initialize(
|
||||
ATypeInfo : PTypeInfo;
|
||||
ARegistryItem : TTypeRegistryItem
|
||||
) : Boolean;virtual;abstract;
|
||||
{$ENDIF TRemotableTypeInitializer_Initialize}
|
||||
end;
|
||||
|
||||
{ TTypeRegistryItem }
|
||||
|
||||
TTypeRegistryItem = class
|
||||
private
|
||||
FOwner : TTypeRegistry;
|
||||
FDataType: PTypeInfo;
|
||||
FNameSpace: string;
|
||||
FDeclaredName : string;
|
||||
@ -1293,10 +1334,11 @@ type
|
||||
procedure CreateInternalObjects();{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
public
|
||||
constructor Create(
|
||||
AOwner : TTypeRegistry;
|
||||
ANameSpace : string;
|
||||
ADataType : PTypeInfo;
|
||||
Const ADeclaredName : string = ''
|
||||
);
|
||||
);virtual;
|
||||
destructor Destroy();override;
|
||||
function AddPascalSynonym(const ASynonym : string):TTypeRegistryItem;
|
||||
function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
@ -1308,6 +1350,7 @@ type
|
||||
procedure RegisterObject(const APropName : string; const AObject : TObject);
|
||||
function GetObject(const APropName : string) : TObject;
|
||||
|
||||
property Owner : TTypeRegistry read FOwner;
|
||||
property DataType : PTypeInfo read FDataType;
|
||||
property NameSpace : string read FNameSpace;
|
||||
property DeclaredName : string read FDeclaredName;
|
||||
@ -1317,14 +1360,21 @@ type
|
||||
{ TTypeRegistry }
|
||||
|
||||
TTypeRegistry = class
|
||||
Private
|
||||
private
|
||||
FList : TObjectList;
|
||||
FInitializerList : TClassList;
|
||||
private
|
||||
function GetItemClassFor(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;
|
||||
{$IFDEF TRemotableTypeInitializer_Initialize}
|
||||
procedure InitializeItem(AItem : TTypeRegistryItem);
|
||||
{$ENDIF TRemotableTypeInitializer_Initialize}
|
||||
function GetCount: Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetItemByIndex(Index: Integer): TTypeRegistryItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetItemByTypeInfo(Index: PTypeInfo): TTypeRegistryItem;
|
||||
Public
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy();override;
|
||||
procedure RegisterInitializer(AInitializer : TRemotableTypeInitializerClass);
|
||||
function IndexOf(Const ATypeInfo : PTypeInfo):Integer;
|
||||
function Add(AItem:TTypeRegistryItem):Integer;
|
||||
function Register(
|
||||
@ -1338,7 +1388,7 @@ type
|
||||
Property Count : Integer Read GetCount;
|
||||
Property Item[Index:Integer] : TTypeRegistryItem Read GetItemByIndex;default;
|
||||
Property ItemByTypeInfo[Index:PTypeInfo] : TTypeRegistryItem Read GetItemByTypeInfo;
|
||||
End;
|
||||
end;
|
||||
|
||||
TPropStoreType = ( pstNever, pstOptional, pstAlways );
|
||||
|
||||
@ -1398,7 +1448,8 @@ var
|
||||
{$ENDIF HAS_FORMAT_SETTINGS}
|
||||
|
||||
implementation
|
||||
uses imp_utils, record_rtti, basex_encode;
|
||||
uses
|
||||
imp_utils, record_rtti, basex_encode, object_serializer;
|
||||
|
||||
|
||||
type
|
||||
@ -1730,8 +1781,10 @@ begin
|
||||
Result := FList[i] as TSerializeOptions;
|
||||
for j := 0 to Pred(c) do begin
|
||||
ri := FList[j] as TSerializeOptions;
|
||||
for k := 0 to Pred(ri.AttributeFieldCount) do begin
|
||||
Result.FAttributeFieldList.Add(ri.FAttributeFieldList[k]);
|
||||
if AElementClass.InheritsFrom(ri.ElementClass) then begin
|
||||
for k := 0 to Pred(ri.AttributeFieldCount) do begin
|
||||
Result.FAttributeFieldList.Add(ri.FAttributeFieldList[k]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1792,6 +1845,17 @@ class procedure TBaseComplexRemotable.Save(
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo
|
||||
);
|
||||
{$IFDEF USE_SERIALIZE}
|
||||
var
|
||||
locSerializer : TObjectSerializer;
|
||||
begin
|
||||
locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer();
|
||||
if ( locSerializer <> nil ) then
|
||||
locSerializer.Save(AObject,AStore,AName,ATypeInfo)
|
||||
else
|
||||
raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name])
|
||||
end;
|
||||
{$ELSE USE_SERIALIZE}
|
||||
Var
|
||||
propList : PPropList;
|
||||
i, propCount, propListLen : Integer;
|
||||
@ -1949,6 +2013,7 @@ begin
|
||||
AStore.SetSerializationStyle(oldSS);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF USE_SERIALIZE}
|
||||
|
||||
Type
|
||||
TFloatExtendedType = Extended;
|
||||
@ -1958,6 +2023,17 @@ class procedure TBaseComplexRemotable.Load(
|
||||
var AName : String;
|
||||
const ATypeInfo : PTypeInfo
|
||||
);
|
||||
{$IFDEF USE_SERIALIZE}
|
||||
var
|
||||
locSerializer : TObjectSerializer;
|
||||
begin
|
||||
locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer();
|
||||
if ( locSerializer <> nil ) then
|
||||
locSerializer.Read(AObject,AStore,AName,ATypeInfo)
|
||||
else
|
||||
raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name])
|
||||
end;
|
||||
{$ELSE USE_SERIALIZE}
|
||||
Var
|
||||
propList : PPropList;
|
||||
i, propCount, propListLen : Integer;
|
||||
@ -2134,6 +2210,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF USE_SERIALIZE}
|
||||
|
||||
{ TBaseObjectArrayRemotable }
|
||||
|
||||
@ -2633,11 +2710,13 @@ begin
|
||||
end;
|
||||
|
||||
constructor TTypeRegistryItem.Create(
|
||||
AOwner : TTypeRegistry;
|
||||
ANameSpace : String;
|
||||
ADataType : PTypeInfo;
|
||||
Const ADeclaredName : String
|
||||
);
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
FNameSpace := ANameSpace;
|
||||
FDataType := ADataType;
|
||||
FDeclaredName := Trim(ADeclaredName);
|
||||
@ -2646,10 +2725,26 @@ begin
|
||||
end;
|
||||
|
||||
destructor TTypeRegistryItem.Destroy();
|
||||
|
||||
procedure FreeObjects();
|
||||
var
|
||||
j, k : PtrInt;
|
||||
obj : TObject;
|
||||
begin
|
||||
j := FExternalNames.Count;
|
||||
for k := 0 to Pred(j) do begin
|
||||
obj := FExternalNames.Objects[k];
|
||||
if ( obj <> nil ) then
|
||||
obj.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
FreeAndNil(FInternalNames);
|
||||
FreeAndNil(FExternalNames);
|
||||
FreeAndNil(FSynonymTable);
|
||||
if ( FExternalNames <> nil ) and ( FExternalNames.Count > 0 ) then
|
||||
FreeObjects();
|
||||
FInternalNames.Free();
|
||||
FExternalNames.Free();
|
||||
FSynonymTable.Free();
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
@ -2728,6 +2823,41 @@ end;
|
||||
|
||||
{ TTypeRegistry }
|
||||
|
||||
function TTypeRegistry.GetItemClassFor(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;
|
||||
var
|
||||
i, c : PtrInt;
|
||||
locInitializer : TRemotableTypeInitializerClass;
|
||||
begin
|
||||
Result := TTypeRegistryItem;
|
||||
c := FInitializerList.Count;
|
||||
if ( c > 0 ) then begin
|
||||
for i := Pred(c) downto 0 do begin
|
||||
locInitializer := TRemotableTypeInitializerClass(FInitializerList[i]);
|
||||
if locInitializer.CanHandle(ATypeInfo) then begin
|
||||
Result := locInitializer.GetItemClass(ATypeInfo);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF TRemotableTypeInitializer_Initialize}
|
||||
procedure TTypeRegistry.InitializeItem(AItem : TTypeRegistryItem);
|
||||
var
|
||||
i, c : PtrInt;
|
||||
locInitializer : TRemotableTypeInitializerClass;
|
||||
begin
|
||||
c := FInitializerList.Count;
|
||||
if ( c > 0 ) then begin
|
||||
for i := Pred(c) downto 0 do begin
|
||||
locInitializer := TRemotableTypeInitializerClass(FInitializerList[i]);
|
||||
if locInitializer.CanHandle(AItem.DataType) and locInitializer.Initialize(AItem.DataType,AItem) then
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF TRemotableTypeInitializer_Initialize}
|
||||
|
||||
function TTypeRegistry.GetCount: Integer;
|
||||
begin
|
||||
Result := FList.Count;
|
||||
@ -2754,14 +2884,22 @@ constructor TTypeRegistry.Create();
|
||||
begin
|
||||
Inherited Create();
|
||||
FList := TObjectList.Create(True);
|
||||
FInitializerList := TClassList.Create();
|
||||
end;
|
||||
|
||||
destructor TTypeRegistry.Destroy();
|
||||
begin
|
||||
FreeAndNil(FList);
|
||||
FInitializerList.Free();
|
||||
FList.Free();
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
procedure TTypeRegistry.RegisterInitializer(AInitializer : TRemotableTypeInitializerClass);
|
||||
begin
|
||||
if ( FInitializerList.IndexOf(AInitializer) = -1 ) then
|
||||
FInitializerList.Add(AInitializer);
|
||||
end;
|
||||
|
||||
function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer;
|
||||
begin
|
||||
For Result := 0 To Pred(Count) Do Begin
|
||||
@ -2791,9 +2929,15 @@ var
|
||||
i : Integer;
|
||||
begin
|
||||
i := IndexOf(ADataType);
|
||||
if ( i = -1 ) then
|
||||
i := Add(TTypeRegistryItem.Create(ANameSpace,ADataType,ADeclaredName));
|
||||
Result := Item[i];
|
||||
if ( i = -1 ) then begin
|
||||
Result := GetItemClassFor(ADataType).Create(Self,ANameSpace,ADataType,ADeclaredName);
|
||||
i := Add(Result);
|
||||
{$IFDEF TRemotableTypeInitializer_Initialize}
|
||||
InitializeItem(Result);
|
||||
{$ENDIF TRemotableTypeInitializer_Initialize}
|
||||
end else begin
|
||||
Result := Item[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTypeRegistry.Find(ATypeInfo : PTypeInfo; Const AExact : Boolean):TTypeRegistryItem;
|
||||
@ -4274,13 +4418,15 @@ class function TAbstractComplexRemotable.IsAttributeProperty(const AProperty: sh
|
||||
var
|
||||
ri : TSerializeOptions;
|
||||
pc : TClass;
|
||||
sor : TSerializeOptionsRegistry;
|
||||
begin
|
||||
Result := False;
|
||||
if ( Self = TBaseComplexRemotable ) then
|
||||
Exit;
|
||||
sor := GetSerializeOptionsRegistry();
|
||||
pc := Self;
|
||||
while Assigned(pc) and pc.InheritsFrom(TBaseComplexRemotable) do begin
|
||||
ri := GetSerializeOptionsRegistry().Find(TBaseComplexRemotableClass(pc));
|
||||
ri := sor.Find(TBaseComplexRemotableClass(pc));
|
||||
if Assigned(ri) then begin
|
||||
Result := ri.IsAttributeField(AProperty);
|
||||
Exit;
|
||||
@ -5615,7 +5761,7 @@ end;
|
||||
|
||||
{ TBase64StringRemotable }
|
||||
|
||||
function TBase64StringRemotable.GetEncodedString() : string;
|
||||
function TBase64StringRemotable.GetEncodedString : string;
|
||||
begin
|
||||
Result := Base64Encode(BinaryData);
|
||||
end;
|
||||
@ -5676,9 +5822,37 @@ begin
|
||||
( TBase64StringRemotable(ACompareTo).BinaryData = Self.BinaryData );
|
||||
end;
|
||||
|
||||
procedure TBase64StringRemotable.LoadFromStream(AStream : TStream);
|
||||
begin
|
||||
BinaryData := LoadBufferFromStream(AStream);
|
||||
end;
|
||||
|
||||
procedure TBase64StringRemotable.LoadFromFile(const AFileName : string);
|
||||
begin
|
||||
BinaryData := LoadBufferFromFile(AFileName);
|
||||
end;
|
||||
|
||||
procedure TBase64StringRemotable.SaveToStream(AStream : TStream);
|
||||
begin
|
||||
if ( Length(FBinaryData) > 0 ) then
|
||||
AStream.Write(FBinaryData[1],Length(FBinaryData));
|
||||
end;
|
||||
|
||||
procedure TBase64StringRemotable.SaveToFile(const AFileName : string);
|
||||
var
|
||||
locStream : TFileStream;
|
||||
begin
|
||||
locStream := TFileStream.Create(AFileName,fmCreate);
|
||||
try
|
||||
SaveToStream(locStream);
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TBase64StringExtRemotable }
|
||||
|
||||
function TBase64StringExtRemotable.GetEncodedString() : string;
|
||||
function TBase64StringExtRemotable.GetEncodedString : string;
|
||||
begin
|
||||
Result := Base64Encode(BinaryData);
|
||||
end;
|
||||
@ -5712,6 +5886,34 @@ begin
|
||||
( TBase64StringExtRemotable(ACompareTo).BinaryData = Self.BinaryData );
|
||||
end;
|
||||
|
||||
procedure TBase64StringExtRemotable.LoadFromStream(AStream : TStream);
|
||||
begin
|
||||
BinaryData := LoadBufferFromStream(AStream);
|
||||
end;
|
||||
|
||||
procedure TBase64StringExtRemotable.LoadFromFile(const AFileName : string);
|
||||
begin
|
||||
BinaryData := LoadBufferFromFile(AFileName);
|
||||
end;
|
||||
|
||||
procedure TBase64StringExtRemotable.SaveToStream(AStream : TStream);
|
||||
begin
|
||||
if ( Length(FBinaryData) > 0 ) then
|
||||
AStream.Write(FBinaryData[1],Length(FBinaryData));
|
||||
end;
|
||||
|
||||
procedure TBase64StringExtRemotable.SaveToFile(const AFileName : string);
|
||||
var
|
||||
locStream : TFileStream;
|
||||
begin
|
||||
locStream := TFileStream.Create(AFileName,fmCreate);
|
||||
try
|
||||
SaveToStream(locStream);
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBase64StringExtRemotable.Assign(Source: TPersistent);
|
||||
begin
|
||||
if Assigned(Source) and Source.InheritsFrom(TBase64StringExtRemotable) then begin
|
||||
@ -5732,8 +5934,10 @@ begin
|
||||
{$ENDIF}
|
||||
{$ENDIF HAS_FORMAT_SETTINGS}
|
||||
|
||||
if ( TypeRegistryInstance = nil ) then
|
||||
if ( TypeRegistryInstance = nil ) then begin
|
||||
TypeRegistryInstance := TTypeRegistry.Create();
|
||||
TypeRegistryInstance.RegisterInitializer(TBaseComplexRemotableInitializer);
|
||||
end;
|
||||
if ( SerializeOptionsRegistryInstance = nil ) then
|
||||
SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create();
|
||||
RegisterStdTypes();
|
||||
@ -5963,6 +6167,19 @@ begin
|
||||
Result := '-' + Result;
|
||||
end;
|
||||
|
||||
{ TRemotableTypeInitializer }
|
||||
|
||||
class function TRemotableTypeInitializer.CanHandle(ATypeInfo : PTypeInfo) : Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
class function TRemotableTypeInitializer.GetItemClass(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;
|
||||
begin
|
||||
Result := TTypeRegistryItem;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
initialize_base_service_intf();
|
||||
|
||||
|
||||
@ -128,6 +128,7 @@ type
|
||||
|
||||
TSOAPBaseFormatter = class(TSimpleFactoryItem,IFormatterBase)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FContentType: string;
|
||||
FEncodingStyle: TSOAPEncodingStyle;
|
||||
FStyle: TSOAPDocumentStyle;
|
||||
@ -148,31 +149,37 @@ type
|
||||
|
||||
procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function InternalPutData(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : string
|
||||
):TDOMNode;
|
||||
function PutEnum(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : TEnumIntType
|
||||
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function PutBool(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : Boolean
|
||||
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function PutInt64(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : Int64
|
||||
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function PutStr(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : String
|
||||
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function PutFloat(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData : Extended
|
||||
@ -188,36 +195,42 @@ type
|
||||
const AData : Pointer
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
||||
function GetNodeValue(var AName : String):DOMString;
|
||||
function GetNodeValue(const ANameSpace : string; var AName : String):DOMString;
|
||||
procedure GetEnum(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : TEnumIntType
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
procedure GetBool(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : Boolean
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
{$IFDEF FPC}
|
||||
procedure GetInt(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : Integer
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
{$ENDIF}
|
||||
procedure GetInt64(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : Int64
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
procedure GetFloat(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : Extended
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
procedure GetStr(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
Var AName : String;
|
||||
Var AData : String
|
||||
);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
@ -289,6 +302,7 @@ type
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetFormatName() : string;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure Clear();
|
||||
|
||||
procedure BeginObject(
|
||||
@ -324,10 +338,16 @@ type
|
||||
procedure EndHeader();
|
||||
|
||||
procedure Put(
|
||||
const AName : string;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure Put(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
@ -336,7 +356,13 @@ type
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);
|
||||
);overload;
|
||||
procedure Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -686,6 +712,7 @@ begin
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.InternalPutData(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData : string
|
||||
@ -696,9 +723,17 @@ Var
|
||||
begin
|
||||
strNodeName := AName;
|
||||
if ( Style = Document ) then begin
|
||||
namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt);
|
||||
if not IsStrEmpty(namespaceShortName) then begin
|
||||
s := ExtractNameSpaceShortName(namespaceShortName);
|
||||
if ( ANameSpace = '' ) then
|
||||
namespaceLongName := StackTop().NameSpace
|
||||
else
|
||||
namespaceLongName := ANameSpace;
|
||||
s := FindAttributeByValueInScope(namespaceLongName);
|
||||
if IsStrEmpty(s) then begin
|
||||
namespaceShortName := 'ns' + IntToStr(NextNameSpaceCounter());
|
||||
AddScopeAttribute('xmlns:'+namespaceShortName, namespaceLongName);
|
||||
strNodeName := s + ':' + strNodeName;
|
||||
end else begin
|
||||
s := ExtractNameSpaceShortName(s);
|
||||
if not IsStrEmpty(s) then
|
||||
strNodeName := s + ':' + strNodeName;
|
||||
end;
|
||||
@ -734,12 +769,14 @@ begin
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.PutEnum(
|
||||
const ANameSpace : string;
|
||||
const AName: String;
|
||||
const ATypeInfo: PTypeInfo;
|
||||
const AData: TEnumIntType
|
||||
): TDOMNode;
|
||||
begin
|
||||
Result := InternalPutData(
|
||||
ANameSpace,
|
||||
AName,
|
||||
ATypeInfo,
|
||||
GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,AData))
|
||||
@ -747,30 +784,33 @@ begin
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.PutBool(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData : Boolean
|
||||
): TDOMNode;
|
||||
begin
|
||||
Result := InternalPutData(AName,ATypeInfo,BoolToSoapBool(AData));
|
||||
Result := InternalPutData(ANameSpace,AName,ATypeInfo,BoolToSoapBool(AData));
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.PutInt64(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData : Int64
|
||||
): TDOMNode;
|
||||
begin
|
||||
Result := InternalPutData(AName,ATypeInfo,IntToStr(AData));
|
||||
Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData));
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.PutStr(
|
||||
const ANameSpace : string;
|
||||
const AName: String;
|
||||
const ATypeInfo: PTypeInfo;
|
||||
const AData: String
|
||||
):TDOMNode;
|
||||
begin
|
||||
Result := InternalPutData(AName,ATypeInfo,AData);
|
||||
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.PutObj(
|
||||
@ -792,6 +832,7 @@ begin
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.PutFloat(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData : Extended
|
||||
@ -819,17 +860,21 @@ begin
|
||||
if ( i > 0 ) then
|
||||
s[i] := '.';
|
||||
{$ENDIF HAS_FORMAT_SETTINGS}
|
||||
Result := InternalPutData(AName,ATypeInfo,s);
|
||||
Result := InternalPutData(ANameSpace,AName,ATypeInfo,s);
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.GetNodeValue(var AName: String): DOMString;
|
||||
Var
|
||||
function TSOAPBaseFormatter.GetNodeValue(const ANameSpace : string; var AName: String): DOMString;
|
||||
var
|
||||
locElt : TDOMNode;
|
||||
namespaceShortName, strNodeName, s : string;
|
||||
begin
|
||||
strNodeName := AName;
|
||||
if ( Style = Document ) then begin
|
||||
namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt);
|
||||
if ( ANameSpace = '' ) then
|
||||
s := StackTop().NameSpace
|
||||
else
|
||||
s := ANameSpace;
|
||||
namespaceShortName := FindAttributeByValueInScope(s);
|
||||
if not IsStrEmpty(namespaceShortName) then begin
|
||||
s := ExtractNameSpaceShortName(namespaceShortName);
|
||||
if not IsStrEmpty(s) then
|
||||
@ -855,13 +900,14 @@ end;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetEnum(
|
||||
const ATypeInfo: PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName: String;
|
||||
var AData: TEnumIntType
|
||||
);
|
||||
Var
|
||||
locBuffer : String;
|
||||
begin
|
||||
locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName));
|
||||
locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(ANameSpace,AName));
|
||||
If IsStrEmpty(locBuffer) Then
|
||||
AData := 0
|
||||
Else
|
||||
@ -870,13 +916,14 @@ End;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetBool(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : String;
|
||||
var AData : Boolean
|
||||
);
|
||||
Var
|
||||
locBuffer : String;
|
||||
begin
|
||||
locBuffer := LowerCase(Trim(GetNodeValue(AName)));
|
||||
locBuffer := LowerCase(Trim(GetNodeValue(ANameSpace,AName)));
|
||||
If IsStrEmpty(locBuffer) Then
|
||||
AData := False
|
||||
Else
|
||||
@ -886,43 +933,47 @@ end;
|
||||
{$IFDEF FPC}
|
||||
procedure TSOAPBaseFormatter.GetInt(
|
||||
const ATypeInfo: PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName: String;
|
||||
var AData: Integer
|
||||
);
|
||||
begin
|
||||
AData := StrToIntDef(Trim(GetNodeValue(AName)),0);
|
||||
AData := StrToIntDef(Trim(GetNodeValue(ANameSpace,AName)),0);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TSOAPBaseFormatter.GetInt64(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : String;
|
||||
var AData : Int64
|
||||
);
|
||||
begin
|
||||
AData := StrToInt64Def(Trim(GetNodeValue(AName)),0);
|
||||
AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0);
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetFloat(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : String;
|
||||
var AData : Extended
|
||||
);
|
||||
begin
|
||||
{$IFDEF HAS_FORMAT_SETTINGS}
|
||||
AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings);
|
||||
AData := StrToFloatDef(Trim(GetNodeValue(ANameSpace,AName)),0,wst_FormatSettings);
|
||||
{$ELSE}
|
||||
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0);
|
||||
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(ANameSpace:=;,AName))),0);
|
||||
{$ENDIF HAS_FORMAT_SETTINGS}
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetStr(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : String;
|
||||
var AData : String
|
||||
);
|
||||
begin
|
||||
AData := GetNodeValue(AName);
|
||||
AData := GetNodeValue(ANameSpace,AName);
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetObj(
|
||||
@ -1319,7 +1370,8 @@ function TSOAPBaseFormatter.ReadHeaders(ACallContext: ICallContext): Integer;
|
||||
s := sXML_NS
|
||||
else
|
||||
s := sXML_NS + ':' + nsSN;
|
||||
nsLN := FindAttributeByNameInScope(s);
|
||||
if not FindAttributeByNameInNode(s,ANode,nsLN) then
|
||||
nsLN := FindAttributeByNameInScope(s);
|
||||
Result := GetTypeRegistry().FindByDeclaredName(Copy(ndName,Succ(j),MaxInt),nsLN);
|
||||
end;
|
||||
|
||||
@ -1402,6 +1454,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.Put(
|
||||
const ANameSpace : string;
|
||||
const AName: String;
|
||||
const ATypeInfo: PTypeInfo;
|
||||
const AData
|
||||
@ -1418,12 +1471,12 @@ begin
|
||||
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
|
||||
Begin
|
||||
int64Data := Int64(AData);
|
||||
PutInt64(AName,ATypeInfo,int64Data);
|
||||
PutInt64(ANameSpace,AName,ATypeInfo,int64Data);
|
||||
End;
|
||||
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
||||
Begin
|
||||
strData := String(AData);
|
||||
PutStr(AName,ATypeInfo,strData);
|
||||
PutStr(ANameSpace,AName,ATypeInfo,strData);
|
||||
End;
|
||||
tkClass :
|
||||
Begin
|
||||
@ -1438,7 +1491,7 @@ begin
|
||||
tkBool :
|
||||
Begin
|
||||
boolData := Boolean(AData);
|
||||
PutBool(AName,ATypeInfo,boolData);
|
||||
PutBool(ANameSpace,AName,ATypeInfo,boolData);
|
||||
End;
|
||||
{$ENDIF}
|
||||
tkInteger, tkEnumeration :
|
||||
@ -1448,7 +1501,7 @@ begin
|
||||
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
|
||||
then begin
|
||||
boolData := Boolean(AData);
|
||||
PutBool(AName,ATypeInfo,boolData);
|
||||
PutBool(ANameSpace,AName,ATypeInfo,boolData);
|
||||
end else begin
|
||||
{$ENDIF}
|
||||
enumData := 0;
|
||||
@ -1461,9 +1514,9 @@ begin
|
||||
otULong : enumData := LongInt(AData);
|
||||
End;
|
||||
If ( ATypeInfo^.Kind = tkInteger ) Then
|
||||
PutInt64(AName,ATypeInfo,enumData)
|
||||
PutInt64(ANameSpace,AName,ATypeInfo,enumData)
|
||||
Else
|
||||
PutEnum(AName,ATypeInfo,enumData);
|
||||
PutEnum(ANameSpace,AName,ATypeInfo,enumData);
|
||||
{$IFDEF WST_DELPHI}
|
||||
end;
|
||||
{$ENDIF}
|
||||
@ -1478,11 +1531,20 @@ begin
|
||||
ftCurr : floatDt := Currency(AData);
|
||||
ftComp : floatDt := Comp(AData);
|
||||
End;
|
||||
PutFloat(AName,ATypeInfo,floatDt);
|
||||
PutFloat(ANameSpace,AName,ATypeInfo,floatDt);
|
||||
End;
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.Put(
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
begin
|
||||
Put('',AName,ATypeInfo,AData);
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
@ -1610,6 +1672,7 @@ end;
|
||||
|
||||
procedure TSOAPBaseFormatter.Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : String;
|
||||
var AData
|
||||
);
|
||||
@ -1626,13 +1689,13 @@ begin
|
||||
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
|
||||
Begin
|
||||
int64Data := 0;
|
||||
GetInt64(ATypeInfo,AName,int64Data);
|
||||
GetInt64(ATypeInfo,ANameSpace,AName,int64Data);
|
||||
Int64(AData) := int64Data;
|
||||
End;
|
||||
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
|
||||
Begin
|
||||
strData := '';
|
||||
GetStr(ATypeInfo,AName,strData);
|
||||
GetStr(ATypeInfo,ANameSpace,AName,strData);
|
||||
String(AData) := strData;
|
||||
End;
|
||||
tkClass :
|
||||
@ -1650,7 +1713,7 @@ begin
|
||||
tkBool :
|
||||
Begin
|
||||
boolData := False;
|
||||
GetBool(ATypeInfo,AName,boolData);
|
||||
GetBool(ATypeInfo,ANameSpace,AName,boolData);
|
||||
Boolean(AData) := boolData;
|
||||
End;
|
||||
{$ENDIF}
|
||||
@ -1661,15 +1724,15 @@ begin
|
||||
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
|
||||
then begin
|
||||
boolData := False;
|
||||
GetBool(ATypeInfo,AName,boolData);
|
||||
GetBool(ATypeInfo,ANameSpace,AName,boolData);
|
||||
Boolean(AData) := boolData;
|
||||
end else begin
|
||||
{$ENDIF}
|
||||
enumData := 0;
|
||||
If ( ATypeInfo^.Kind = tkInteger ) Then
|
||||
GetInt64(ATypeInfo,AName,enumData)
|
||||
GetInt64(ATypeInfo,ANameSpace,AName,enumData)
|
||||
Else
|
||||
GetEnum(ATypeInfo,AName,enumData);
|
||||
GetEnum(ATypeInfo,ANameSpace,AName,enumData);
|
||||
Case GetTypeData(ATypeInfo)^.OrdType Of
|
||||
otSByte : ShortInt(AData) := enumData;
|
||||
otUByte : Byte(AData) := enumData;
|
||||
@ -1685,7 +1748,7 @@ begin
|
||||
tkFloat :
|
||||
Begin
|
||||
floatDt := 0;
|
||||
GetFloat(ATypeInfo,AName,floatDt);
|
||||
GetFloat(ATypeInfo,ANameSpace,AName,floatDt);
|
||||
Case GetTypeData(ATypeInfo)^.FloatType Of
|
||||
ftSingle : Single(AData) := floatDt;
|
||||
ftDouble : Double(AData) := floatDt;
|
||||
@ -1699,6 +1762,15 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);
|
||||
begin
|
||||
Get(ATypeInfo,'',AName,AData);
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -1829,6 +1901,13 @@ begin
|
||||
Result := sPROTOCOL_NAME;
|
||||
end;
|
||||
|
||||
function TSOAPBaseFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TSOAPBaseFormatter.WriteBuffer(const AValue: string);
|
||||
var
|
||||
strm : TStringStream;
|
||||
|
||||
@ -158,6 +158,7 @@ type
|
||||
|
||||
TXmlRpcBaseFormatter = class(TSimpleFactoryItem,IFormatterBase)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FContentType: string;
|
||||
FDoc : TXMLDocument;
|
||||
FStack : TObjectStack;
|
||||
@ -301,6 +302,7 @@ type
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetFormatName() : string;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure Clear();
|
||||
|
||||
procedure BeginObject(
|
||||
@ -339,16 +341,28 @@ type
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);
|
||||
);overload;
|
||||
procedure Put(
|
||||
const ANameSpace : string;
|
||||
Const AName : String;
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Const AData
|
||||
);overload;
|
||||
procedure PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
);
|
||||
procedure Get(
|
||||
Const ATypeInfo : PTypeInfo;
|
||||
Var AName : String;
|
||||
Var AData
|
||||
);
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);overload;
|
||||
procedure GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -1183,6 +1197,15 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TXmlRpcBaseFormatter.Put(
|
||||
const ANameSpace : string;
|
||||
const AName : String;
|
||||
const ATypeInfo : PTypeInfo; const AData
|
||||
);
|
||||
begin
|
||||
Put(AName,ATypeInfo,AData);
|
||||
end;
|
||||
|
||||
procedure TXmlRpcBaseFormatter.PutScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const AData
|
||||
@ -1374,6 +1397,16 @@ begin
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TXmlRpcBaseFormatter.Get(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
const ANameSpace : string;
|
||||
var AName : string;
|
||||
var AData
|
||||
);
|
||||
begin
|
||||
Get(ATypeInfo,AName,AData);
|
||||
end;
|
||||
|
||||
procedure TXmlRpcBaseFormatter.GetScopeInnerValue(
|
||||
const ATypeInfo : PTypeInfo;
|
||||
var AData
|
||||
@ -1493,6 +1526,13 @@ begin
|
||||
Result := sPROTOCOL_NAME;
|
||||
end;
|
||||
|
||||
function TXmlRpcBaseFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TXmlRpcBaseFormatter.WriteBuffer(const AValue: string);
|
||||
var
|
||||
strm : TStringStream;
|
||||
|
||||
@ -32,13 +32,10 @@ Type
|
||||
{$M+}
|
||||
TBinaryFormatter = class(TBaseBinaryFormatter,IFormatterClient)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FCallProcedureName : string;
|
||||
FCallTarget : String;
|
||||
protected
|
||||
public
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
@ -55,7 +52,7 @@ Type
|
||||
{ TBinaryCallMaker }
|
||||
|
||||
TBinaryCallMaker = class(TSimpleFactoryItem,ICallMaker)
|
||||
Private
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
Public
|
||||
constructor Create();override;
|
||||
@ -69,13 +66,6 @@ Type
|
||||
|
||||
implementation
|
||||
|
||||
function TBinaryFormatter.GetPropertyManager(): IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TBinaryFormatter.BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
|
||||
@ -17,7 +17,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, TypInfo,
|
||||
base_service_intf;
|
||||
wst_types, base_service_intf;
|
||||
|
||||
Type
|
||||
|
||||
@ -47,8 +47,11 @@ Type
|
||||
function ExtractOptionName(const ACompleteName : string):string;
|
||||
function TranslateDotToDecimalSeperator(const Value: string) : string;
|
||||
|
||||
function LoadBufferFromFile(const AFileName : string) : TBinaryString;
|
||||
function LoadBufferFromStream(AStream : TStream) : TBinaryString;
|
||||
|
||||
|
||||
implementation
|
||||
uses wst_types;
|
||||
|
||||
function IsStrEmpty(Const AStr:String):Boolean;
|
||||
begin
|
||||
@ -98,6 +101,35 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoadBufferFromStream(AStream : TStream) : TBinaryString;
|
||||
var
|
||||
len : Int64;
|
||||
begin
|
||||
len := AStream.Size;
|
||||
SetLength(Result,len);
|
||||
if ( len > 0 ) then begin
|
||||
try
|
||||
AStream.Seek(0,soBeginning);
|
||||
AStream.Read(Result[1],len);
|
||||
except
|
||||
SetLength(Result,0);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoadBufferFromFile(const AFileName : string) : TBinaryString;
|
||||
var
|
||||
locStream : TStream;
|
||||
begin
|
||||
locStream := TFileStream.Create(AFileName,fmOpenRead);
|
||||
try
|
||||
Result := LoadBufferFromStream(locStream);
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TPublishedPropertyManager }
|
||||
|
||||
procedure TPublishedPropertyManager.Error(const AMsg: string);
|
||||
|
||||
@ -28,7 +28,6 @@ type
|
||||
|
||||
TJsonRpcFormatter = class(TJsonRpcBaseFormatter,IFormatterClient)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FCallProcedureName : string;
|
||||
FCallTarget : string;
|
||||
FVersion : string;
|
||||
@ -37,7 +36,6 @@ type
|
||||
procedure SetVersion(const AValue : string);
|
||||
public
|
||||
constructor Create();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
const AProcName,
|
||||
@ -129,13 +127,6 @@ begin
|
||||
SetVersion(s_json_rpc_version_10);
|
||||
end;
|
||||
|
||||
function TJsonRpcFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TJsonRpcFormatter.BeginCall(
|
||||
const AProcName, ATarget : string;
|
||||
ACallContext : ICallContext
|
||||
|
||||
@ -91,14 +91,12 @@ const
|
||||
sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/';
|
||||
sSOAP_NS = 'http://schemas.xmlsoap.org/wsdl/soap/';
|
||||
sSOAP = 'soap';
|
||||
sSOAP_ENC_NS = 'http://schemas.xmlsoap.org/soap/encoding/';
|
||||
sXMLNS = 'xmlns';
|
||||
sXSD_NS = 'http://www.w3.org/2001/XMLSchema';
|
||||
sXSD = 'xsd';
|
||||
sTNS = 'tns';
|
||||
|
||||
sSOAP_ACTION = 'soapAction';
|
||||
sSOAP_ENCODED = 'encoded';
|
||||
sSOAP_ENCODING_STYLE = 'encodingStyle';
|
||||
sSOAP_RPC = 'rpc';
|
||||
sSOAP_TRANSPORT = 'http://schemas.xmlsoap.org/soap/http';
|
||||
@ -127,7 +125,6 @@ const
|
||||
sTRANSPORT = 'transport';
|
||||
sTYPE = 'type';
|
||||
sUNBOUNDED = 'unbounded';
|
||||
sUSE = 'use';
|
||||
sVALUE = 'value';
|
||||
|
||||
sWSDL_DEFINITIONS = 'definitions';
|
||||
|
||||
1229
wst/trunk/object_serializer.pas
Normal file
1229
wst/trunk/object_serializer.pas
Normal file
File diff suppressed because it is too large
Load Diff
@ -45,13 +45,13 @@ type
|
||||
public
|
||||
constructor Create(const AData : PRecordTypeData; const AFieldList : string);
|
||||
destructor Destroy();override;
|
||||
function GetRecordTypeData() : PRecordTypeData;
|
||||
function GetRecordTypeData() : PRecordTypeData;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function FindField(const AFieldName : shortstring) : PRecordFieldInfo;
|
||||
function GetField(const AFieldName : shortstring) : PRecordFieldInfo;
|
||||
end;
|
||||
|
||||
function MakeRecordTypeInfo(ARawTypeInfo : PTypeInfo) : PRecordTypeData;
|
||||
procedure FreeRecordTypeInfo(ATypeInfo : PRecordTypeData);
|
||||
procedure FreeRecordTypeInfo(ATypeInfo : PRecordTypeData);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
||||
{$IFDEF WST_RECORD_RTTI}
|
||||
function MakeRawTypeInfo(
|
||||
|
||||
@ -80,6 +80,8 @@ end;
|
||||
|
||||
procedure TSOAPFormatter.BeginCallResponse(Const AProcName,ATarget:string);
|
||||
begin
|
||||
if ( FCallContext = nil ) then
|
||||
FCallContext := TSimpleCallContext.Create();
|
||||
Clear();
|
||||
Prepare();
|
||||
WriteHeaders(FCallContext);
|
||||
@ -97,7 +99,7 @@ end;
|
||||
procedure TSOAPFormatter.BeginCallRead(ACallContext : ICallContext);
|
||||
Var
|
||||
envNd : TDOMElement;
|
||||
hdrNd, bdyNd, mthdNd, tmpNode : TDOMNode;
|
||||
hdrNd, bdyNd, mthdNd : TDOMNode;
|
||||
s,nsShortName,eltName : string;
|
||||
doc : TXMLDocument;
|
||||
begin
|
||||
|
||||
@ -38,8 +38,6 @@ Type
|
||||
//The client formater interface, used to marshall parameters.
|
||||
IFormatterClient = Interface(IFormatterBase)
|
||||
['{73746BC7-CA43-4C00-8789-71E23033C3B2}']
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
|
||||
@ -30,13 +30,9 @@ type
|
||||
{$M+}
|
||||
TSOAPFormatter = class(TSOAPBaseFormatter,IFormatterClient)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FCallProcedureName : string;
|
||||
FCallTarget : String;
|
||||
public
|
||||
destructor Destroy();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
@ -73,19 +69,6 @@ implementation
|
||||
|
||||
{ TSOAPFormatter }
|
||||
|
||||
destructor TSOAPFormatter.Destroy();
|
||||
begin
|
||||
FPropMngr := nil;
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
function TSOAPFormatter.GetPropertyManager(): IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TSOAPFormatter.BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
|
||||
@ -23,7 +23,9 @@ uses
|
||||
test_suite_utils in '..\test_suite_utils.pas',
|
||||
test_std_cursors in '..\test_std_cursors.pas',
|
||||
test_rtti_filter in '..\test_rtti_filter.pas',
|
||||
test_wst_cursors in '..\test_wst_cursors.pas';
|
||||
test_wst_cursors in '..\test_wst_cursors.pas',
|
||||
test_registry in '..\test_registry.pas',
|
||||
test_soap_specific in '..\test_soap_specific.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
<?xml version="1.0"?>
|
||||
<schema targetNamespace="class_properties_default" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="class_properties_default">
|
||||
<xsd:complexType name="TClassSampleType">
|
||||
<xsd:sequence>
|
||||
|
||||
@ -0,0 +1,42 @@
|
||||
<?xml version="1.0"?>
|
||||
<SOAP-ENV:Envelope xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
|
||||
<SOAP-ENV:Body>
|
||||
<ns1:SampleProcResponse xmlns:ns1="SampleService" xmlns:ns2="NameSpace.A" xmlns:ns3="NameSpace.B" xmlns:ns4="NameSpace.C">
|
||||
<ns2:a>
|
||||
<ns2:Qualified_Val_Bool>true</ns2:Qualified_Val_Bool>
|
||||
<ns2:Qualified_Val_Enum>steTwo</ns2:Qualified_Val_Enum>
|
||||
<ns2:Qualified_Val_Integer>1210</ns2:Qualified_Val_Integer>
|
||||
<ns2:Qualified_Val_Int64>123456</ns2:Qualified_Val_Int64>
|
||||
<ns2:Qualified_Val_String>sample string.</ns2:Qualified_Val_String>
|
||||
</ns2:a>
|
||||
<ns3:b>
|
||||
<ns2:Qualified_Val_Bool>true</ns2:Qualified_Val_Bool>
|
||||
<ns2:Qualified_Val_Enum>steThree</ns2:Qualified_Val_Enum>
|
||||
<ns2:Qualified_Val_Integer>456</ns2:Qualified_Val_Integer>
|
||||
<ns2:Qualified_Val_Int64>78945</ns2:Qualified_Val_Int64>
|
||||
<ns2:Qualified_Val_String>Sample string inherited from TNameSpaceA_Class.</ns2:Qualified_Val_String>
|
||||
<ns3:Val_Bool>true</ns3:Val_Bool>
|
||||
<ns3:Val_String>WST sample string, local to NameSpace.B</ns3:Val_String>
|
||||
</ns3:b>
|
||||
<ns4:c>
|
||||
<ns4:Prop_String>This property should be in : NameSpace.C</ns4:Prop_String>
|
||||
<ns2:Prop_A>
|
||||
<ns2:Qualified_Val_Bool>false</ns2:Qualified_Val_Bool>
|
||||
<ns2:Qualified_Val_Enum>steOne</ns2:Qualified_Val_Enum>
|
||||
<ns2:Qualified_Val_Integer>0</ns2:Qualified_Val_Integer>
|
||||
<ns2:Qualified_Val_Int64>0</ns2:Qualified_Val_Int64>
|
||||
<ns2:Qualified_Val_String>This property should be in : NameSpace.A</ns2:Qualified_Val_String>
|
||||
</ns2:Prop_A>
|
||||
<ns3:Prop_B>
|
||||
<ns2:Qualified_Val_Bool>false</ns2:Qualified_Val_Bool>
|
||||
<ns2:Qualified_Val_Enum>steFour</ns2:Qualified_Val_Enum>
|
||||
<ns2:Qualified_Val_Integer>789</ns2:Qualified_Val_Integer>
|
||||
<ns2:Qualified_Val_Int64>64</ns2:Qualified_Val_Int64>
|
||||
<ns2:Qualified_Val_String>This inherited property should be in : NameSpace.A</ns2:Qualified_Val_String>
|
||||
<ns3:Val_Bool>true</ns3:Val_Bool>
|
||||
<ns3:Val_String>local elemet. This property should be in : NameSpace.B</ns3:Val_String>
|
||||
</ns3:Prop_B>
|
||||
</ns4:c>
|
||||
</ns1:SampleProcResponse>
|
||||
</SOAP-ENV:Body>
|
||||
</SOAP-ENV:Envelope>
|
||||
@ -105,7 +105,7 @@ begin
|
||||
g.Execute(tr,mdl.Name);
|
||||
WriteXMLFile(locDoc,'.\class_properties_default.xsd');
|
||||
locExistDoc := LoadXmlFromFilesList('class_properties_default.xsd');
|
||||
Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.');
|
||||
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
|
||||
finally
|
||||
ReleaseDomNode(locExistDoc);
|
||||
ReleaseDomNode(locDoc);
|
||||
@ -246,7 +246,7 @@ begin
|
||||
g.Execute(tr,mdl.Name);
|
||||
WriteXMLFile(locDoc,'.\class_extent_native_type.xsd');
|
||||
locExistDoc := LoadXmlFromFilesList('class_extent_native_type.xsd');
|
||||
Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.');
|
||||
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
|
||||
finally
|
||||
ReleaseDomNode(locExistDoc);
|
||||
ReleaseDomNode(locDoc);
|
||||
|
||||
@ -101,7 +101,7 @@ var
|
||||
strm : TMemoryStream;
|
||||
locParser : TJSONParser;
|
||||
root, errorNodeObj : TJSONObject;
|
||||
errorNode, tmpNode : TJSONData;
|
||||
errorNode : TJSONData;
|
||||
excpt_code, excpt_msg : string;
|
||||
begin
|
||||
root := nil;
|
||||
|
||||
178
wst/trunk/tests/test_suite/test_registry.pas
Normal file
178
wst/trunk/tests/test_suite/test_registry.pas
Normal file
@ -0,0 +1,178 @@
|
||||
{ This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit test_registry;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
{$IFDEF FPC}
|
||||
fpcunit, testregistry,
|
||||
{$ELSE}
|
||||
TestFrameWork,
|
||||
{$ENDIF}
|
||||
TypInfo,
|
||||
wst_types, base_service_intf;
|
||||
|
||||
const
|
||||
s_sample_namespace = 'org.wst.sample';
|
||||
|
||||
type
|
||||
|
||||
{ TClass_A }
|
||||
|
||||
TClass_A = class(TBaseComplexRemotable)
|
||||
private
|
||||
FIntProp : Integer;
|
||||
FStrProp : string;
|
||||
published
|
||||
// StrProp is an attribute property in this class !
|
||||
property StrProp : string read FStrProp write FStrProp;
|
||||
property IntProp : Integer read FIntProp write FIntProp;
|
||||
end;
|
||||
|
||||
{ TClass_B }
|
||||
|
||||
TClass_B = class(TBaseComplexRemotable)
|
||||
private
|
||||
FIntProp : Integer;
|
||||
FStrProp : string;
|
||||
published
|
||||
property StrProp : string read FStrProp write FStrProp;
|
||||
property IntProp : Integer read FIntProp write FIntProp;
|
||||
end;
|
||||
|
||||
TClass_C = class(TBaseComplexRemotable)
|
||||
private
|
||||
FIntProp : Integer;
|
||||
FStrProp : string;
|
||||
published
|
||||
property StrProp : string read FStrProp write FStrProp;
|
||||
//IntProp is an attribute property
|
||||
property IntProp : Integer read FIntProp write FIntProp;
|
||||
end;
|
||||
|
||||
{ TTest_TTypeRegistry }
|
||||
|
||||
TTest_TTypeRegistry = class(TTestCase)
|
||||
protected
|
||||
published
|
||||
procedure Register();
|
||||
procedure Register_with_declared_name();
|
||||
procedure isAttributeProperty();
|
||||
procedure register_external_prop();
|
||||
procedure synonym_procs();
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTest_TTypeRegistry }
|
||||
|
||||
procedure TTest_TTypeRegistry.Register();
|
||||
var
|
||||
reg : TTypeRegistry;
|
||||
regItem0 : TTypeRegistryItem;
|
||||
c : PtrInt;
|
||||
begin
|
||||
reg := TTypeRegistry.Create();
|
||||
try
|
||||
CheckEquals(0, reg.Count, 'Count');
|
||||
c := reg.Count;
|
||||
regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
|
||||
CheckEquals( ( c + 1 ), reg.Count, 'Count');
|
||||
CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True));
|
||||
CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]);
|
||||
Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType');
|
||||
CheckEquals(TClass_A.ClassName,regItem0.DeclaredName);
|
||||
CheckEquals(s_sample_namespace,regItem0.NameSpace);
|
||||
finally
|
||||
reg.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TTypeRegistry.Register_with_declared_name();
|
||||
const s_declared_name = 'sample_declared_name';
|
||||
var
|
||||
reg : TTypeRegistry;
|
||||
regItem0 : TTypeRegistryItem;
|
||||
c : PtrInt;
|
||||
begin
|
||||
reg := TTypeRegistry.Create();
|
||||
try
|
||||
CheckEquals(0, reg.Count, 'Count');
|
||||
c := reg.Count;
|
||||
regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A),s_declared_name);
|
||||
CheckEquals( ( c + 1 ), reg.Count, 'Count');
|
||||
CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True));
|
||||
CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]);
|
||||
Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType');
|
||||
CheckEquals(s_declared_name,regItem0.DeclaredName);
|
||||
CheckEquals(s_sample_namespace,regItem0.NameSpace);
|
||||
finally
|
||||
reg.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TTypeRegistry.isAttributeProperty();
|
||||
begin
|
||||
Check(TClass_A.IsAttributeProperty('StrProp'));
|
||||
Check(not TClass_A.IsAttributeProperty('IntProp'));
|
||||
Check(not TClass_B.IsAttributeProperty('StrProp'));
|
||||
Check(TClass_C.IsAttributeProperty('IntProp'));
|
||||
Check(not TClass_C.IsAttributeProperty('StrProp'));
|
||||
end;
|
||||
|
||||
procedure TTest_TTypeRegistry.register_external_prop();
|
||||
const s_ext_name = 'sample_external_name';
|
||||
var
|
||||
reg : TTypeRegistry;
|
||||
regItem : TTypeRegistryItem;
|
||||
begin
|
||||
reg := TTypeRegistry.Create();
|
||||
try
|
||||
regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
|
||||
regItem.RegisterExternalPropertyName('StrProp',s_ext_name);
|
||||
CheckEquals(s_ext_name,regItem.GetExternalPropertyName('StrProp'));
|
||||
CheckEquals('StrProp',regItem.GetInternalPropertyName(s_ext_name));
|
||||
finally
|
||||
reg.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TTypeRegistry.synonym_procs();
|
||||
const s_ext_name = 'sample_external_name';
|
||||
var
|
||||
reg : TTypeRegistry;
|
||||
regItem : TTypeRegistryItem;
|
||||
begin
|
||||
reg := TTypeRegistry.Create();
|
||||
try
|
||||
regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
|
||||
regItem.AddPascalSynonym(s_ext_name);
|
||||
Check(regItem.IsSynonym(s_ext_name));
|
||||
CheckSame(regItem, reg.Find(s_ext_name));
|
||||
finally
|
||||
reg.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_A));
|
||||
TClass_A.RegisterAttributeProperty('StrProp');
|
||||
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_B));
|
||||
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_C));
|
||||
TClass_C.RegisterAttributeProperty('IntProp');
|
||||
|
||||
RegisterTest('Registry',TTest_TTypeRegistry.Suite);
|
||||
end.
|
||||
|
||||
427
wst/trunk/tests/test_suite/test_soap_specific.pas
Normal file
427
wst/trunk/tests/test_suite/test_soap_specific.pas
Normal file
@ -0,0 +1,427 @@
|
||||
{
|
||||
This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit test_soap_specific;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
{$IFDEF FPC}
|
||||
fpcunit, testutils, testregistry, DOM, XmlRead, XmlWrite, wst_fpc_xml,
|
||||
{$ENDIF}
|
||||
{$IFNDEF FPC}
|
||||
TestFrameWork, ActiveX, wst_delphi_xml,
|
||||
{$ENDIF}
|
||||
TypInfo,
|
||||
base_service_intf, wst_types, server_service_intf, service_intf;
|
||||
|
||||
const
|
||||
ns_soap_test = 'soap.test.namespace';
|
||||
|
||||
type
|
||||
|
||||
TSOAPTestEnum = ( steOne, steTwo, steThree, steFour );
|
||||
|
||||
{ NBHeader }
|
||||
|
||||
NBHeader = class(THeaderBlock)
|
||||
private
|
||||
FSessionID : string;
|
||||
FUserID : string;
|
||||
public
|
||||
class procedure Load(
|
||||
var AObject : TObject;
|
||||
AStore : IFormatterBase;
|
||||
var AName : string;
|
||||
const ATypeInfo : PTypeInfo
|
||||
);override;
|
||||
class function GetNameSpace() : string;
|
||||
published
|
||||
property UserID : string read FUserID write FUserID;
|
||||
property SessionID : string read FSessionID write FSessionID;
|
||||
end;
|
||||
|
||||
{ TNameSpaceA_Class }
|
||||
|
||||
TNameSpaceA_Class = class(TBaseComplexRemotable)
|
||||
private
|
||||
FQualified_Val_Bool : boolean;
|
||||
FQualified_Val_Enum : TSOAPTestEnum;
|
||||
FQualified_Val_Int64 : Integer;
|
||||
FQualified_Val_Integer : Integer;
|
||||
FQualified_Val_String : string;
|
||||
public
|
||||
class function GetNameSpace() : string;virtual;
|
||||
published
|
||||
property Qualified_Val_Bool : boolean read FQualified_Val_Bool write FQualified_Val_Bool;
|
||||
property Qualified_Val_Enum : TSOAPTestEnum read FQualified_Val_Enum write FQualified_Val_Enum;
|
||||
property Qualified_Val_Integer : Integer read FQualified_Val_Integer write FQualified_Val_Integer;
|
||||
property Qualified_Val_Int64 : Integer read FQualified_Val_Int64 write FQualified_Val_Int64;
|
||||
property Qualified_Val_String : string Read FQualified_Val_String Write FQualified_Val_String;
|
||||
end;
|
||||
|
||||
{ TNameSpaceB_Class }
|
||||
|
||||
TNameSpaceB_Class = class(TNameSpaceA_Class)
|
||||
private
|
||||
FVal_Bool : Boolean;
|
||||
FVal_String : string;
|
||||
public
|
||||
class function GetNameSpace() : string;override;
|
||||
published
|
||||
property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool;
|
||||
property Val_String : string Read FVal_String Write FVal_String;
|
||||
end;
|
||||
|
||||
{ TNameSpaceC_Class }
|
||||
|
||||
TNameSpaceC_Class = class(TBaseComplexRemotable)
|
||||
private
|
||||
FProp_A : TNameSpaceA_Class;
|
||||
FProp_B : TNameSpaceB_Class;
|
||||
FProp_String : string;
|
||||
public
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
class function GetNameSpace() : string;virtual;
|
||||
published
|
||||
property Prop_String : string Read FProp_String Write FProp_String;
|
||||
property Prop_A : TNameSpaceA_Class read FProp_A write FProp_A;
|
||||
property Prop_B : TNameSpaceB_Class read FProp_B write FProp_B;
|
||||
end;
|
||||
|
||||
{ TTest_SoapFormatterServerNameSpace }
|
||||
|
||||
TTest_SoapFormatterServerNameSpace = class(TTestCase)
|
||||
published
|
||||
procedure namespace_declared_env();
|
||||
procedure received_header();
|
||||
procedure multi_namespace_object_write();
|
||||
procedure multi_namespace_object_read();
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
object_serializer, server_service_soap, test_suite_utils;
|
||||
|
||||
function GetFileFullName(const AFileName: string): string;
|
||||
var
|
||||
locFileName : string;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result := Format('.%sfiles%s%s',[PathDelim,PathDelim,AFileName]);
|
||||
{$ENDIF}
|
||||
{$IFDEF DELPHI}
|
||||
Result := Format('..%sfiles%s%s',[PathDelim,PathDelim,AFileName]);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function LoadXmlFromFilesList(const AFileName: string): TXMLDocument;
|
||||
begin
|
||||
ReadXMLFile(Result,GetFileFullName(AFileName));
|
||||
end;
|
||||
|
||||
{ NBHeader }
|
||||
|
||||
class procedure NBHeader.Load(
|
||||
var AObject : TObject;
|
||||
AStore : IFormatterBase;
|
||||
var AName : string;
|
||||
const ATypeInfo : PTypeInfo
|
||||
);
|
||||
var
|
||||
locSerializer : TObjectSerializer;
|
||||
begin
|
||||
locSerializer := TObjectSerializer.Create(Self,GetTypeRegistry());
|
||||
try
|
||||
locSerializer.Read(AObject,AStore,AName,ATypeInfo);
|
||||
finally
|
||||
locSerializer.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
class function NBHeader.GetNameSpace() : string;
|
||||
begin
|
||||
Result := 'NBS3';
|
||||
end;
|
||||
|
||||
{ TTest_SoapFormatterServerNameSpace }
|
||||
|
||||
procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env();
|
||||
const
|
||||
XML_SOURCE =
|
||||
'<soapenv:Envelope ' + sLineBreak +
|
||||
'xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" ' + sLineBreak +
|
||||
'xmlns:hfp="hfpax"> ' + sLineBreak +
|
||||
' <soapenv:Header/> ' + sLineBreak +
|
||||
' <soapenv:Body> ' + sLineBreak +
|
||||
' <hfp:GetVersion/> ' + sLineBreak +
|
||||
' </soapenv:Body> ' + sLineBreak +
|
||||
'</soapenv:Envelope>';
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
strBuffer : ansistring;
|
||||
cctx : ICallContext;
|
||||
begin
|
||||
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
|
||||
strm := TMemoryStream.Create();
|
||||
try
|
||||
strBuffer := XML_SOURCE;
|
||||
strm.Write(strBuffer[1],Length(strBuffer));
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
cctx := TSimpleCallContext.Create() as ICallContext;
|
||||
f.BeginCallRead(cctx);
|
||||
strBuffer := f.GetCallProcedureName();
|
||||
CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()');
|
||||
f.EndScopeRead();
|
||||
finally
|
||||
FreeAndNil(strm);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_SoapFormatterServerNameSpace.received_header();
|
||||
const
|
||||
XML_SOURCE =
|
||||
'<?xml version="1.0" encoding="utf-8" ?>' + sLineBreak +
|
||||
'<env:Envelope xmlns:xsd="http://www.w3.org/2001/XMLSchema"' + sLineBreak +
|
||||
' xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"' + sLineBreak +
|
||||
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">' + sLineBreak +
|
||||
' <env:Header >' + sLineBreak +
|
||||
' <n1:NBHeader xmlns:n1="NBS3"' + sLineBreak +
|
||||
' env:mustUnderstand="1">' + sLineBreak +
|
||||
' <n1:UserID>AL00287DE</n1:UserID>' + sLineBreak +
|
||||
' <n1:SessionID>KvyxXkK9PAta4zLtm6PA</n1:SessionID>' + sLineBreak +
|
||||
' </n1:NBHeader>' + sLineBreak +
|
||||
' </env:Header>' + sLineBreak +
|
||||
' <env:Body>' + sLineBreak +
|
||||
' <n2:getSelbst xmlns:n2="NBS3">' + sLineBreak +
|
||||
' </n2:getSelbst>' + sLineBreak +
|
||||
' </env:Body>' + sLineBreak +
|
||||
'</env:Envelope>';
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
strBuffer : ansistring;
|
||||
cctx : ICallContext;
|
||||
hdr : NBHeader;
|
||||
begin
|
||||
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
|
||||
strm := TMemoryStream.Create();
|
||||
try
|
||||
strBuffer := XML_SOURCE;
|
||||
strm.Write(strBuffer[1],Length(strBuffer));
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
cctx := TSimpleCallContext.Create() as ICallContext;
|
||||
f.BeginCallRead(cctx);
|
||||
CheckEquals(0,cctx.GetHeaderCount([hdOut]),'Ouput header count');
|
||||
CheckEquals(1,cctx.GetHeaderCount([hdIn]),'Input header count');
|
||||
CheckIs(cctx.GetHeader(0),NBHeader);
|
||||
hdr := NBHeader(cctx.GetHeader(0));
|
||||
CheckEquals(1,hdr.mustUnderstand,'mustUnderstand');
|
||||
CheckEquals('AL00287DE',hdr.UserID,'UserID');
|
||||
CheckEquals('KvyxXkK9PAta4zLtm6PA',hdr.SessionID);
|
||||
strBuffer := f.GetCallProcedureName();
|
||||
CheckEquals('getSelbst',strBuffer, 'GetCallProcedureName()');
|
||||
f.EndScopeRead();
|
||||
finally
|
||||
FreeAndNil(strm);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_write();
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
a : TNameSpaceA_Class;
|
||||
b : TNameSpaceB_Class;
|
||||
c : TNameSpaceC_Class;
|
||||
locDoc, locExistDoc : TXMLDocument;
|
||||
begin
|
||||
locDoc := nil;
|
||||
locExistDoc := nil;
|
||||
c := nil;
|
||||
b := nil;
|
||||
strm := nil;
|
||||
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
|
||||
f.GetPropertyManager().SetProperty('Style','Document');
|
||||
f.GetPropertyManager().SetProperty('EncodingStyle','Literal');
|
||||
a := TNameSpaceA_Class.Create();
|
||||
try
|
||||
a.Qualified_Val_Bool := True;
|
||||
a.Qualified_Val_Enum := steTwo;
|
||||
a.Qualified_Val_Integer := 1210;
|
||||
a.Qualified_Val_Int64 := 123456;
|
||||
a.Qualified_Val_String := 'sample string.';
|
||||
b := TNameSpaceB_Class.Create();
|
||||
b.Val_Bool := True;
|
||||
b.Val_String := 'WST sample string, local to ' + b.GetNameSpace();
|
||||
b.Qualified_Val_Bool := True;
|
||||
b.Qualified_Val_Enum := steThree;
|
||||
b.Qualified_Val_Integer := 456;
|
||||
b.Qualified_Val_Int64 := 78945;
|
||||
b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.';
|
||||
c := TNameSpaceC_Class.Create();
|
||||
c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ;
|
||||
c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ;
|
||||
c.Prop_B.Val_Bool := True;
|
||||
c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ;
|
||||
c.Prop_B.Qualified_Val_Bool := False;
|
||||
c.Prop_B.Qualified_Val_Enum := steFour;
|
||||
c.Prop_B.Qualified_Val_Integer := 789;
|
||||
c.Prop_B.Qualified_Val_Int64 := 64;
|
||||
c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ;
|
||||
f.BeginCallResponse('SampleProc','SampleService');
|
||||
f.Put('a',TypeInfo(TNameSpaceA_Class),a);
|
||||
f.Put('b',TypeInfo(TNameSpaceB_Class),b);
|
||||
f.Put('c',TypeInfo(TNameSpaceC_Class),c);
|
||||
f.EndCallResponse();
|
||||
strm := TMemoryStream.Create();
|
||||
f.SaveToStream(strm);
|
||||
strm.SaveToFile('soap_multi_namespace_object.xml');
|
||||
|
||||
strm.Position := 0;
|
||||
ReadXMLFile(locDoc,strm);
|
||||
locExistDoc := LoadXmlFromFilesList('soap_multi_namespace_object.xml');
|
||||
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
|
||||
finally
|
||||
ReleaseDomNode(locExistDoc);
|
||||
ReleaseDomNode(locDoc);
|
||||
c.Free();
|
||||
b.Free();
|
||||
a.Free();
|
||||
strm.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_read();
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
a, a_readed : TNameSpaceA_Class;
|
||||
b, b_readed : TNameSpaceB_Class;
|
||||
c, c_readed : TNameSpaceC_Class;
|
||||
locDoc, locExistDoc : TXMLDocument;
|
||||
strName : string;
|
||||
begin
|
||||
locDoc := nil;
|
||||
locExistDoc := nil;
|
||||
c := nil;
|
||||
b := nil;
|
||||
strm := nil;
|
||||
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
|
||||
f.GetPropertyManager().SetProperty('Style','Document');
|
||||
f.GetPropertyManager().SetProperty('EncodingStyle','Literal');
|
||||
a := TNameSpaceA_Class.Create();
|
||||
try
|
||||
a.Qualified_Val_Bool := True;
|
||||
a.Qualified_Val_Enum := steTwo;
|
||||
a.Qualified_Val_Integer := 1210;
|
||||
a.Qualified_Val_Int64 := 123456;
|
||||
a.Qualified_Val_String := 'sample string.';
|
||||
b := TNameSpaceB_Class.Create();
|
||||
b.Val_Bool := True;
|
||||
b.Val_String := 'WST sample string, local to ' + b.GetNameSpace();
|
||||
b.Qualified_Val_Bool := True;
|
||||
b.Qualified_Val_Enum := steThree;
|
||||
b.Qualified_Val_Integer := 456;
|
||||
b.Qualified_Val_Int64 := 78945;
|
||||
b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.';
|
||||
c := TNameSpaceC_Class.Create();
|
||||
c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ;
|
||||
c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ;
|
||||
c.Prop_B.Val_Bool := True;
|
||||
c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ;
|
||||
c.Prop_B.Qualified_Val_Bool := False;
|
||||
c.Prop_B.Qualified_Val_Enum := steFour;
|
||||
c.Prop_B.Qualified_Val_Integer := 789;
|
||||
c.Prop_B.Qualified_Val_Int64 := 64;
|
||||
c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ;
|
||||
strm := TMemoryStream.Create();
|
||||
strm.LoadFromFile(GetFileFullName('soap_multi_namespace_object.xml'));
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
a_readed := TNameSpaceA_Class.Create();
|
||||
b_readed := TNameSpaceB_Class.Create();
|
||||
c_readed := TNameSpaceC_Class.Create();
|
||||
f.BeginCallRead(TSimpleCallContext.Create());
|
||||
strName := 'a';
|
||||
f.Get(TypeInfo(TNameSpaceA_Class),strName,a_readed);
|
||||
strName := 'b';
|
||||
f.Get(TypeInfo(TNameSpaceB_Class),strName,b_readed);
|
||||
strName := 'c';
|
||||
f.Get(TypeInfo(TNameSpaceC_Class),strName,c_readed);
|
||||
f.EndScopeRead();
|
||||
|
||||
Check(a.Equal(a_readed) and a_readed.Equal(a),'a');
|
||||
Check(b.Equal(b_readed) and b_readed.Equal(b),'b');
|
||||
Check(c.Equal(c_readed) and c_readed.Equal(c),'c');
|
||||
finally
|
||||
ReleaseDomNode(locExistDoc);
|
||||
ReleaseDomNode(locDoc);
|
||||
c.Free();
|
||||
b.Free();
|
||||
a.Free();
|
||||
strm.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TNameSpaceA_Class }
|
||||
|
||||
class function TNameSpaceA_Class.GetNameSpace() : string;
|
||||
begin
|
||||
Result := 'NameSpace.A';
|
||||
end;
|
||||
|
||||
{ TNameSpaceB_Class }
|
||||
|
||||
class function TNameSpaceB_Class.GetNameSpace() : string;
|
||||
begin
|
||||
Result := 'NameSpace.B';
|
||||
end;
|
||||
|
||||
{ TNameSpaceC_Class }
|
||||
|
||||
constructor TNameSpaceC_Class.Create();
|
||||
begin
|
||||
inherited Create();
|
||||
FProp_A := TNameSpaceA_Class.Create();
|
||||
FProp_B := TNameSpaceB_Class.Create();
|
||||
end;
|
||||
|
||||
destructor TNameSpaceC_Class.Destroy();
|
||||
begin
|
||||
FreeAndNil(FProp_B);
|
||||
FreeAndNil(FProp_A);
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
class function TNameSpaceC_Class.GetNameSpace() : string;
|
||||
begin
|
||||
Result := 'NameSpace.C';
|
||||
end;
|
||||
|
||||
initialization
|
||||
GetTypeRegistry().Register(NBHeader.GetNameSpace(),TypeInfo(NBHeader),'NBHeader');
|
||||
GetTypeRegistry().Register(TNameSpaceA_Class.GetNameSpace(),TypeInfo(TNameSpaceA_Class));
|
||||
GetTypeRegistry().Register(TNameSpaceB_Class.GetNameSpace(),TypeInfo(TNameSpaceB_Class));
|
||||
GetTypeRegistry().Register(TNameSpaceC_Class.GetNameSpace(),TypeInfo(TNameSpaceC_Class));
|
||||
GetTypeRegistry().Register(ns_soap_test,TypeInfo(TSOAPTestEnum));
|
||||
|
||||
RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
|
||||
|
||||
end.
|
||||
|
||||
@ -57,7 +57,7 @@ begin
|
||||
Exit;
|
||||
if ( A.Attributes.Length > 0 ) then begin
|
||||
for i := 0 to Pred(A.Attributes.Length) do begin
|
||||
if not CompareNodes(A.Attributes.Item[i],B.Attributes.Item[i]) then
|
||||
if not CompareNodes(A.Attributes.Item[i],B.Attributes.GetNamedItem(A.Attributes.Item[i].NodeName)) then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -22,7 +22,7 @@ uses
|
||||
TestFrameWork,
|
||||
{$ENDIF}
|
||||
TypInfo,
|
||||
wst_types, base_service_intf;
|
||||
wst_types, base_service_intf, imp_utils;
|
||||
|
||||
type
|
||||
|
||||
@ -352,6 +352,10 @@ type
|
||||
procedure Equal();
|
||||
procedure SetBinaryData();
|
||||
procedure SetEncodedString();
|
||||
procedure LoadFromStream();
|
||||
procedure LoadFromFile();
|
||||
procedure SaveToStream();
|
||||
procedure SaveToFile();
|
||||
end;
|
||||
|
||||
{ TTest_TBase64StringExtRemotable }
|
||||
@ -362,6 +366,10 @@ type
|
||||
procedure test_Assign();
|
||||
procedure SetBinaryData();
|
||||
procedure SetEncodedString();
|
||||
procedure LoadFromStream();
|
||||
procedure LoadFromFile();
|
||||
procedure SaveToStream();
|
||||
procedure SaveToFile();
|
||||
end;
|
||||
|
||||
{ TClass_A_CollectionRemotable }
|
||||
@ -389,6 +397,14 @@ type
|
||||
procedure IndexOf();
|
||||
end;
|
||||
|
||||
{ TTest_Procedures }
|
||||
|
||||
TTest_Procedures = class(TTestCase)
|
||||
published
|
||||
procedure test_LoadBufferFromStream();
|
||||
procedure test_LoadBufferFromFile();
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses Math, basex_encode;
|
||||
|
||||
@ -2171,7 +2187,6 @@ begin
|
||||
end;
|
||||
|
||||
procedure TTest_TDateRemotable.ParseDate();
|
||||
const sDATE = '1976-10-12T23:34:56';
|
||||
var
|
||||
s : string;
|
||||
objd : TDateRemotable;
|
||||
@ -2901,6 +2916,129 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringRemotable.LoadFromStream();
|
||||
var
|
||||
locLoadedBuffer : TBase64StringRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locLoadedBuffer := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locLoadedBuffer := TBase64StringRemotable.Create();
|
||||
locLoadedBuffer.LoadFromStream(locStream);
|
||||
Check( locLoadedBuffer.BinaryData = locBuffer );
|
||||
finally
|
||||
locLoadedBuffer.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringRemotable.LoadFromFile();
|
||||
var
|
||||
locLoadedBuffer : TBase64StringRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
locFileName : string;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locLoadedBuffer := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locFileName := 'test_LoadBufferFromFile.bin';
|
||||
locStream.SaveToFile(locFileName);
|
||||
locLoadedBuffer := TBase64StringRemotable.Create();
|
||||
locLoadedBuffer.LoadFromFile(locFileName);
|
||||
Check( locLoadedBuffer.BinaryData = locBuffer );
|
||||
finally
|
||||
locLoadedBuffer.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringRemotable.SaveToStream();
|
||||
var
|
||||
locObj : TBase64StringRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locObj := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locObj := TBase64StringRemotable.Create();
|
||||
locObj.BinaryData := locBuffer;
|
||||
locObj.SaveToStream(locStream);
|
||||
Check( locStream.Size = Length(locObj.BinaryData) );
|
||||
SetLength(locBuffer,locStream.Size);
|
||||
locStream.Position := 0;
|
||||
locStream.Read(locBuffer[1],Length(locBuffer));
|
||||
Check( locBuffer = locObj.BinaryData );
|
||||
finally
|
||||
locObj.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringRemotable.SaveToFile();
|
||||
var
|
||||
locObj : TBase64StringRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TFileStream;
|
||||
i : PtrInt;
|
||||
locFileName : string;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locStream := nil;
|
||||
locObj := TBase64StringRemotable.Create();
|
||||
try
|
||||
locObj.BinaryData := locBuffer;
|
||||
locFileName := 'test_LoadBufferFromFile.bin';
|
||||
DeleteFile(locFileName);
|
||||
locObj.SaveToFile(locFileName);
|
||||
Check(FileExists(locFileName));
|
||||
locStream := TFileStream.Create(locFileName,fmOpenRead);
|
||||
Check( locStream.Size = Length(locObj.BinaryData) );
|
||||
SetLength(locBuffer,locStream.Size);
|
||||
locStream.Position := 0;
|
||||
locStream.Read(locBuffer[1],Length(locBuffer));
|
||||
Check( locBuffer = locObj.BinaryData );
|
||||
finally
|
||||
locObj.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTest_TBase64StringExtRemotable }
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.Equal();
|
||||
@ -2994,6 +3132,129 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.LoadFromStream();
|
||||
var
|
||||
locLoadedBuffer : TBase64StringExtRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locLoadedBuffer := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locLoadedBuffer := TBase64StringExtRemotable.Create();
|
||||
locLoadedBuffer.LoadFromStream(locStream);
|
||||
Check( locLoadedBuffer.BinaryData = locBuffer );
|
||||
finally
|
||||
locLoadedBuffer.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.LoadFromFile();
|
||||
var
|
||||
locLoadedBuffer : TBase64StringExtRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
locFileName : string;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locLoadedBuffer := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locFileName := 'test_LoadBufferFromFile.bin';
|
||||
locStream.SaveToFile(locFileName);
|
||||
locLoadedBuffer := TBase64StringExtRemotable.Create();
|
||||
locLoadedBuffer.LoadFromFile(locFileName);
|
||||
Check( locLoadedBuffer.BinaryData = locBuffer );
|
||||
finally
|
||||
locLoadedBuffer.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.SaveToStream();
|
||||
var
|
||||
locObj : TBase64StringExtRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locObj := nil;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locObj := TBase64StringExtRemotable.Create();
|
||||
locObj.BinaryData := locBuffer;
|
||||
locObj.SaveToStream(locStream);
|
||||
Check( locStream.Size = Length(locObj.BinaryData) );
|
||||
SetLength(locBuffer,locStream.Size);
|
||||
locStream.Position := 0;
|
||||
locStream.Read(locBuffer[1],Length(locBuffer));
|
||||
Check( locBuffer = locObj.BinaryData );
|
||||
finally
|
||||
locObj.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.SaveToFile();
|
||||
var
|
||||
locObj : TBase64StringExtRemotable;
|
||||
locBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TFileStream;
|
||||
i : PtrInt;
|
||||
locFileName : string;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locStream := nil;
|
||||
locObj := TBase64StringExtRemotable.Create();
|
||||
try
|
||||
locObj.BinaryData := locBuffer;
|
||||
locFileName := 'test_LoadBufferFromFile.bin';
|
||||
DeleteFile(locFileName);
|
||||
locObj.SaveToFile(locFileName);
|
||||
Check(FileExists(locFileName));
|
||||
locStream := TFileStream.Create(locFileName,fmOpenRead);
|
||||
Check( locStream.Size = Length(locObj.BinaryData) );
|
||||
SetLength(locBuffer,locStream.Size);
|
||||
locStream.Position := 0;
|
||||
locStream.Read(locBuffer[1],Length(locBuffer));
|
||||
Check( locBuffer = locObj.BinaryData );
|
||||
finally
|
||||
locObj.Free();
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_TBase64StringExtRemotable.test_Assign();
|
||||
const ITER = 100;
|
||||
var
|
||||
@ -3243,6 +3504,57 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTest_Procedures }
|
||||
|
||||
procedure TTest_Procedures.test_LoadBufferFromStream();
|
||||
var
|
||||
locBuffer, locLoadedBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locLoadedBuffer := LoadBufferFromStream(locStream);
|
||||
Check( locLoadedBuffer = locBuffer );
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_Procedures.test_LoadBufferFromFile();
|
||||
var
|
||||
locBuffer, locLoadedBuffer : TBinaryString;
|
||||
pBytePtr : PByte;
|
||||
locStream : TMemoryStream;
|
||||
i : PtrInt;
|
||||
locFileName : string;
|
||||
begin
|
||||
SetLength(locBuffer,255);
|
||||
pBytePtr := PByte(@(locBuffer[1]));
|
||||
for i := 0 to 255 do begin
|
||||
pBytePtr^ := i;
|
||||
Inc(pBytePtr);
|
||||
end;
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
locStream.Write(locBuffer[1],Length(locBuffer));
|
||||
locFileName := 'test_LoadBufferFromFile.bin';
|
||||
locStream.SaveToFile(locFileName);
|
||||
locLoadedBuffer := LoadBufferFromFile(locFileName);
|
||||
Check( locLoadedBuffer = locBuffer );
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest('Support',TTest_TObjectCollectionRemotable.Suite);
|
||||
RegisterTest('Support',TTest_TBaseComplexRemotable.Suite);
|
||||
@ -3273,5 +3585,7 @@ initialization
|
||||
RegisterTest('Support',TTest_TBase64StringRemotable.Suite);
|
||||
RegisterTest('Support',TTest_TBase64StringExtRemotable.Suite);
|
||||
|
||||
RegisterTest('Support',TTest_Procedures.Suite);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -4,7 +4,7 @@ unit test_wst_cursors;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Contnrs,
|
||||
Classes, SysUtils,
|
||||
{$IFDEF FPC}
|
||||
fpcunit, testutils, testregistry,
|
||||
{$ELSE}
|
||||
@ -109,7 +109,7 @@ const O_COUNT = 100;
|
||||
var
|
||||
x : IObjectCursor;
|
||||
ls : TBaseObjectArrayRemotable;
|
||||
c, i : Integer;
|
||||
i : Integer;
|
||||
begin
|
||||
ls := TTClass_A_ArrayRemotable.Create();
|
||||
try
|
||||
@ -182,7 +182,7 @@ const O_COUNT = 100;
|
||||
var
|
||||
x : IFilterableObjectCursor;
|
||||
ls : TBaseObjectArrayRemotable;
|
||||
c, i : Integer;
|
||||
i : Integer;
|
||||
f : IObjectFilter;
|
||||
fcr : TRttiFilterCreator;
|
||||
begin
|
||||
@ -445,7 +445,7 @@ const O_COUNT = 100;
|
||||
var
|
||||
x : IObjectCursor;
|
||||
ls : TObjectCollectionRemotable;
|
||||
c, i : PtrInt;
|
||||
i : PtrInt;
|
||||
begin
|
||||
ls := TTClass_A_CollectionRemotable.Create();
|
||||
try
|
||||
|
||||
@ -517,14 +517,8 @@ type
|
||||
published
|
||||
procedure Assign();
|
||||
end;
|
||||
|
||||
{ TTest_SoapFormatterServerNameSpace }
|
||||
|
||||
TTest_SoapFormatterServerNameSpace = class(TTestCase)
|
||||
published
|
||||
procedure namespace_declared_env();
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti,
|
||||
Math, imp_utils
|
||||
@ -537,7 +531,7 @@ uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_r
|
||||
, server_service_soap, soap_formatter,
|
||||
server_service_xmlrpc, xmlrpc_formatter,
|
||||
binary_streamer, server_binary_formatter, binary_formatter,
|
||||
test_suite_utils;
|
||||
test_suite_utils, object_serializer;
|
||||
|
||||
function CompareNodes(const A,B : PDataBuffer) : Boolean;overload;forward;
|
||||
|
||||
@ -4245,41 +4239,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTest_SoapFormatterServerNameSpace }
|
||||
|
||||
procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env();
|
||||
const
|
||||
XML_SOURCE =
|
||||
'<soapenv:Envelope ' + sLineBreak +
|
||||
'xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" ' + sLineBreak +
|
||||
'xmlns:hfp="hfpax"> ' + sLineBreak +
|
||||
' <soapenv:Header/> ' + sLineBreak +
|
||||
' <soapenv:Body> ' + sLineBreak +
|
||||
' <hfp:GetVersion/> ' + sLineBreak +
|
||||
' </soapenv:Body> ' + sLineBreak +
|
||||
'</soapenv:Envelope>';
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
strBuffer : ansistring;
|
||||
cctx : ICallContext;
|
||||
begin
|
||||
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
|
||||
strm := TMemoryStream.Create();
|
||||
try
|
||||
strBuffer := XML_SOURCE;
|
||||
strm.Write(strBuffer[1],Length(strBuffer));
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
cctx := TSimpleCallContext.Create() as ICallContext;
|
||||
f.BeginCallRead(cctx);
|
||||
strBuffer := f.GetCallProcedureName();
|
||||
CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()');
|
||||
f.EndScopeRead();
|
||||
finally
|
||||
FreeAndNil(strm);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
RegisterStdTypes();
|
||||
@ -4345,5 +4307,5 @@ initialization
|
||||
RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite);
|
||||
RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite);
|
||||
RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite);
|
||||
RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
|
||||
|
||||
end.
|
||||
|
||||
@ -19,7 +19,7 @@ uses
|
||||
xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode,
|
||||
test_basex_encode, json_formatter, server_service_json, test_json,
|
||||
test_suite_utils, test_generators, test_std_cursors, test_rtti_filter,
|
||||
test_wst_cursors;
|
||||
test_wst_cursors, test_registry;
|
||||
|
||||
Const
|
||||
ShortOpts = 'alh';
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
<PackageName Value="fpcunittestrunner"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="16">
|
||||
<Units Count="17">
|
||||
<Unit0>
|
||||
<Filename Value="wst_test_suite_gui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -111,10 +111,15 @@
|
||||
<UnitName Value="test_wst_cursors"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="wst_collections.pas"/>
|
||||
<Filename Value="test_registry.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wst_collections"/>
|
||||
<UnitName Value="test_registry"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="test_soap_specific.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="test_soap_specific"/>
|
||||
</Unit16>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -17,7 +17,7 @@ uses
|
||||
xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode,
|
||||
test_basex_encode, json_formatter, server_service_json, test_json,
|
||||
test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors,
|
||||
test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors;
|
||||
test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors, test_registry, test_soap_specific;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
|
||||
@ -1,3 +1,6 @@
|
||||
{$DEFINE USE_SERIALIZE}
|
||||
{$UNDEF TRemotableTypeInitializer_Initialize}
|
||||
|
||||
{$WARNINGS OFF}
|
||||
|
||||
{$IFDEF FPC}
|
||||
|
||||
@ -30,13 +30,9 @@ type
|
||||
{$M+}
|
||||
TXmlRpcFormatter = class(TXmlRpcBaseFormatter,IFormatterClient)
|
||||
private
|
||||
FPropMngr : IPropertyManager;
|
||||
FCallProcedureName : string;
|
||||
FCallTarget : String;
|
||||
public
|
||||
destructor Destroy();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
@ -73,19 +69,6 @@ implementation
|
||||
|
||||
{ TXmlRpcFormatter }
|
||||
|
||||
destructor TXmlRpcFormatter.Destroy();
|
||||
begin
|
||||
FPropMngr := nil;
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
function TXmlRpcFormatter.GetPropertyManager(): IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TXmlRpcFormatter.BeginCall(
|
||||
const AProcName,
|
||||
ATarget : string;
|
||||
|
||||
Reference in New Issue
Block a user