BUG correction in Delphi 6 SOAP source code
Recently I was using Delphi 6 to make a project about SOAP, and the tracked source code found some bugs in the source code of Delphi 6 when debugging the program :(
In the xsbuiltins.pas file below the Delphi / Source / SOAP directory, the 438th line is as follows:
Procedure TXSDATE.XSTONATIVE (Value: WideString);
VAR
Tempdate: TDATETIME;
Begin
Fadditionaleardigits: = POS (XmLDateseParetor, Value) - (1 XmldefaultyearDigits);
Tempdate: = strtodate (xmldatetostr (value, fadditionalAardIgits); // Note this line of code
Decodedate (Tempdate, Fyear, Fmonth, FDAY);
END;
Among them, an XMLDATETOSTR function is called, the following is the code of the function (in the 241 line of xsbuiltins.pas):
Function XmldateTostr (adode: wideString; adddigits: word = 0): WideString;
Begin
Result: = Copy (Adate, XMLMONTHPOS AddDigits, 2) DateSeparetor
Copy (Adate, XmLDayPOS AddDigits, 2)
Dateseparator Copy (Adate, XMlyearpos, XmldefaultyearDigits AddDigits);
END;
Note that the date format returned by XMLDATETOSTR is MM-DD-YYYY. For example, if passing the parameter addate = '2001-12-08', the result of XMLDATETOSTR ('2001-12-08', 0) is '12 -08-2001 '. The second parameter of XMLDATETOSTR adddigits is the number of digits of extra age. It is estimated to solve the problem of millennium, and the standard 10-bit date format AddDigits is always 0.
Now the problem is coming, go back to Xstonative code, this line code:
Tempdate: = Strtodate (XmldateTstr (Value, FadditionalEardIgits);
The return value of the function XMLDateTostr is called the Strtodate this function. The function of the function start is to transform the string to the date. The parameter of this function should be a string representing the date, but the character string format of the date must meet the current platform. Regional settings, such as the short date of our common Chinese platform, is generally YYYY-MM-DD, and the English platform is generally MM-DD-YYYY, so if you call strTodate () on the Chinese platform to format a format " "MM-DD-YYYY" strings will generate a date format error! !
Here is the content of the STRTODATE function in the help of Delphi:
Function Strtodate (const s: string): TDATETIME;
Description
Call Strtodate to Parse A String That Specifies a Date. If S Does Not Contain A Valid Date,
STRTODATE RAISES An EconvertERROR Exception.s Must Consist of Two or Three Numbers, Separated by The CharacterDefined by The Dateseparator Global Variable.
THE ORDER for Month, Day, And Year Is Determined by The ShortdateFormat Global Variable - Possible
Combinations are m / d / y, d / m / y, AND Y / m / d.
Process decodedate (Tempdate, fyear, fmonth, fday); last line code
Decodedate (Tempdate, Fyear, Fmonth, FDAY);
The role is to resolve Tempdate into fyear, fmonth, and fday, in fact, you can resolve these three domains directly from the date represented by the original string, so you can solve this bug slightly.
The specific approach is to change the function that starts with the 433th line in the xsbuiltins.pas file below the Delphi / SOURCE / SOAP directory.
Procedure TXSDATE.XSTONATIVE (Value: WideString);
Begin
Fadditionaleardigits: = POS (XmLDateseParetor, Value) - (1 XmldefaultyearDigits);
Try
Fyear: = STRTOINT (Copy (Value, XMlyearpos, XmldefaultyearDigits FadditionalEardIgits);
FMONTH: = StrtOINT (Copy (Value, XmLDayPos FadditionalEardIgits, 2);
FDAY: = STRTOINT (Copy (Value, XMLMONTHPOS FADDitionAlYardigits, 2));
Except
Raise econverterror.createresfmt (@sinvaliddate, [value]);
END;
END;
In the beginning of the file xsbuiltins.pas, add
Interface
Uses sysutils, invokeregistry, sysconst; // plus sysconst, because resource string SINVALIDDATE is defined in sysConst.pas
In addition, in the xsbuiltins.pas file below the Delphi / Source / SOAP directory, the following functions:
// 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;
Very obvious BUG! If the parameter value = '' is executed to IF value [1] = '-' Ten .. An error: (In fact, I encountered this in the process of my program, when SOAP passes the date time passed through XML When there is no millisecond field including time, it will encounter a case where IntFromValue is called. The function after modification should be as follows:
// 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;
Moreover
Function TXSTIME.GETASTIME: TDATETIME;
Function TXSDATE.GETASDATE: TDATETIME;
Function TXSCUSTOMDATETIME.GETASDATETIME: TDATETIME
There are also BUGs that I have previously said, and programmers who write this code have forgotten the datetime format will be different from different systems. Below is the xsbuiltins.pas file I have completely modified, and all the modified places have been annotated.
Note: I can't guarantee that the code after my revised code must be completely correct, but I can affirm that there are many bugs in its original code!
The following modified xsbuiltins.pas file, put it into the Delpi / Source / SOAP / directory overwrite the original files and recompile all SOAP projects.
{********************************************************** ******}
{}
{Borland Delphi Visual Component Library}
{SOAP Support}
{}
{CopyRight (c) 2001 Borland Software Corporation}
{}
{********************************************************** ******}
Unit xsbuiltins;
Interface
// sysconst, dateutils is address by starfish
Uses Sysutils, InvokeRegistry, sysconst, dateutils;
Const
SOAPTIMEPREFIX = 'T';
XmLDateseParetor = '-';
XMLHOFFSETMINUSMARKER = '-';
XMLHOFFSETPLUSMARKER = ' ';
XMLTIMESEPARATOR = ':';
XMLMONTHPOS = 6;
XMLDAYPOS = 9; XMlyearpos = 1;
XMLMilsecpos = 10;
Xmldefaultyeardigits = 4;
XMLDURATIONSTART = 'P';
XMLDURATIONYEAR = 'Y';
XMLDURATIONMONTH = 'm';
XMLDURATIONDAY = 'D';
XMLDURATIONHOUR = 'h';
XMLDURATIONMINUTE = 'm';
XmLdurationSecond = 's';
ResourceString
SINVALIDHOUR = 'Invalid Hour:% d';
SINVALIDMINUTE = 'Invalid Minute:% D';
SINVALIDSECOND = 'INVALID Second:% D';
SINVALIDFRACTIONSECOND = 'Invalid Second:% F';
SINVALIDMILLISECOND = 'Invalid MilliseCond:% D';
SINVALIDHOUROFFSET = 'Invalid Hour Offset:% D';
SINVALIDDAY = 'INVALID DAY:% D';
SINVALIDMONTH = 'INVALID MONTH:% D';
SINVALIDDURATION = 'Invalid Duration String:% s';
Type
{forward declaratives}
TXSDURATION = Class;
TXSTIME = Class;
TXSDATE = Class;
TXSDATETIME = Class;
{TxStime}
TXSTIME = Class (TremotableXS)
Private
FHOUR: WORD;
Fminute: Word;
FSecond: Word;
FmilliseCond: Word;
FHOUROFFSET: smallint;
FminuteOffset: smallint;
Function Buildhouroffset: WideString;
protected
Function GetAstime: TDATETIME;
Procedure setAstime (Value: tdatetime);
Procedure set (const value: word);
Procedure Setminute (Const Value: Word);
Procedure setSecond (Const Value: Word);
Procedure setmillisecond (const value: word);
Procedure setHouroffset (Const value: smallint);
Procedure setminuteoffset (Const value: smallint);
public
Function Clone: TXSTIME;
Property Hour: Word Read FHOUR WRITE SETHOUR Default 0;
Property Minute: Word Read Fminute Write Setminute DEFAULT 0;
Property Second: Word Read FSecond Write SetSecond Default 0; Property Millisecond: Word Read FmilliseCond Write SetMilliseCond Default 0;
Property Hourofset: Smallint Read Fharoufset Write SetHOFFSet Default 0;
Property MinuteOffset: Smallint Read FminuteOffset Write setminuteOffset
Procedure xstonative (value: wideString); OVERRIDE;
Function NativeToxs: WideString; Override;
Property Astime: Tdatetime Read GetAstime Write SetAstime;
END;
{TXSDATE}
TXSDATE = Class (TremotableXS)
Private
FadditionalEardigits: Word;
FMONTH: WORD;
FDAY: WORD;
Fyear: Word;
FMaxDay: Word;
Fmaxmonth: Word;
FMINDAY: WORD;
FMINMONTH: WORD;
protected
Function Getasdate: TDATETIME;
Procedure setasdate (Value: tdatetime);
Procedure setmonth (Const value: Word);
Procedure setDay (const value: word);
Procedure setYear (Const value: Word);
Property MaxDay: Word Read Fmaxday Write Fmaxday;
Property Maxmonth: Word Read Fmaxmonth Write FmaxMonth;
Property MINDAY: Word Read FMinday Write FMinday;
Property MinMonth: Word Read FMINMONTH WRITE FMINMONTH;
public
CONSTRUCTOR CRETE; OVERRIDE;
Property Month: Word Read Fmonth Write SetMonth Default 0;
Property Day: Word Read FDAY WRITE SETDAY DEFAULT 0;
Property Year: Word Read Fyear Write SetYear Default 0;
Function Clone: TXSDATE;
Procedure xstonative (value: wideString); OVERRIDE;
Function NativeToxs: WideString; Override;
Property Asdate: TDATETIME READ Getasdate Write SetAsdate;
END;
{TXSCUSTOMDATETIME}
TXSCUSTOMDATETIME = Class (TREMOTABLEXS)
Private
FDATEPARAM: TXSDATE;
FTIMEPARAM: TXSTIME;
protected
Function GetasDateTime: TDATETIME;
Function gethour: Word;
Function getminute: Word;
Function GetSecond: Word;
Function GetMonth: Word;
Function Getday: Word; Function GetYear: Word;
Function getMillisecond: Word;
Function Gethouroffset: smallint;
Function getminuteOffset: smallint;
Procedure setasDatetime (value: tdatetime);
Procedure set (const value: word); virtual;
Procedure setminute (const value: word); virtual;
Procedure setsecond (const value: word); virtual;
Procedure setmillisecond (const value: word); virtual;
Procedure setHouroffset; virtual;
Procedure setminuteOffset; virtual;
Procedure setMonth; virtual;
Procedure setDay (const value: word); virtual;
Procedure setYear (const value: word); virtual;
public
CONSTRUCTOR CRETE; OVERRIDE;
DESTRUCTOR DESTROY; OVERRIDE;
Property Asdatetime: TDATETIME READ GetASdateTime Write SetAsDateTime;
Property Hour: Word Read Gethour Write SetHour Default 0;
Property Minute: Word ReadMinute Write Setminute Default 0;
Property Second: Word Read GetSecond Write SetSecond Default 0;
// the folowing line is address by starfish
Property Millisecond: Word ReadMilliseCond Write SetMilliseCond Default 0;
Property Month: Word ReadMonth Write SetMonth Default 0;
Property Day: Word ReadDay Write setday default 0;
Property Year: Word Read getyear Write setYear Default 0;
END;
{TXSDATETIME}
TXSDATETIME = Class (TXSCUSTOMDATETIME)
Private
Function ValidValue (Value, Subtract, Min, Max: Integer; Var Remainder: Integer;
public
Function ComparedateTimeParam (Const Value1, Value2: TxsDateTime): TXSDURATION;
public
Function Clone: TXSDATETIME;
Property Millisecond: Word ReadMilliseCond Write SetMilliseCond Default 0;
Property Houroffset: Smallint Read Gethouroffset Write setOffset Default 0;
Property MinuteOffset: Smallint ReadGETMINUTEOFFSET WRITE SETMINUTEOFFSET DEFAULT 0; Procedure Xstonative (Value: WideString); OVERRIDE
Function NativeToxs: WideString; Override;
END;
TXSDURATION = 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 Decimals: boolean = false: WideString;
protected
Procedure setDecimalsecond (const value: double);
public
CONSTRUCTOR CRETE; OVERRIDE;
Procedure xstonative (value: wideString); OVERRIDE;
Function NativeToxs: WideString; Override;
Property Decimalsecond: Double Read FDecimalsecond Write setDecimalsecond;
END;
EXSDATETIMEEXCEPTION = Class (Exception);
{Utility function}
Function datetimetoxdatetime (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; 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 datetimetoxdatetime (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 (adode: wideString; adddigits: word = 0): WideString;
Begin
Result: = Copy (Adate, XMLMONTHPOS AddDigits, 2) DateSeparetor
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 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: = startIME (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 (HOUROFSET) MinuteOffset <> 0 THEN Begin IF Houroffset> 0 Then Marker: = XmlhouroffSetplusmarker Else Marker: = Xmlhouroffsetminusmarker; Result: = INTOSTR (ABS (HOUROFFSET)); IF ABS (Houroffset) <10 THEN Result: = '0' Result; IF ABS (MinuteOffset)> 9 THEN Result: = Result XMLTIMESEPARATOR INTOSTR (ABS (MinuteOffset)) Else IF ABS (MinuteOffset)> 0 THEN Result: = Result XMLTIMESEPARATOR '0' INTOSTR (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% snorth% sss.zzz', [xmltimseparator, xmltimseparator]); 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: = INTOSTR (HOUR) COLON INTOSTR (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 folowing code has a bug! Rewrite by starfish { Procedure TXSDATE.XSTONATIVE (Value: WideString); VAR Tempdate: TDATETIME; Begin Fadditionaleardigits: = POS (XmLDateseParetor, Value) - (1 XmldefaultyearDigits); Tempdate: = Strtodate (XmldateTstr (Value, FadditionalEardIgits); Decodedate (Tempdate, Fyear, Fmonth, FDAY); END; } Procedure TXSDATE.XSTONATIVE (Value: WideString); Begin Fadditionaleardigits: = POS (XmLDateseParetor, Value) - (1 XmldefaultyearDigits); Try Fyear: = STRTOINT (Copy (Value, XMlyearpos, XmldefaultyearDigits FadditionalEardIgits); FMONTH: = StrtOINT (Copy (Value, XmLDayPos FadditionalEardIgits, 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', [XmLDateseParetor]); 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: = INTOSTR (MONTH) SLASH INTOSTR (DAY) SLASH INTOSTR (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 TXSCUScustomDatetime.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 TXSCUScustomDatetime.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.setAsettime (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: = INTOSTR (MONTH) SLASH INTSTR (DAY) SLASH INTOSTR (YEAR) '' INTOSTR (HOUR) COLON INTOSTR (Minute) Colon INTOSTR (SECOND); Result: = stratodatetime (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> 0 THEN Begin DateString: = Copy (Value, 1, TimePosition-1); TimeString: = Copy (Value, TimePosition 1, Length (Value) - TIMEPSITION; 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.nativeTox 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 results 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, Remain); Seconds: = ValidValue (Value1.second Remainder, Value2.Second, 0, 60, Remain); Result.Decimalsecond: = Seconds MilliseConds / 1000; Result.minute: = ValidValue (Value1.minute Remainder, Value2.minute, 0, 60, Remain); Result.Hour: = ValidValue (Value1.Hour Remainder, Value2. Hour, 0, 24, Remain); Result.day: = ValidValue (Value1.day Remainder, Value2.day, 0, 31, Remain); Result.month: = ValidValue (Value1.month Remainder, Value2.mont, 0, 12, Remain); Result.year: = ValidValue (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 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] = '.'))))) DEC (i); IF j> i Then Result: = Copy (Aparam, i, J-i) Else Result: = '0'; END; Function TXSDURATION.GETINTEGERVALUE (Const Aparam: string): Integer; Begin Result: = start (getNuMericstring (APARAM, ATYPE)); END; Function TXSDURATION.GETDECIMALVALUE (const APARAM: STRING; Const atype: String): Double; Begin Result: = start (getNuMericstring (Aparam, atype, true); END; Procedure TXSDURATION.XSTONATIVE (Value: WideString); VAR DateString, TimeString: String; TimePosition: integer; Begin IF value [1] <> xmldurationstart the 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, XmLdureyear); 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 INTOSTR (MONTH) XMLDURATIONMONTH INTOSTR (DAY) XMLDURATIONDAY SOAPTIMEPREFIX INTOSTR (HOUR) XMLDURATIONHOUR INTTOSTR (Minute) XMLDURATIONMINUTE FLOATTOSTR (DECIMALSECOND) XMLDURATIONSECOND; 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); Finalization RemclassRegistry.unregisterXSClass (TXSDateTime); RemclassRegistry.unregisterXSClass (TXSTIME); RemclassRegistry.unregisterXSClass (TXSDATE); RemclassRegistry.unregisterXSClass (TXSDuration); End.
