xsbuiltins.pas

Delphi的Soap一些使用功能控件

                            const ObjConverter: IObjConverter;
                            const Name, URI: InvString; ObjConvOpts: TObjectConvertOptions;
                            out RefID: InvString): IXMLNode; override;
    procedure  SOAPToObject(const RootNode, Node: IXMLNode; const ObjConverter: IObjConverter); override;
    procedure  LoadFomXML(const XML: string); overload;
    procedure  LoadFromXML(const XML: WideString); overload;

    property XMLNode: IXMLNode read FXMLNode;
end;

{ Utility function }

{ XML DateTime <-> Delphi TDateTime conversion routines }
function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
function XMLTimeToDateTime(const XMLDateTime: WideString; AsUTCTime: Boolean = False): TDateTime;

{ Utility function for TDateTime -> TXSDateTime conversion }
function DateTimeToXSDateTime(const Value: TDateTime; ApplyLocalBias: Boolean = False): TXSDateTime;

function GetDataFromFile(AFileName: string): string;
function SoapFloatToStr(Value: double): string;
function SoapStrToFloat(Value: string): double;

procedure InitXSTypes;

implementation

uses SOAPConst, {$IFDEF MSWINDOWS}Windows{$ENDIF}{$IFDEF LINUX}Libc{$ENDIF},
     DateUtils, XMLDoc;

type

{ TXSBaseTime }

TXSBaseTime = class
  private
    FFractionalSecondString: string;
    FHour: Word;
    FHourOffset: Word;
    FMinute: Word;
    FMinuteOffset: Word;
    FNegativeOffset: Boolean;
    FSecond: Word;
    FUseZeroMilliseconds: Boolean;
    function BuildHourOffset: WideString;
    function IntToFractionalSeconds(Value: Word): string;
  protected
    function GetAsTime: TDateTime;
    function GetFractionalSeconds: Double;
    function GetFractionalSecondString: string;
    function GetHourOffset: SmallInt;
    function GetMillisecond: Word;
    function GetMinuteOffset: SmallInt;
    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 FHour 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 FMinute write SetMinute default 0;
    property MinuteOffset: SmallInt read GetMinuteOffset write SetMinuteOffset;
    property Second: Word read FSecond write SetSecond default 0;
    property UseZeroMilliseconds: Boolean read FUseZeroMilliseconds write
             FUseZeroMilliseconds;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString);
{$ELSE}
    procedure XSToNative(Value: WideString);
{$ENDIF}
    function NativeToXS: WideString;
end;

{ TXSBaseDate }

TXSBaseDate = class
  private
    { place holder for future work supporting years with greater than 4 digits }
    FAdditionalYearDigits: Word;
    FMonth: Word;
    FDay: Word;
    FYear: Integer;
    FNegativeDate: Boolean;
  protected
    function GetAsDate: TDateTime;
    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;
    property Month: Word read FMonth write SetMonth default 0;
    property Day: Word read FDay write SetDay default 0;
    property Year: Integer read GetYear write SetYear default 0;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString);
{$ELSE}
    procedure XSToNative(Value: WideString);
{$ENDIF}
    function NativeToXS: WideString;
    property AsDate: TDateTime read GetAsDate write SetAsDate;
end;

{ TXSBaseCustomDateTime }

TXSBaseCustomDateTime = class
  private
    FDateParam: TXSBaseDate;
    FTimeParam: TXSBaseTime;
    procedure SetUseZeroMilliseconds(const Value: Boolean);
    function GetUseZeroMilliseconds: Boolean;
  protected
    procedure AdjustDate(Reverse: Boolean); virtual;
    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 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 SetYear(const Value: Integer); virtual;
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
  public
    constructor Create;
    destructor Destroy; override;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString);
{$ELSE}
    procedure XSToNative(Value: WideString);
{$ENDIF}
    function NativeToXS: WideString;
    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;

{ TXSBaseDateTime }

TXSBaseDateTime = class(TXSBaseCustomDateTime)
  public
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
end;

TXSBaseDuration = class(TXSBaseCustomDateTime)
  private
    FDecimalSecond: Double;
    function GetDecimalValue(const AParam: String; const AType: string): Double;
    function GetIntegerValue(const AParam: String; const AType: string): Integer;
    function GetNumericString(const AParam: string; const AType: String;
             const Decimals: Boolean = False): WideString;
  protected
    procedure SetDecimalSecond(const Value: Double);
  public
    constructor Create;
{$IFDEF CONST_XS_TO_NATIVE}
    procedure XSToNative(const Value: WideString);
{$ELSE}
    procedure XSToNative(Value: WideString);
{$ENDIF}
    function NativeToXS: WideString;
    function NativeToXSAsDateTime: WideString;
    procedure XSToNativeAsDateTime(const Value: WideString);
    property DecimalSecond: Double read FDecimalSecond write SetDecimalSecond;
end;

  { Record that holds Duration Data }
  TDurationData = record
    Year: Integer;
    Month: Integer;
    Day: Integer;
    Hour: Integer;
    Minute: Integer;
    Second: Double;
    Negative: Boolean;
  end;

DurationDataFlag = (ddYear, ddMonth, ddDay, ddHour, ddMinute, ddSecond);
TDurationDataFlags = set of DurationDataFlag;

function IsDurationType(const DateTimeStr: WideString): Boolean;
begin
  Result := (Length(DateTimeStr) > 2) and
             (DateTimeStr[1] = XMLDurationStart) or
             (DateTimeSTr[1] = '-');
end;

{ exception routines }

procedure SoapDateTimeError(const Message: string); local;
begin
  raise EXSDateTimeException.Create(Message);
end;

procedure SoapDateTimeErrorFmt(const Message: string; const Args: array of const); local;
begin
  SoapDateTimeError(Format(Message,Args));
end;

procedure SoapDecimalError(const Message: string); local;
begin
  raise EXSDecimalException.Create(Message);
end;

procedure SoapDecimalErrorFmt(const Message: string; const Args: array of const); local;
begin
  SoapDecimalError(Format(Message,Args));
end;

procedure SoapHexBinaryError(const Message: string); local;
begin
  raise EXSHexBinaryException.Create(Message);
end;

procedure SoapHexBinaryErrorFmt(const Message: string; const Args: array of const); local;
begin
  SoapHexBinaryError(Format(Message,Args));
end;

{ utility functions }

type
  PFormatSettings = ^TFormatSettings;

var
  FormatSettings : TFormatSettings;

function GetFormatSettings: PFormatSettings;
begin
  if FormatSettings.DecimalSeparator <> SoapDecimalSeparator then
  begin
    GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FormatSettings);
    FormatSettings.DecimalSeparator := SoapDecimalSeparator;
  end;
  Result := @FormatSettings;
end;

function SoapFloatToStr(Value: double): string;
begin
  Result := FloatToStr(Value, GetFormatSettings^);
end;

function SoapStrToFloat(Value: string): double;
begin
  Result := StrToFloat(Value, GetFormatSettings^);
end;

function EncodeDuration(const Data: TDurationData): WideString;
const
  sNegPrefix: array[Boolean] of string = ('', '-');
begin
  Result := Format('%sP%dY%dM%dD%dH%dM%sS', [sNegPrefix[Data.Negative],
                                             Data.Year, Data.Month, Data.Day,
                                             Data.Hour, Data.Minute,
                                             SoapFloatToStr(Data.Second)]);
end;

procedure DecodeDuration(const ADuration: string;
                         out Data: TDurationData;
                         Flags: TDurationDataFlags = []);

  function GetNumberBefore(const ASeparator: string;
                           const Decimals: Boolean = False): String;
  var
    I, J: Integer;
  begin
    I := Pos(ASeparator, ADuration);
    J := I;
    while (I > 0) and ((ADuration[I-1] in ['0'..'9']) or
          (Decimals and (ADuration[I-1] = '.'))) do
      Dec(I);
    if J > I then
      Result := Copy(ADuration, I, J-I)
    else
      Result := '0';
  end;

  function GetNumber(const ASeparator: string): Integer;
  begin
    Result := StrToInt(GetNumberBefore(ASeparator));
  end;

  function GetDouble(const ASeparator: string): Double;
  begin
    Result := SoapStrToFloat(GetNumberBefore(ASeparator, True));
  end;

var
  Flag: DurationDataFlag;
begin
  { "The designator 'P' must be present"
    "...at least one number and its designator 穖ust