xsbuiltins.pas

Delphi开发webservice的一套例子

procedure TXSTime.SetAsTime(Value: TDateTime);
begin
  DecodeTime(Value, FHour, FMinute, FSecond, FMillisecond);
end;
function TXSTime.GetAsTime: TDateTime;
var
  TimeString: string;
  Colon: string;
begin
  Colon := TimeSeparator;
  TimeString := IntToStr(Hour) + Colon + IntToStr(Minute) + Colon +
                IntToStr(Second);
  Result := StrToTime(TimeString);
end;

{ TXSDate }

constructor TXSDate.Create;
begin
  inherited Create;
  FMaxMonth := 12;
  FMinMonth := 1;
  FMaxDay := 31;
  FMinDay := 1;
end;

function TXSDate.Clone: TXSDate;
begin
  Result := TXSDate.Create;
  Result.Day := Day;
  Result.Month := Month;
  Result.Year := Year;
end;

procedure TXSDate.SetMonth(const Value: Word);
begin
  if (Value <= FMaxMonth) and (Value >= FMinMonth) then
    FMonth := Value
  else
    SoapDateTimeErrorFmt(SInvalidMonth, [Value]);
end;

procedure TXSDate.SetDay(const Value: Word);
begin
  { Perform more complete check when all values set }
  if (Value <= FMaxDay) and (Value >= FMinDay) then
    FDay := Value
  else
    SoapDateTimeErrorFmt(SInvalidDay, [Value]);
end;

procedure TXSDate.SetYear(const Value: Word);
begin
  FYear := Value
end;

procedure TXSDate.XSToNative(Value: WideString);
begin
  ParseXMLDate(Value, FYear, FMonth, FDay);
end;

function TXSDate.NativeToXS: WideString;
var
  TempDate: TDateTime;
  FormatString: string;
begin
  if Year + Month + Day = 0 then exit;
  TempDate := EncodeDate(Year, Month, Day);   { Exception thrown if invalid }
  FormatString := Format('yyyy%smm%sdd', [XMLDateSeparator, XMLDateSeparator]);
  Result := FormatDateTime(FormatString, TempDate);
end;

function TXSDate.GetAsDate: TDateTime;
var
  DateString: string;
  Slash: string;
begin
  Slash := DateSeparator;
  DateString := IntToStr(Month) + Slash + IntToStr(Day) + Slash + IntToStr(Year);
  Result := StrToDate(DateString);
end;

procedure TXSDate.SetAsDate(Value: TDateTime);
begin
  DecodeDate(Value, FYear, FMonth, FDay);
end;

{ TXSCustomDateTime }

constructor TXSCustomDateTime.Create;
begin
  Inherited Create;
  FDateParam := TXSDate.Create;
  FTimeParam := TXSTime.Create;
end;

destructor TXSCustomDateTime.Destroy;
begin
  FDateParam.Free;
  FTimeParam.Free;
  inherited Destroy;
end;

function TXSCustomDateTime.GetHour: Word;
begin
  Result := FTimeParam.Hour;
end;

function TXSCustomDateTime.GetMinute: Word;
begin
  Result := FTimeParam.Minute;
end;

function TXSCustomDateTime.GetSecond: Word;
begin
  Result := FTimeParam.Second;
end;

function TXSCustomDateTime.GetMilliSecond: Word;
begin
  Result := FTimeParam.MilliSecond;
end;

function TXSCustomDateTime.GetHourOffset: SmallInt;
begin
  Result := FTimeParam.HourOffset;
end;

function TXSCustomDateTime.GetMinuteOffset: SmallInt;
begin
  Result := FTimeParam.MinuteOffset;
end;

function TXSCustomDateTime.GetMonth: Word;
begin
  Result := FDateParam.Month;
end;

function TXSCustomDateTime.GetDay: Word;
begin
  Result := FDateParam.Day;
end;

function TXSCustomDateTime.GetYear: Word;
begin
  Result := FDateParam.Year;
end;

procedure TXSCustomDateTime.SetHour(const Value: Word);
begin
  FTimeParam.SetHour(Value);
end;

procedure TXSCustomDateTime.SetMinute(const Value: Word);
begin
  FTimeParam.SetMinute(Value);
end;

procedure TXSCustomDateTime.SetSecond(const Value: Word);
begin
  FTimeParam.SetSecond(Value);
end;

procedure TXSCustomDateTime.SetMillisecond(const Value: Word);
begin
  FTimeParam.SetMillisecond(Value);
end;

procedure TXSCustomDateTime.SetHourOffset(const Value: SmallInt);
begin
  FTimeParam.SetHourOffset(Value);
end;

procedure TXSCustomDateTime.SetMinuteOffset(const Value: SmallInt);
begin
  FTimeParam.SetMinuteOffset(Value);
end;

procedure TXSCustomDateTime.SetMonth(const Value: Word);
begin
  FDateParam.SetMonth(Value);
end;

procedure TXSCustomDateTime.SetDay(const Value: Word);
begin
  FDateParam.SetDay(Value);
end;

procedure TXSCustomDateTime.SetYear(const Value: Word);
begin
  FDateParam.SetYear(Value);
end;

procedure TXSCustomDateTime.SetAsDateTime(Value: TDateTime);
begin
  FDateParam.AsDate := Value;
  FTimeParam.AsTime := Value;
end;

function TXSCustomDateTime.GetAsDateTime: TDateTime;
begin
  Result := EncodeDateTime(Year, Month, Day, Hour, Minute, Second, 0);
end;

{ TXSDateTime }

function TXSDateTime.Clone: TXSDateTime;
begin
  Result := TXSDateTime.Create;
  Result.FDateParam.Day := Day;
  Result.FDateParam.Month := Month;
  Result.FDateParam.Year := Year;
  Result.FTimeParam.Hour := Hour;
  Result.FTimeParam.Minute := Minute;
  Result.FTimeParam.Second := Second;
  Result.FTimeParam.MilliSecond := MilliSecond;
  Result.FTimeParam.HourOffset := HourOffset;
  Result.FTimeParam.MinuteOffset := MinuteOffset;
end;

procedure TXSDateTime.XSToNative(Value: WideString);
var
  TimeString, DateString: WideString;
  TimePosition: Integer;
begin
  TimePosition := Pos(SoapTimePrefix, Value);
  if TimePosition > 0 then
  begin
    DateString := Copy(Value, 1, TimePosition -1);
    TimeString := Copy(Value, TimePosition + 1, Length(Value) - TimePosition);
    FDateParam.XSToNative(DateString);
    FTimeParam.XSToNative(TimeString);
  end else
    FDateParam.XSToNative(Value);
end;

function TXSDateTime.NativeToXS: WideString;
var
  TimeString: WideString;
begin
  TimeString := FTimeParam.NativeToXS;
  if TimeString <> '' then
    Result := FDateParam.NativeToXS + SoapTimePrefix + TimeString
  else
    Result := FDateParam.NativeToXS;
end;

function TXSDateTime.ValidValue(Value, Subtract, Min, Max: Integer; var Remainder: Integer): Integer;
begin
  Result := Value - Subtract;
  Remainder := 0;
  if Result < Min then
  begin
    Remainder := 1;
    Inc(Result,Max);
  end;
end;

function TXSDateTime.CompareDateTimeParam(const Value1, Value2: TXSDateTime): TXSDuration;
var
  Remainder, Milliseconds, Seconds: Integer;
begin
    Result := TXSDuration.Create;
    try
      MilliSeconds := ValidValue(Value1.Millisecond, Value2.Millisecond, 0, 1000, Remainder);
      Seconds := ValidValue(Value1.Second + Remainder, Value2.Second, 0, 60, Remainder);
      Result.DecimalSecond := Seconds + Milliseconds / 1000;
      Result.Minute := ValidValue(Value1.Minute + Remainder, Value2.Minute, 0, 60, Remainder);
      Result.Hour := ValidValue(Value1.Hour + Remainder, Value2.Hour, 0, 24, Remainder);
      Result.Day := ValidValue(Value1.Day + Remainder, Value2.Day, 0, 31, Remainder);
      Result.Month := ValidValue(Value1.Month + Remainder, Value2.Month, 0, 12, Remainder);
      Result.Year := ValidValue(Value1.Year + Remainder, Value2.Year, -9999, 0, Remainder);
    except
      Result.Free;
      Result := nil;
    end;
end;

{ TXSDuration }

constructor TXSDuration.Create;
begin
  inherited Create;
  FDateParam.MaxDay := 30;
  FDateParam.MinDay := 0;
  FDateParam.MaxMonth := 11;
  FDateParam.MinMonth := 0;
end;

procedure TXSDuration.SetDecimalSecond(const Value: Double);
begin
  if Value < 60 then
    FDecimalSecond := Value
  else
    SoapDateTimeErrorFmt(SInvalidFractionSecond, [Value]);
end;

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

function TXSDuration.GetIntegerValue(const AParam: string; const AType: string): Integer;
begin
  Result := StrToInt(GetNumericString(AParam, AType));
end;

function TXSDuration.GetDecimalValue(const AParam: string; const AType: string): Double;
begin
  Result := StrToFloat(GetNumericString(AParam, AType, True));
end;

procedure TXSDuration.XSToNative(Value: WideString);
var
  DateString, TimeString: string;
  TimePosition: Integer;
begin
  if Value[1] <> XMLDurationStart then
    SoapDateTimeErrorFmt(SInvalidDuration, [Value]);
  TimePosition := Pos(SoapTimePrefix, Value);
  if TimePosition > 0 then
  begin
    TimeString := Copy(Value, TimePosition + 1, Length(Value) - TimePosition);
    DateString := Copy(Value, 1, TimePosition - 1);
  end else
    DateString := Value;
  Year := GetIntegerValue(DateString, XMLDurationYear);
  Month := GetIntegerValue(DateString, XMLDurationMonth);
  Day := GetIntegerValue(DateString, XMLDurationDay);
  if TimePosition > 0 then
  begin
    Hour := GetIntegerValue(TimeString, XMLDurationHour);
    Minute := GetIntegerValue(TimeString, XMLDurationMinute);
    DecimalSecond := GetDecimalValue(TimeString, XMLDurationSecond);
  end;
end;

{ Format is 'P1Y2M3DT10H30M12.3S' }
function TXSDuration.NativeToXS: WideString;
begin
  Result := XMLDurationStart +
              IntToStr(Year) + XMLDurationYear +
              IntToStr(Month) + XMLDurationMonth +
              IntToStr(Day) + XMLDurationDay + SoapTimePrefix +
              IntToStr(Hour) + XMLDurationHour +
              IntToStr(Minute) + XMLDurationMinute +
              FloatToStr(DecimalSecond) + XMLDurationSecond;
end;

{ TXSHexBinary }

function TXSHexBinary.NativeToXS: WideString;
begin
  Result := FHexBinaryString;
end;

procedure TXSHexBinary.XSToNative(Value: WideString);
begin
  FHexBinaryString := Value;
end;

{ TXSDecimal }

function TXSDecimal.NativeToXS: WideString;
begin
  Result := FDecimalString;
end;

procedure TXSDecimal.XSToNative(Value: WideString);
begin
  FDecimalString := Value;
end;


initialization
  RemClassRegistry.RegisterXSClass(TXSDateTime, XMLSchemaNameSpace, 'dateTime', '',True);
  RemClassRegistry.RegisterXSClass(TXSTime, XMLSchemaNameSpace, 'time', '', True);
  RemClassRegistry.RegisterXSClass(TXSDate, XMLSchemaNameSpace, 'date', '', True);
  RemClassRegistry.RegisterXSClass(TXSDuration, XMLSchemaNameSpace, 'duration', '', True);
  RemClassRegistry.RegisterXSClass(TXSHexBinary, XMLSchemaNamespace, 'hexBinary', '', True);
  RemClassRegistry.RegisterXSClass(TXSDecimal, XMLSchemaNamespace, 'decimal', '', True);
finalization
  RemClassRegistry.UnRegisterXSClass(TXSDateTime);
  RemClassRegistry.UnRegisterXSClass(TXSTime);
  RemClassRegistry.UnRegisterXSClass(TXSDate);
  RemClassRegistry.UnRegisterXSClass(TXSDuration);
  RemClassRegistry.UnRegisterXSClass(TXSHexBinary);
  RemClassRegistry.UnRegisterXSClass(TXSDecimal);
end.