You've already forked lazarus-ccr
Preparing Type name and Element disambiguation
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@950 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
<Version Value="8"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="..\..\"/>
|
||||
<OtherUnitFiles Value="..\..\;$(LazarusDir)\others_package\indy-10.2.0.3\fpc\"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -163,7 +163,7 @@ procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||
{else
|
||||
ShowMessage(AStr)};
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
s : TBinaryString;
|
||||
{$ENDIF}
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
Reference in New Issue
Block a user