xsbuiltins.pas

Delphi的Soap一些使用功能控件

{*******************************************************}
{                                                       }
{ Borland Delphi Visual Component Library               }
{                SOAP Support                           }
{                                                       }
{ Copyright (c) 2001 Borland Software Corporation       }
{                                                       }
{*******************************************************}

unit XSBuiltIns;

{$IFNDEF VER150}
{$INCLUDE 'CompVer.inc'}
{$ENDIF}

interface

uses SysUtils, InvokeRegistry, Classes, FMTBcd, Types, XmlIntf;

const
  SHexMarker               = '$';      { do not localize }
  SoapTimePrefix           = 'T';      { do not localize }
  XMLDateSeparator         = '-';      { do not localize }
  XMLHourOffsetMinusMarker = '-';      { do not localize }
  XMLHourOffsetPlusMarker  = '+';      { do not localize }
  XMLTimeSeparator         = ':';      { do not localize }
  XMLMonthPos              = 6;
  XMLDayPos                = 9;
  XMLYearPos               = 1;
  XMLMilSecPos             = 10;
  XMLDefaultYearDigits     = 4;
  XMLDurationStart         = 'P';      { do not localize }
  XMLDurationYear          = 'Y';      { do not localize }
  XMLDurationMonth         = 'M';      { do not localize }
  XMLDurationDay           = 'D';      { do not localize }
  XMLDurationHour          = 'H';      { do not localize }
  XMLDurationMinute        = 'M';      { do not localize }
  XMLDurationSecond        = 'S';      { do not localize }
  SNAN                     = 'NAN';    { do not localize }
  SSciNotationMarker: Char = 'E';      { do not localize }
  SDecimal: Char           = '.';      { do not localize }
  SNegative: Char          = '-';      { do not localize }
  SPlus: Char              = '+';      { do not localize }
  SLocalTimeMarker         = 'Z';      { do not localize }
  MaxMonth                 = 12;
  MinMonth                 = 1;
  MaxDay                   = 31;
  MinDay                   = 1;
  SoapDecimalSeparator     = '.';

  IncrementAmount: array[Boolean] of Integer = (1, -1);

type

{ forward declarations }

TXSDuration = class;
TXSTime = class;
TXSDate = class;
TXSDateTime = class;

{ TXSTime }

TXSTime = class(TRemotableXS)
  private
    FTimeValue: WideString;
    FUseZeroMilliseconds: Boolean;
  protected
    function GetAsTime: TDateTime;
    function GetFractionalSeconds: Double;
    function GetFractionalSecondString: string;
    function GetHourOffset: SmallInt;
    function GetHour: Word;
    function GetMillisecond: Word;
    function GetMinute: Word;
    function GetMinuteOffset: SmallInt;
    function GetSecond: Word;
    procedure SetAsTime(const Value: TDateTime);
    procedure SetFractionalSeconds(const Value: Double);
    procedure SetHour(const Value: Word);
    procedure SetHourOffset(const Value: SmallInt);
    procedure SetMillisecond(const Value: Word);
    procedure SetMinute(const Value: Word);
    procedure SetMinuteOffset(const Value: SmallInt);
    procedure SetSecond(const Value: Word);
    property FractionalSecondString: string read GetFractionalSecondString;
  public
    property AsTime: TDateTime read GetAsTime write SetAsTime;
    property FractionalSeconds: Double read GetFractionalSeconds write
             SetFractionalSeconds;
    property Hour: Word read GetHour write SetHour default 0;
    property HourOffset: SmallInt read GetHourOffset write SetHourOffset default 0;
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
    property Minute: Word read GetMinute write SetMinute default 0;
    property MinuteOffset: SmallInt read GetMinuteOffset write SetMinuteOffset;
    property Second: Word read GetSecond write SetSecond default 0;
    property UseZeroMilliseconds: Boolean read FUseZeroMilliseconds write
             FUseZeroMilliseconds;
    function Clone: TXSTime;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function NativeToXS: WideString; override;
end;

{ TXSDate }

TXSDate = class(TRemotableXS)
  private
    FDateValue: WideString;
  protected
    function GetAsDate: TDateTime;
    function GetDay: Word;
    function GetMonth: Word;
    function GetYear: Integer;
    procedure SetAsDate(const Value: TDateTime);
    procedure SetMonth(const Value: Word);
    procedure SetDay(const Value: Word);
    procedure SetYear(const Value: Integer);
  public
    constructor Create; override;
    property Month: Word read GetMonth write SetMonth default 0;
    property Day: Word read GetDay write SetDay default 0;
    property Year: Integer read GetYear write SetYear default 0;
    function Clone: TXSDate;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function NativeToXS: WideString; override;
    property AsDate: TDateTime read GetAsDate write SetAsDate;
end;

{ TXSCustomDateTime }

TXSCustomDateTime = class(TRemotableXS)
  protected
    FDateTime: WideString;
    function GetAsDateTime: TDateTime;
    function GetAsUTCDateTime: TDateTime;
    function GetDay: Word;
    function GetFractionalSeconds: Double;
    function GetHour: Word;
    function GetHourOffset: SmallInt;
    function GetMonth: Word;
    function GetMillisecond: Word;
    function GetMinute: Word;
    function GetMinuteOffset: SmallInt;
    function GetSecond: Word;
    function GetUseZeroMilliseconds: Boolean;
    function GetYear: Integer;
    procedure SetAsDateTime(const Value: TDateTime);
    procedure SetAsUTCDateTime(const Value: TDateTime);
    procedure SetFractionalSeconds(const Value: Double);
    procedure SetDay(const Value: Word); virtual;
    procedure SetHour(const Value: Word); virtual;
    procedure SetHourOffset(const Value: SmallInt); virtual;
    procedure SetMillisecond(const Value: Word); virtual;
    procedure SetMinute(const Value: Word); virtual;
    procedure SetMinuteOffset(const Value: SmallInt); virtual;
    procedure SetMonth(const Value: Word); virtual;
    procedure SetSecond(const Value: Word); virtual;
    procedure SetUseZeroMilliseconds(const Value: Boolean);
    procedure SetYear(const Value: Integer); virtual;
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
  public
    constructor Create;  override;
    destructor Destroy; override;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsUTCDateTime: TDateTime read GetAsUTCDateTime write SetAsUTCDateTime;
    property FractionalSeconds: Double read GetFractionalSeconds write
             SetFractionalSeconds;
    property Hour: Word read GetHour write SetHour default 0;
    property HourOffset: SmallInt read GetHourOffset write SetHourOffset default 0;
    property Minute: Word read GetMinute write SetMinute default 0;
    property MinuteOffset: SmallInt read GetMinuteOffset write SetMinuteOffset default 0;
    property Second: Word read GetSecond write SetSecond default 0;
    property Month: Word read GetMonth write SetMonth default 0;
    property Day: Word read GetDay write SetDay default 0;
    property Year: Integer read GetYear write SetYear default 0;
    property UseZeroMilliseconds: Boolean read GetUseZeroMilliseconds write
             SetUseZeroMilliseconds;
end;

{ TXSDateTime }

TXSDateTime = class(TXSCustomDateTime)
  public
    function Clone: TXSDateTime;
    function CompareDateTimeParam(const Value1, Value2: TXSDateTime): TXSDuration;
    function NativeToXS: WideString; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
end;

{ TXSDuration }

{ Backward compatible definition that was incorrectly based on DateTime:(
  In a future release TXSDuration should be lightened }
TXSDuration = class(TXSCustomDateTime)
  protected
    function GetDecimalSecond: Double;
    procedure SetDecimalSecond(const Value: Double);
  public
    constructor Create; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function NativeToXS: WideString; override;
    property DecimalSecond: Double read GetDecimalSecond write SetDecimalSecond;
end;

{ NOTE: These classes should derive from ERemotableException so we can
        send better SOAP faults across the wire?? }
EXSDateTimeException  = class(Exception);
EXSDecimalException   = class(Exception);
EXSHexBinaryException = class(Exception);

{ TXSHexBinary }
TXSHexBinary = class(TRemotableXS)
  private
    FHexBinaryString: string;
    procedure  SetAsByteArray(const Value: TByteDynArray);
    function   GetAsByteArray: TByteDynArray;
  public
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function  NativeToXS: WideString; override;
    property  HexBinaryString: string read FHexBinaryString write FHexBinaryString;
    property  AsByteArray: TByteDynArray read GetAsByteArray write SetAsByteArray;
end;

{ TXSDecimal }
{ Rudimentary support (strictly to handle xsd:decimal) for now }
TXSDecimal = class(TRemotableXS)
  private
    FDecimalString: string;
    function GetAsBcd: TBcd;
    procedure SetAsBcd(const Value: TBcd);
  public
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function  NativeToXS: WideString; override;
    property  DecimalString: string read FDecimalString write FDecimalString;
    property  AsBcd: TBcd read GetAsBcd write SetAsBcd;
end;

{ TXSString - for xsd:string and any other XML Data Types where nillable support
              is required }
TXSString = class(TRemotableXS)
  private
    FString: WideString;
  public
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    function  NativeToXS: WideString; override;
  end;

TXSTimeInstant = TXSDateTime;

{ TXSBoolean - for xsd:boolean that require nillable support }
TXSBoolean = class(TRemotableXS)
  private
    FBoolean: Boolean;
  public
    function  NativeToXS: WideString; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    property AsBoolean: Boolean read FBoolean write FBoolean;
end;

{ TXSInteger - for xsd:int that require nillable support }
TXSInteger = class(TRemotableXS)
  private
    FInteger: Integer;
  public
    function  NativeToXS: WideString; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    property AsInteger: Integer read FInteger write FInteger;
end;

{ TXSLong - for xsd:long that require nillable support }
TXSLong = class(TRemotableXS)
  private
    FLong: Int64;
  public
    function  NativeToXS: WideString; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString); override;
{$ELSE}
    procedure XSToNative(Value: WideString); override;
{$ENDIF}
    property AsLong: Int64 read FLong write FLong;
end;

{ For cases where one needs access to the raw XMLNode data in a SOAP envelope }
TXMLData = class(TRemotable)
  private
    FXMLDocument: IXMLDocument;
    FXMLNode: IXMLNode;
  public
    constructor Create; override;
    destructor  Destroy; override;
    function   ObjectToSOAP(RootNode, ParentNode: IXMLNode;