diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas
index a8b4ca818..71c355333 100644
--- a/wst/trunk/base_service_intf.pas
+++ b/wst/trunk/base_service_intf.pas
@@ -50,7 +50,7 @@ type
{$IFNDEF WST_HAS_TTIMEREMOTABLE}
time = type string;
{$ENDIF WST_HAS_TTIMEREMOTABLE}
-
+
TScopeType = Integer;
TArrayStyle = ( asScoped, asEmbeded, asNone );
TInstanceOption = ( ioAlwaysSerialize );
@@ -76,7 +76,7 @@ type
EServiceConfigException = class(EServiceException)
end;
-
+
ETypeRegistryException = class(EServiceConfigException)
end;
@@ -144,7 +144,7 @@ type
End;
TSerializationStyle = ( ssNodeSerialization, ssAttibuteSerialization );
-
+
IFormatterBase = Interface
['{2AB3BF54-B7D6-4C46-8245-133C8775E9C1}']
function GetPropertyManager():IPropertyManager;
@@ -219,7 +219,7 @@ type
function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
//Please use this method if and _only_ if you do not have another way achieve your aim!
procedure WriteBuffer(const AValue : string);
-
+
procedure SaveToStream(AStream : TStream);
procedure LoadFromStream(AStream : TStream);
@@ -383,6 +383,7 @@ type
class function ToStr(const ADate : TDateTime):string;overload;
class function ToStr(const ADate : TDateTimeRec):string;overload;virtual;abstract;
class function Parse(const ABuffer : string):TDateTimeRec;virtual;abstract;
+ class function ParseToUTC(const ABuffer : string):TDateTime;
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
@@ -403,8 +404,8 @@ type
public
class function ToStr(const ADate : TDateTimeRec):string;override;
class function Parse(const ABuffer : string):TDateTimeRec;override;
- end;
-
+ end;
+
{ TDateTimeRemotable }
TDateTimeRemotable = class(TBaseDateRemotable)
@@ -417,7 +418,7 @@ type
property Minute : Integer index 4 read GetDatepart;
property Second : Integer index 5 read GetDatepart;
end;
-
+
{ TDurationRemotable }
TDurationRemotable = class(TAbstractSimpleRemotable)
@@ -507,7 +508,7 @@ type
property Data : TTimeRec read FData write FData;
property AsString : string read GetAsString write SetAsString;
end;
-
+
TAbstractComplexRemotableClass = class of TAbstractComplexRemotable;
{ TAbstractComplexRemotable }
@@ -546,7 +547,7 @@ type
end;
TRemotableRecordEncoderClass = class of TRemotableRecordEncoder;
-
+
{ TRemotableRecordEncoder }
TRemotableRecordEncoder = class(TPersistent)
@@ -564,7 +565,7 @@ type
const ATypeInfo : PTypeInfo
);virtual;
end;
-
+
{ TBaseComplexSimpleContentRemotable }
TBaseComplexSimpleContentRemotable = class(TAbstractComplexRemotable)
@@ -599,7 +600,7 @@ type
end;
{ TComplexInt8SContentRemotable }
-
+
TComplexInt8SContentRemotable = class(TBaseComplexSimpleContentRemotable)
private
FValue: ShortInt;
@@ -631,7 +632,7 @@ type
public
property Value : Word read FValue write FValue;
end;
-
+
{ TComplexInt32SContentRemotable }
TComplexInt32SContentRemotable = class(TBaseComplexSimpleContentRemotable)
@@ -655,7 +656,7 @@ type
public
property Value : LongWord read FValue write FValue;
end;
-
+
{ TComplexInt64SContentRemotable }
TComplexInt64SContentRemotable = class(TBaseComplexSimpleContentRemotable)
@@ -823,7 +824,7 @@ type
public
property Value : Boolean read FValue write FValue;
end;
-
+
THeaderBlockClass = class of THeaderBlock;
{ THeaderBlock }
@@ -1453,7 +1454,7 @@ type
property Intf : IInterface read FIntf;
property Used : Boolean read FUsed write FUsed;
end;
-
+
TIntfPool = class
private
FList : TObjectList;
@@ -1478,7 +1479,7 @@ type
property Min : PtrInt read FMin;
property Max : PtrInt read FMax;
end;
-
+
{ TSimpleItemFactoryEx }
TSimpleItemFactoryEx = class(TSimpleItemFactory,IInterface,IItemFactory,IItemFactoryEx)
@@ -1522,7 +1523,7 @@ type
TTypeRegistry = class;
TTypeRegistryItem = class;
TTypeRegistryItemClass = class of TTypeRegistryItem;
-
+
TRemotableTypeInitializerClass = class of TRemotableTypeInitializer;
{ TRemotableTypeInitializer }
@@ -1538,7 +1539,7 @@ type
) : Boolean;virtual;abstract;
{$ENDIF TRemotableTypeInitializer_Initialize}
end;
-
+
{ TTypeRegistryItem }
TTypeRegistryItem = class
@@ -1568,11 +1569,11 @@ type
function AddExternalSynonym(const ASynonym : string):TTypeRegistryItem;
function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
function IsExternalSynonym(const AExternalName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
-
+
procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); virtual;
function GetExternalPropertyName(const APropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetInternalPropertyName(const AExtPropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
-
+
procedure RegisterObject(const APropName : string; const AObject : TObject);
function GetObject(const APropName : string) : TObject;
@@ -1624,7 +1625,7 @@ type
end;
TPropStoreType = ( pstNever, pstOptional, pstAlways );
-
+
EPropertyException = class(Exception)
end;
@@ -1680,7 +1681,7 @@ const
procedure initialize_base_service_intf();
procedure finalize_base_service_intf();
-
+
{$IFDEF HAS_FORMAT_SETTINGS}
var
wst_FormatSettings : TFormatSettings;
@@ -1693,7 +1694,7 @@ uses
type
PObject = ^TObject;
-
+
var
TypeRegistryInstance : TTypeRegistry = Nil;
@@ -1789,13 +1790,13 @@ begin
r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatDoubleRemotable),'TArrayOfFloatDoubleRemotable').AddPascalSynonym('TArrayOfFloatDoubleRemotable');
r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatExtendedRemotable),'TArrayOfFloatExtendedRemotable').AddPascalSynonym('TArrayOfFloatExtendedRemotable');
r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatCurrencyRemotable),'TArrayOfFloatCurrencyRemotable').AddPascalSynonym('TArrayOfFloatCurrencyRemotable');
-
+
r.Register(sXSD_NS,TypeInfo(TComplexInt64SContentRemotable),'long').AddPascalSynonym('TComplexInt64SContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexInt64UContentRemotable),'unsignedLong').AddPascalSynonym('TComplexInt64UContentRemotable');
-
+
r.Register(sXSD_NS,TypeInfo(TComplexInt32SContentRemotable),'int').AddPascalSynonym('TComplexInt32SContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexInt32UContentRemotable),'unsignedInt').AddPascalSynonym('TComplexInt32UContentRemotable');
-
+
r.Register(sXSD_NS,TypeInfo(TComplexInt16SContentRemotable),'short').AddPascalSynonym('TComplexInt16SContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexInt16UContentRemotable),'unsignedShort').AddPascalSynonym('TComplexInt16UContentRemotable');
@@ -1805,7 +1806,7 @@ begin
r.Register(sXSD_NS,TypeInfo(TComplexFloatExtendedContentRemotable),'decimal').AddPascalSynonym('TComplexFloatExtendedContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexFloatDoubleContentRemotable),'double').AddPascalSynonym('TComplexFloatDoubleContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexFloatSingleContentRemotable),'Single').AddPascalSynonym('TComplexFloatSingleContentRemotable');
-
+
r.Register(sXSD_NS,TypeInfo(TComplexStringContentRemotable),'string').AddPascalSynonym('TComplexStringContentRemotable');
r.Register(sXSD_NS,TypeInfo(TComplexWideStringContentRemotable),'widestring').AddPascalSynonym('TComplexWideStringContentRemotable');
{$IFDEF WST_UNICODESTRING}
@@ -2018,14 +2019,14 @@ Type
var
SerializeOptionsRegistryInstance : TSerializeOptionsRegistry = nil;
-
+
function GetSerializeOptionsRegistry():TSerializeOptionsRegistry;
begin
if not Assigned(SerializeOptionsRegistryInstance) then
SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create();
Result := SerializeOptionsRegistryInstance;
end;
-
+
{ TSerializeOptionsRegistry }
function TSerializeOptionsRegistry.GetCount: Integer;
@@ -2094,7 +2095,7 @@ begin
else
Result := nil;
end;
-
+
{ TSerializeOptions }
procedure TSerializeOptions.AddAttributeField(const AAttributeField: string);
@@ -2132,10 +2133,10 @@ begin
Result := ( FAttributeFieldList.IndexOf(AField) >= 0 );
end;
-destructor TBaseComplexRemotable.Destroy();
+destructor TBaseComplexRemotable.Destroy();
begin
FreeObjectProperties();
- inherited Destroy();
+ inherited Destroy();
end;
class procedure TBaseComplexRemotable.Save(
@@ -2511,10 +2512,10 @@ begin
end;
{$ENDIF USE_SERIALIZE}
-procedure TBaseComplexRemotable.FreeObjectProperties();
+procedure TBaseComplexRemotable.FreeObjectProperties();
begin
//Derived classes should override this method to free their object(s) and array(s).
-end;
+end;
{ TBaseObjectArrayRemotable }
@@ -3095,7 +3096,7 @@ destructor TTypeRegistryItem.Destroy();
obj.Free();
end;
end;
-
+
begin
if ( FExternalNames <> nil ) and ( FExternalNames.Count > 0 ) then
FreeObjects();
@@ -3279,13 +3280,19 @@ begin
end;
function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer;
+var
+ i : Integer;
begin
- For Result := 0 To Pred(Count) Do Begin
- If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And
+ for i := 0 to Pred(Count) do begin
+ if ( ATypeInfo = Item[i].DataType ) then begin
+ Result := i;
+ Exit;
+ end;
+ {If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And
AnsiSameText(ATypeInfo^.Name,Item[Result].DataType^.Name)
Then
- Exit;
- End;
+ Exit;}
+ end;
Result := -1;
end;
@@ -4733,10 +4740,12 @@ class procedure TSimpleContentHeaderBlock.Save(
);
var
locSerializer : TObjectSerializer;
+ locOptionChanged : Boolean;
begin
locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer();
if ( locSerializer <> nil ) then begin
- if not ( osoDontDoBeginWrite in locSerializer.Options ) then
+ locOptionChanged := not ( osoDontDoBeginWrite in locSerializer.Options );
+ if locOptionChanged then
locSerializer.Options := locSerializer.Options + [osoDontDoBeginWrite];
AStore.BeginObject(AName,ATypeInfo);
try
@@ -4745,6 +4754,8 @@ begin
locSerializer.Save(AObject,AStore,AName,ATypeInfo);
finally
AStore.EndScope();
+ if locOptionChanged then
+ locSerializer.Options := locSerializer.Options - [osoDontDoBeginWrite];
end;
end else begin
raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name])
@@ -5655,12 +5666,12 @@ end;
{ TDateRemotable }
-class function TDateRemotable.ToStr(const ADate : TDateTimeRec) : string;
+class function TDateRemotable.ToStr(const ADate : TDateTimeRec) : string;
begin
Result := xsd_DateTimeToStr(ADate,xdkDate);
end;
-class function TDateRemotable.Parse(const ABuffer : string) : TDateTimeRec;
+class function TDateRemotable.Parse(const ABuffer : string) : TDateTimeRec;
begin
Result := xsd_StrToDate(ABuffer,xdkDate);
end;
@@ -5822,6 +5833,11 @@ begin
Result := ToStr(locTemp);
end;
+class function TBaseDateRemotable.ParseToUTC(const ABuffer : string) : TDateTime;
+begin
+ Result := NormalizeToUTC(Parse(ABuffer));
+end;
+
{ TComplexInt8SContentRemotable }
class procedure TComplexInt8SContentRemotable.SaveValue(
@@ -6590,7 +6606,7 @@ begin
end;
class procedure TComplexWideCharContentRemotable.SaveValue(
- AObject: TBaseRemotable;
+ AObject: TBaseRemotable;
AStore: IFormatterBase
);
begin
diff --git a/wst/trunk/date_utils.pas b/wst/trunk/date_utils.pas
index bfa9ee2dd..5831fe39f 100644
--- a/wst/trunk/date_utils.pas
+++ b/wst/trunk/date_utils.pas
@@ -67,6 +67,10 @@ const
type
TXsdDateKind = ( xdkDateTime, xdkDate );
+ TValueCompareKind = (
+ vckEqual, vckLessThan, vckGreaterThan, vckNotEqual,
+ vckEqualOrLessThan, vckEqualOrGreaterThan
+ );
function xsd_TryStrToDate(
const AStr : string;
@@ -123,6 +127,11 @@ type
function ValueEquals(const AA,AB: TTimeRec) : Boolean; overload;
function ValueEquals(const AA,AB: TDurationRec) : Boolean; overload;
+ function CompareValue(
+ const AA,AB : TDateTimeRec;
+ const ACompareKind : TValueCompareKind
+ ) : Boolean;
+
resourcestring
SERR_InvalidDate = '"%s" is not a valid date.';
SERR_InvalidTime = '"%s" is not a valid time.';
@@ -200,6 +209,27 @@ begin
( a.MinuteOffset = b.MinuteOffset );
end;
+function CompareValue(
+ const AA,AB : TDateTimeRec;
+ const ACompareKind : TValueCompareKind
+) : Boolean;
+var
+ locA, locB : TDateTime;
+begin
+ case ACompareKind of
+ vckEqual : Result := ValueEquals(AA,AB);
+ vckLessThan : Result := ( NormalizeToUTC(AA) < NormalizeToUTC(AB) );
+ vckGreaterThan : Result := ( NormalizeToUTC(AA) > NormalizeToUTC(AB) );
+ vckNotEqual : Result := not ValueEquals(AA,AB);
+ vckEqualOrLessThan : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) < NormalizeToUTC(AB) );
+ vckEqualOrGreaterThan : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) > NormalizeToUTC(AB) );
+ else begin
+ Assert(False); // To suppress the warning
+ Result := False;
+ end;
+ end;
+end;
+
function xsd_TryStrToDate(
const AStr : string;
out ADate : TDateTimeRec;
diff --git a/wst/trunk/ide/lazarus/wst_indy.lpk b/wst/trunk/ide/lazarus/wst_indy.lpk
index fe1d5caeb..a787764df 100644
--- a/wst/trunk/ide/lazarus/wst_indy.lpk
+++ b/wst/trunk/ide/lazarus/wst_indy.lpk
@@ -8,7 +8,7 @@
-
+
diff --git a/wst/trunk/indy_http_protocol.pas b/wst/trunk/indy_http_protocol.pas
index 3fad713f8..0e36b7215 100644
--- a/wst/trunk/indy_http_protocol.pas
+++ b/wst/trunk/indy_http_protocol.pas
@@ -4,7 +4,7 @@
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
@@ -24,7 +24,7 @@ uses
Const
sTRANSPORT_NAME = 'HTTP';
-
+
Type
{$M+}
@@ -36,12 +36,15 @@ Type
FConnection : TidHttp;
FSoapAction: string;
FContentType: string;
+ private
function GetAddress: string;
+ function GetProtocolVersion : string;
function GetProxyPassword: string;
function GetProxyPort: Integer;
function GetProxyServer: string;
function GetProxyUsername: string;
procedure SetAddress(const AValue: string);
+ procedure SetProtocolVersion(const AValue : string);
procedure SetProxyPassword(const AValue: string);
procedure SetProxyPort(const AValue: Integer);
procedure SetProxyServer(const AValue: string);
@@ -60,13 +63,37 @@ Type
property ProxyPassword : string read GetProxyPassword write SetProxyPassword;
property SoapAction : string read FSoapAction write FSoapAction;
property Format : string read FFormat write FFormat;
+ property ProtocolVersion : string read GetProtocolVersion write SetProtocolVersion;
End;
{$M+}
procedure INDY_RegisterHTTP_Transport();
-
+
implementation
-
+uses
+ wst_consts;
+
+const
+ ProtocolVersionMAP : array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1');
+
+function TryStrToProtocolVersion(
+ const AStr : string;
+ out ARes : TIdHTTPProtocolVersion
+) : Boolean;
+var
+ i : TIdHTTPProtocolVersion;
+begin
+ for i := Low(TIdHTTPProtocolVersion) to High(TIdHTTPProtocolVersion) do begin
+ if ( AStr = ProtocolVersionMAP[i] ) then begin
+ ARes := i;
+ Result := True;
+ Exit;
+ end;
+ end;
+ Result := False;
+end;
+
+
{ THTTPTransport }
function THTTPTransport.GetAddress: string;
@@ -74,6 +101,11 @@ begin
Result := FConnection.Request.URL;
end;
+function THTTPTransport.GetProtocolVersion : string;
+begin
+ Result := ProtocolVersionMAP[FConnection.ProtocolVersion];
+end;
+
function THTTPTransport.GetProxyPassword: string;
begin
Result := FConnection.ProxyParams.ProxyPassword;
@@ -99,6 +131,17 @@ begin
FConnection.Request.URL := AValue;
end;
+procedure THTTPTransport.SetProtocolVersion(const AValue : string);
+var
+ locValue : TIdHTTPProtocolVersion;
+begin
+ if not TryStrToProtocolVersion(AValue,locValue) then
+ raise ETransportExecption.CreateFmt(SERR_InvalidPropertyValue,['ProtocolVersion',AValue]);
+ FConnection.ProtocolVersion := locValue;
+ if not ( hoKeepOrigProtocol in FConnection.HTTPOptions ) then
+ FConnection.HTTPOptions := FConnection.HTTPOptions + [hoKeepOrigProtocol];
+end;
+
procedure THTTPTransport.SetProxyPassword(const AValue: string);
begin
FConnection.ProxyParams.ProxyPassword := AValue;
@@ -151,8 +194,11 @@ begin
FConnection.ProxyParams.BasicAuthentication := True;
end;
FConnection.Request.CustomHeaders.Clear();
- FConnection.Request.CustomHeaders.Values['soapAction'] := SoapAction;
+ FConnection.Request.CustomHeaders.Values['SOAPAction'] := SoapAction;
FConnection.Request.ContentType := ContentType;
+{$IFDEF WST_DBG}
+ TMemoryStream(ARequest).SaveToFile('request.log');
+{$ENDIF WST_DBG}
FConnection.Post(Address,ARequest, AResponse);
{$IFDEF WST_DBG}
i := AResponse.Size;
diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas
index 5c7c45be8..72af95493 100644
--- a/wst/trunk/synapse_http_protocol.pas
+++ b/wst/trunk/synapse_http_protocol.pas
@@ -163,7 +163,7 @@ procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
{else
ShowMessage(AStr)};
end;
-
+
var
s : TBinaryString;
{$ENDIF}
diff --git a/wst/trunk/tests/test_suite/test_generators_runtime.pas b/wst/trunk/tests/test_suite/test_generators_runtime.pas
index c2651b73a..8abe75b40 100644
--- a/wst/trunk/tests/test_suite/test_generators_runtime.pas
+++ b/wst/trunk/tests/test_suite/test_generators_runtime.pas
@@ -310,10 +310,10 @@ begin
RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString');
end;
{$IFNDEF WST_RECORD_RTTI}
- typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
+ typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
{$ENDIF WST_RECORD_RTTI}
{$IFDEF WST_RECORD_RTTI}
- typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
+ typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
{$ENDIF WST_RECORD_RTTI}
(typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetObject(FIELDS_STRING) as TRecordRttiDataObject).GetField('fieldWord')^.IsAttribute := True;
handlerReg := CreateWsdlTypeHandlerRegistry(typeReg);
diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas
index 931578cd0..85b4293e9 100644
--- a/wst/trunk/ws_helper/pascal_parser_intf.pas
+++ b/wst/trunk/ws_helper/pascal_parser_intf.pas
@@ -20,6 +20,7 @@ uses
pparser, pastree;
const
+ sEMBEDDED_TYPE = '_E_T_';
sEXTERNAL_NAME = '_E_N_';
sATTRIBUTE = '_ATTRIBUTE_';
sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME';
@@ -409,6 +410,7 @@ begin
AddSystemSymbol(Result,AContainer);
AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType);
AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType);
+ AContainer.RegisterExternalAlias(AddClassDef(Result,'schema_Type','TAbstractSimpleRemotable'),'schema');
AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable'),'date');
AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateTimeRemotable','TAbstractSimpleRemotable'),'dateTime');
{$IFDEF WST_HAS_TDURATIONREMOTABLE}
diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas
index fe46ed631..6c47bc716 100644
--- a/wst/trunk/ws_helper/ws_parser_imp.pas
+++ b/wst/trunk/ws_helper/ws_parser_imp.pas
@@ -51,6 +51,8 @@ type
) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement;
function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
+ procedure SetAsEmbeddedType(AType : TPasType);
+ function IsEmbeddedType(AType : TPasType) : Boolean;
{$IFDEF WST_HANDLE_DOC}
procedure ParseDocumentation(AType : TPasType);
{$ENDIF WST_HANDLE_DOC}
@@ -353,6 +355,16 @@ begin
Result := '';
end;
+procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType);
+begin
+ FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,'1');
+end;
+
+function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean;
+begin
+ Result := ( FSymbols.Properties.GetValue(AType,sEMBEDDED_TYPE) = '1' );
+end;
+
{$IFDEF WST_HANDLE_DOC}
procedure TAbstractTypeParser.ParseDocumentation(AType : TPasType);
var
@@ -1049,10 +1061,10 @@ begin
internalName := ExtractIdentifier(ATypeName);
hasInternalName := IsReservedKeyWord(internalName) or
( not IsValidIdent(internalName) ) or
- //( FSymbols.IndexOf(internalName) <> -1 ) or
+ ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or
( not AnsiSameText(internalName,ATypeName) );
if hasInternalName then begin
- internalName := Format('_%s',[internalName]);
+ internalName := Format('%s_Type',[internalName]);
end;
if ( pthDeriveFromSoapArray in FHints ) or
@@ -1379,7 +1391,8 @@ begin
if Assigned(locSym) then begin
if not locSym.InheritsFrom(TPasType) then
raise EXsdParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]);
- locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef);
+ locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef) or
+ ( IsEmbeddedType(TPasType(locSym)) <> FEmbededDef );
if not locContinue then;
Result := locSym as TPasType;
end;
diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas
index 47951d591..0ec3fdd05 100644
--- a/wst/trunk/ws_helper/wsdl_parser.pas
+++ b/wst/trunk/ws_helper/wsdl_parser.pas
@@ -75,7 +75,11 @@ type
const ASoapBindingStyle : string
) : TPasProcedure;
function GetParser(const ANamespace : string) : IXsdPaser;
- function ParseType(const AName : string; const AHint : string = '') : TPasType;
+ function ParseType(
+ const AName : string;
+ const AHint : string = '';
+ const ATypeOrElement : string = ''
+ ) : TPasType;
procedure ParseTypes();
protected
function GetXsShortNames() : TStrings;
@@ -300,6 +304,7 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin
schmNode, tmpNode : TDOMNode;
s : string;
typeList : TList;
+ locXsdParser : IXsdPaser;
begin
if Assigned(FSchemaCursor) then begin
FSchemaCursor.Reset();
@@ -323,7 +328,8 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin
tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym));
if Assigned(tmpNode) then begin
//symNew := ParseType(FSymbols.GetExternalName(sym));
- symNew := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue).ParseType(FSymbols.GetExternalName(sym));
+ locXsdParser := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue);
+ symNew := locXsdParser.ParseType(FSymbols.GetExternalName(sym),tmpNode);
//symNew := ParseType(tmpNode.Attributes.GetNamedItem(s_name).NodeValue);
if ( sym <> symNew ) then begin
FModule.InterfaceSection.Declarations.Extract(sym);
@@ -460,7 +466,7 @@ function TWsdlParser.ParseOperation(
function GetDataType(const AName, ATypeOrElement : string; const ATypeHint : string = ''):TPasType;
begin
try
- Result := ParseType(AName,ATypeHint);
+ Result := ParseType(AName,ATypeHint,ATypeOrElement);
except
on e : Exception do begin
DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement);
@@ -578,7 +584,9 @@ function TWsdlParser.ParseOperation(
prmName := ExtractNameFromQName(prmTypeName);
end;
prmInternameName := Trim(prmName);
- if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
+ if AnsiSameText(prmInternameName,tmpMthd.Name) or
+ AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName))
+ then begin
prmInternameName := prmInternameName + 'Param';
end;
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
@@ -1176,11 +1184,16 @@ begin
end;
end;
-function TWsdlParser.ParseType(const AName : string; const AHint : string) : TPasType;
+function TWsdlParser.ParseType(
+ const AName : string;
+ const AHint : string;
+ const ATypeOrElement : string
+) : TPasType;
var
localName, spaceShort, spaceLong : string;
locPrs : IXsdPaser;
xsdModule : TPasModule;
+ locTypeKind : string;
begin
ExplodeQName(AName,localName,spaceShort);
if ( FXSShortNames.IndexOf(spaceShort) >= 0 ) then begin
@@ -1196,7 +1209,11 @@ begin
if not FindNameSpace(spaceShort,spaceLong) then
raise EXsdParserAssertException.CreateFmt('Unable to resolve the namespace : "%s".',[spaceShort]);
locPrs := GetParser(spaceLong);
- Result := locPrs.ParseType(AName);
+ if ( ATypeOrElement = s_element ) then
+ locTypeKind := s_element
+ else
+ locTypeKind := '';
+ Result := locPrs.ParseType(AName,locTypeKind);
end;
end;
diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas
index 3cfcac9fd..8ef319e93 100644
--- a/wst/trunk/ws_helper/xsd_parser.pas
+++ b/wst/trunk/ws_helper/xsd_parser.pas
@@ -55,7 +55,14 @@ type
IXsdPaser = interface
['{F0CEC726-A068-4CCC-B1E7-D31F018415B2}']
- function ParseType(const AName : string) : TPasType;
+ function ParseType(
+ const AName,
+ ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" }
+ ) : TPasType; overload;
+ function ParseType(
+ const AName : string;
+ const ATypeNode : TDOMNode
+ ) : TPasType; overload;
procedure ParseTypes();
procedure SetNotifier(ANotifier : TOnParserMessage);
end;
@@ -90,6 +97,10 @@ type
function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings;
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
procedure SetNotifier(ANotifier : TOnParserMessage);
+ function InternalParseType(
+ const AName : string;
+ const ATypeNode : TDOMNode
+ ) : TPasType;
public
constructor Create(
ADoc : TXMLDocument;
@@ -98,7 +109,15 @@ type
AParentContext : IParserContext
);
destructor Destroy();override;
- function ParseType(const AName : string) : TPasType;
+ function ParseType(
+ const AName,
+ ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" }
+ ) : TPasType; overload;
+ function ParseType(
+ const AName : string;
+ const ATypeNode : TDOMNode
+ ) : TPasType; overload;
+
procedure ParseTypes();
function GetTargetNameSpace() : string;
@@ -296,7 +315,23 @@ begin
Result := FXSShortNames;
end;
-function TCustomXsdSchemaParser.ParseType(const AName: string): TPasType;
+function TCustomXsdSchemaParser.ParseType(const AName, ATypeKind : string): TPasType;
+begin
+ Result := InternalParseType(AName,nil);
+end;
+
+function TCustomXsdSchemaParser.ParseType(
+ const AName : string;
+ const ATypeNode : TDOMNode
+) : TPasType;
+begin
+ Result := InternalParseType(AName,ATypeNode);
+end;
+
+function TCustomXsdSchemaParser.InternalParseType(
+ const AName : string;
+ const ATypeNode : TDOMNode
+): TPasType;
var
crsSchemaChild : IObjectCursor;
typNd : TDOMNode;
@@ -324,7 +359,10 @@ var
begin
ASimpleTypeAlias := nil;
Result := True;
- typNd := FindNamedNode(crsSchemaChild,localTypeName);
+ if ( ATypeNode <> nil ) then
+ typNd := ATypeNode
+ else
+ typNd := FindNamedNode(crsSchemaChild,localTypeName);
if not Assigned(typNd) then
raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]);
if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin
@@ -432,6 +470,7 @@ var
sct : TPasSection;
shortNameSpace, longNameSpace : string;
typeModule : TPasModule;
+ locTypeNodeFound : Boolean;
begin
sct := nil;
DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName]));
@@ -449,6 +488,14 @@ begin
if ( typeModule = nil ) then
raise EXsdTypeNotFoundException.Create(AName);
Result := SymbolTable.FindElementInModule(localTypeName,typeModule) as TPasType;
+ Init();
+ locTypeNodeFound := FindTypeNode(aliasType);
+ if ( Result <> nil ) and ( typeModule = FModule ) and
+ ( not Result.InheritsFrom(TPasUnresolvedTypeRef) )
+ then begin
+ if locTypeNodeFound and ( embededType <> ( SymbolTable.Properties.GetValue(Result,sEMBEDDED_TYPE) = '1' ) ) then
+ Result := nil;
+ end;
if ( ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) ) and
( typeModule = FModule )
then begin
@@ -456,7 +503,7 @@ begin
frwType := Result;
Result := nil;
Init();
- if FindTypeNode(aliasType) then begin
+ if locTypeNodeFound {FindTypeNode(aliasType)} then begin
if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin
Result := ParseComplexType();
end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin
@@ -520,8 +567,9 @@ begin
typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
typTmpCrs.Reset();
if typTmpCrs.MoveNext() then begin
- ParseType(
- (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue
+ InternalParseType(
+ (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,
+ typNode
);
end;
end;