ration = class(TXSCustomDateTime)
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; override;
procedure XSToNative(Value: WideString); override;
function NativeToXS: WideString; override;
property DecimalSecond: Double read FDecimalSecond write SetDecimalSecond;
end;
EXSDateTimeException = class(Exception);
{ Utility function }
function DateTimeToXSDateTime(Value: TDateTime; CalcLocalBias: Boolean = False): TXSDateTime;
implementation
uses SoapConst, Windows;
{ 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;
{ Utility functions }
procedure AddUTCBias(var DateTime: TXSDateTime);
var
Info: TTimeZoneInformation;
Status: DWORD;
begin
Status := GetTimeZoneInformation(Info);
if (Status = TIME_ZONE_ID_UNKNOWN) or (Status = TIME_ZONE_ID_INVALID) then
SoapDateTimeError(SInvalidTimeZone);
DateTime.HourOffset := Info.Bias div 60;
DateTime.MinuteOffset := Info.Bias - (DateTime.HourOffset * 60);
end;
function DateTimeToXSDateTime(Value: TDateTime; CalcLocalBias: Boolean = False): TXSDateTime;
begin
Result := TXSDateTime.Create;
Result.AsDateTime := Value;
if CalcLocalBias then
AddUTCBias(Result);
end;
procedure ParseXMLDate(ADate: WideString; var Year, Month, Day: Word);
begin
Year := StrToInt(Copy(ADate, XMLYearPos, 4));
Month := StrToInt(Copy(ADate, XMLMonthPos, 2));
Day := StrToInt(Copy(ADate, XMLDayPos, 2));
end;
function XMLDateToStr(ADate: WideString; AddDigits: Word = 0): WideString;
begin
Result := Copy(ADate, XMLMonthPos + AddDigits, 2) + DateSeparator +
Copy(ADate, XMLDayPos + AddDigits, 2 ) +
DateSeparator + Copy(ADate, XMLYearPos, XMLDefaultYearDigits + AddDigits);
end;
{ the following code has a bug, modified by starfish
// get Small Int Using Digits in value, positive or negative. function IntFromValue(Value: WideString; Digits: Integer): SmallInt; begin
Result := 0;
if Value[1] = ''''-'''' then
Result := StrToInt(Value)
else if Value <> '''''''' then
Result := StrToInt(Copy(Value, 1, Digits));
end;
}
// modified by starfish
function IntFromValue(Value: WideString; Digits: Integer): SmallInt;
begin
if Value = '''''''' then
Result := 0
else if Value[1] = ''''-'''' then
Result := StrToInt(Value)
else
Result := StrToInt(Copy(Value, 1, Digits));
end;
{ TXSTime }
function TXSTime.Clone: TXSTime;
begin
Result := TXSTime.Create;
Result.Hour := Hour;
Result.Minute := Minute;
Result.Second := Second;
Result.MilliSecond := MilliSecond;
Result.HourOffset := HourOffset;
Result.MinuteOffset := MinuteOffset;
end;
procedure TXSTime.SetHour(const Value: Word);
begin
if Value < HoursPerDay then
FHour := Value
else
SoapDateTimeErrorFmt(SInvalidHour, [Value]);
end;
procedure TXSTime.SetMinute(const Value: Word);
begin
if Value < 60 then
FMinute := Value
else
SoapDateTimeErrorFmt(SInvalidMinute, [Value]);
end;
procedure TXSTime.SetSecond(const Value: Word);
begin
if Value < 60 then
FSecond := Value
else
SoapDateTimeErrorFmt(SInvalidSecond, [Value]);
end;
procedure TXSTime.SetMillisecond(const Value: Word);
begin
if Value < 1000 then
FMillisecond := Value
else
SoapDateTimeErrorFmt(SInvalidMillisecond, [Value]);
end;
procedure TXSTime.SetHourOffset(const Value: SmallInt);
begin
if Abs(Value) <= (HoursPerDay div 2) then
FHourOffset := Value
else
SoapDateTimeErrorFmt(SInvalidHourOffset, [Value]);
end;
procedure TXSTime.SetMinuteOffset(const Value: SmallInt);
begin
if Abs(Value) < 60 then
FMinuteOffset := Value
else
SoapDateTimeErrorFmt(SInvalidMinute, [Value]);
end;
procedure TXSTime.XSToNative(Value: WideString);
var
TempValue: WideString;
TempTime: TDateTime;
HourOffsetPos: Integer;
begin
TempValue := StringReplace(Copy(Value, 1, 8), XMLTimeSeparator, TimeSeparator, []);
TempTime := StrToTime(TempValue);
DecodeTime(TempTime, FHour, FMinute, FSecond, FMillisecond);
TempValue := Copy(Value, XMLMilSecPos, 3);
Millisecond := IntFromValue(TempValue, 3);
HourOffsetPos := Pos(XMLHourOffsetMinusMarker, Value);
if HourOffsetPos = 0 then
HourOffsetPos := Pos(XMLHourOffsetPlusMarker, Value);
if HourOffsetPos > 0 then
begin
TempValue := Copy(Value, HourOffsetPos + 1, 2);
HourOffset := IntFromValue(TempValue, 2);
TempValue := Copy(Value, HourOffsetPos + 4, 2);
if TempValue <> '''''''' then
MinuteOffSet := IntFromValue(TempValue,2);
end;
end;
function TXSTime.BuildHourOffset: WideString;
var
Marker: String;
begin
if Abs(HourOffset) + MinuteOffset <> 0 then
begin
if HourOffset > 0 then
Marker := XMLHourOffsetPlusMarker
else
Marker := XMLHourOffsetMinusMarker;
Result := IntToStr(Abs(HourOffset));
if Abs(HourOffset) < 10 then
Result := ''''0'''' + Result;
if Abs(MinuteOffSet) > 9 then
Result := Result + XMLTimeSeparator + IntToStr(Abs(MinuteOffset))
else if Abs(MinuteOffSet) > 0 then
Result := Result + XMLTimeSeparator + ''''0'''' + IntToStr(Abs(MinuteOffset))
else
Result := Result + XMLTimeSeparator + ''''00'''';
Result := Marker + Result;
end;
end;
function TXSTime.NativeToXS: WideString;
var
TempTime: TDateTime;
FormatString: string;
begin
if Hour + Minute + Second = 0 then exit;
TempTime := EncodeTime(Hour, Minute, Second, Millisecond); // exception thrown if invalid
FormatString := Format(''''hh%snn%sss.zzz'''', [XMLTimeSeparator, XMLTimeSeparator]);
Result := FormatDateTime(FormatString, TempTime) + BuildHourOffset;
end;
procedure TXSTime.SetAsTime(Value: TDateTime);
begin
DecodeTime(Value, FHour, FMinute, FSecond, FMillisecond);
end;
{ the following function has a bug! rewrite by starfish
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;
}
function TXSTime.GetAsTime: TDateTime;
begin
Result := EncodeTime(Hour, Minute, Second, Millisecond);
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
if (Value <= FMaxDay) and (Value >= FMinDay) then // perform more complete check when all values set
FDay := Value
else
SoapDateTimeErrorFmt(SInvalidDay, [Value]);
end;
procedure TXSDate.SetYear(const Value: Word);
begin
FYear := Value
end;
// the following code has a bug! rewrite by starfish
{
procedure TXSDate.XSToNative(Value: WideString);
var
TempDate: TDateTime;
begin
FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
TempDate := StrToDate(XMLDateToStr(Value, FAdditionalYearDigits));
DecodeDate(TempDate, FYear, FMonth, FDay);
end;
}
procedure TXSDate.XSToNative(Value: WideString);
begin
FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
try
FYear := StrToInt(Copy(Value, XMLYearPos, XMLDefaultYearDigits + FAdditionalYearDigits));
FMonth := StrToInt(Copy(Value, XMLDayPos + FAdditionalYearDigits, 2 ));
FDay := StrToInt(Copy(Value, XMLMonthPos + FAdditionalYearDigits, 2));
except
raise EConvertError.CreateResFmt(@SInvalidDate, [Value]);
end;
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;
{ the following code has a bug! rewrite by starfish
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;
}
function TXSDate.GetAsDate: TDateTime;
begin
Result := EncodeDate(Year, Month, Day);
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;
{ the following code has a bug, modified by starfish
function TXSCustomDateTime.GetAsDateTime: TDateTime;
var
DateString: string;
Slash: string;
Colon: string;
begin
Slash := DateSeparator;
Colon := TimeSeparator;
DateString := IntToStr(Month) + Slash + IntToStr(Day) + Slash + IntToStr(Year)
+ '''' '''' + IntToStr(Hour) + Colon + IntToStr(Minute) + Colon +
IntToStr(Second);
Result := StrToDateTime(DateString);
end;
}
function TXSCustomDateTime.GetAsDateTime: TDateTime;
begin
Result := EncodeDateTime(Year, Month, Day, Hour, Minute, Second, Millisecond);
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 >
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
