source/COM/_StDate.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   _STDATE.PAS 3.00                    *}
{*********************************************************}

{$I STDEFINE.INC}
{$I STCOMDEF.INC}
unit _StDate;

interface

uses
  ComObj, StDate, SysTools_TLB, StdVcl;

type
  TStDate = class(TAutoObject, IStDate)
   private
    FIsLicensed : Boolean;
   public
    procedure Initialize; override;
   protected {Protected declarations }
    { IStDate - Methods }
    function AstJulianDate(Julian: TDateTime): Double; safecall;
    function AstJulianDatePrim(Year, Month, Day: Integer; UT: TDateTime): Double; safecall;
    function AstJulianDateToStDate(AstJD: Double; Truncate: WordBool): TDateTime; safecall;
    function BondDateDiff(Date1, Date2: TDateTime; DayBasis: TStBondDateType): TDateTime; safecall;
    function CurrentDate: TDateTime; safecall;
    function CurrentDateString(const Picture: WideString; Pack: WordBool): WideString; safecall;
    function CurrentTime: TDateTime; safecall;
    function CurrentTimeString(const Picture: WideString; Pack: WordBool): WideString; safecall;
    procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Integer); safecall;
    function DateStringHMStoAstJD(const Picture, DS: WideString; Hours, Minutes, Seconds, Epoch: Integer): Double; safecall;
    function DateStringToDMY(const Picture, S: WideString; var Day, Month, Year: Integer; Epoch: Integer): WordBool; safecall;
    function DateStringToStDate(const Picture, S: WideString; Epoch: Integer): TDateTime; safecall;
    procedure DateTimeDiff(DT1, DT2: TDateTime; var Days, Seconds: Integer); safecall;
    function DayOfWeek(Julian: TDateTime): TStDayType; safecall;
    function DayOfWeekDMY(Day, Month, Year, Epoch: Integer): TStDayType; safecall;
    function DayOfWeekToString(WeekDay: TStDayType): WideString; safecall;
    function DaysInMonth(Month, Year, Epoch: Integer): Integer; safecall;
    function DecTime(T: TDateTime; Hours, Minutes, Seconds: Byte): TDateTime; safecall;
    function DMYtoStDate(Day, Month, Year, Epoch: Integer): TDateTime; safecall;
    function DMYtoDateString(const Picture: WideString; Day, Month, Year, Epoch: Integer; Pack: WordBool): WideString; safecall;
    function HMStoStTime(Hours, Minutes, Seconds: Byte): TDateTime; safecall;
    function IncDate(Julian: TDateTime; Days, Months, Years: Integer): TDateTime; safecall;
    procedure IncDateTime(DT1: TDateTime; var DT2: TDateTime; Days,
      Seconds: Integer); safecall;
    function IncDateTrunc(Julian: TDateTime; Months, Years: Integer): TDateTime; safecall;
    function IncTime(T: TDateTime; Hours, Minutes, Seconds: Byte): TDateTime; safecall;
    function InternationalDate(ForceCentury: WordBool): WideString; safecall;
    function InternationalLongDate(ShortNames, ExcludeDOW: WordBool): WideString; safecall;
    function InternationalTime(ShowSeconds: WordBool): WideString; safecall;
    function IsLeapYear(Year: Integer): WordBool; safecall;
    function MonthToString(Month: Integer): WideString; safecall;
    function RoundToNearestHour(T: TDateTime; Truncate: WordBool): TDateTime; safecall;
    function RoundToNearestMinute(T: TDateTime; Truncate: WordBool): TDateTime; safecall;
    function StDateToDateString(const Picture: WideString; Julian: TDateTime; Pack: WordBool): WideString; safecall;
    procedure StDateToDMY(Julian: TDateTime; var Day, Month, Year: Integer);  safecall;
    function StTimeToAmPmString(const Picture: WideString; T: TDateTime; Pack: WordBool): WideString; safecall;
    procedure StTimeToHMS(T: TDateTime; var Hours, Minutes, Seconds: Byte);  safecall;
    function StTimeToTimeString(const Picture: WideString; T: TDateTime; Pack: WordBool): WideString; safecall;
    procedure TimeDiff(T1, T2: TDateTime; var Hours, Minutes, Seconds: Byte); safecall;
    function TimeStringToHMS(const Picture, TS: WideString; var Hours, Minutes, Seconds: Integer): WordBool; safecall;
    function TimeStringToStTime(const Picture, S: WideString): TDateTime; safecall;
    function ValidDate(Day, Month, Year, Epoch: Integer): WordBool; safecall;
    function ValidTime(Hours, Minutes, Seconds: Integer): WordBool; safecall;
    function WeekOfYear(Julian: TDateTime): Byte; safecall;
    function License(const Key: WideString): WordBool; safecall;
  end;

implementation

uses ComServ, StDateSt {$IFDEF LICENSE}, ActiveX, StComLic {$ENDIF};

procedure TStDate.Initialize;
begin
  inherited Initialize;
  {$IFDEF LICENSE}
  FIsLicensed := False;
  {$ELSE}
  FIsLicensed := True;
  {$ENDIF}
end;

{ ********** TStDate Methods ********************************************************** }
function TStDate.AstJulianDate(Julian: TDateTime): Double;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.AstJulianDate(StDate.DateTimeToStDate(Julian));
end;

function TStDate.AstJulianDatePrim(Year, Month, Day: Integer;
  UT: TDateTime): Double;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.AstJulianDatePrim(Year, Month, Day, StDate.DateTimeToStTime(UT));
end;

function TStDate.AstJulianDateToStDate(AstJD: Double;
  Truncate: WordBool): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.AstJulianDatetoStDate(AstJD, Truncate));
end;

function TStDate.BondDateDiff(Date1, Date2: TDateTime;
  DayBasis: TStBondDateType): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.BondDateDiff(StDate.DateTimeToStDate(Date1),
                                                        StDate.DateTimeToStDate(Date2),
                                                        StDate.TStBondDateType(DayBasis)));
end;

function TStDate.CurrentDate: TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.CurrentDate);
end;

function TStDate.CurrentDateString(const Picture: WideString;
  Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.CurrentDateString(Picture, Pack);
end;

function TStDate.CurrentTime: TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.CurrentTime);
end;

function TStDate.CurrentTimeString(const Picture: WideString;
  Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.CurrentTimeString(Picture, Pack);
end;

procedure TStDate.DateDiff(Date1, Date2: TDateTime; var Days, Months,
  Years: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  StDate.DateDiff(StDate.DateTimeToStDate(Date1),
                  StDate.DateTimeToStDate(Date2), Days, Months, Years);
end;

function TStDate.DateStringHMStoAstJD(const Picture, DS: WideString; Hours,
  Minutes, Seconds, Epoch: Integer): Double;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.DateStringHMStoAstJD(Picture, DS, Hours, Minutes, Seconds, Epoch);
end;

function TStDate.DateStringToDMY(const Picture, S: WideString; var Day,
  Month, Year: Integer; Epoch: Integer): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.DateStringToDMY(Picture, S, Epoch, Day, Month, Year);
end;

function TStDate.DateStringToStDate(const Picture, S: WideString;
  Epoch: Integer): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDateSt.DateStringToStDate(Picture, S, Epoch));
end;

procedure TStDate.DateTimeDiff(DT1, DT2: TDateTime; var Days,
  Seconds: Integer);
var
  DTR1, DTR2 : StDate.TStDateTimeRec;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  DTR1.D := StDate.DateTimeToStDate(DT1);
  DTR1.T := StDate.DateTimeToStTime(DT1);

  DTR2.D := StDate.DateTimeToStDate(DT2);
  DTR2.T := StDate.DateTimeToStTime(DT2);

  StDate.DateTimeDiff(DTR1, DTR2, Days, Seconds);
end;

function TStDate.DayOfWeek(Julian: TDateTime): TStDayType;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := TStDayType(StDate.DayOfWeek(StDate.DateTimeToStDate(Julian)));
end;

function TStDate.DayOfWeekDMY(Day, Month, Year,
  Epoch: Integer): TStDayType;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := TStDayType(StDate.DayOfWeekDMY(Day, Month, Year, Epoch));
end;

function TStDate.DayOfWeekToString(WeekDay: TStDayType): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.DayOfWeekToString(StDate.TStDayType(WeekDay));
end;

function TStDate.DaysInMonth(Month, Year, Epoch: Integer): Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.DaysInMonth(Month, Year, Epoch);
end;

function TStDate.DecTime(T: TDateTime; Hours, Minutes,
  Seconds: Byte): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.DecTime(StDate.DateTimeToStTime(T),
                                                   Hours,
                                                   Minutes,
                                                   Seconds));
end;

function TStDate.DMYtoStDate(Day, Month, Year, Epoch: Integer): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.DMYtoStDate(Day, Month, Year, Epoch));
end;

function TStDate.DMYtoDateString(const Picture: WideString; Day, Month,
  Year, Epoch: Integer; Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.DMYtoDateString(Picture, Day, Month, Year, Epoch, Pack);
end;

function TStDate.HMStoStTime(Hours, Minutes, Seconds: Byte): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.HMStoStTime(Hours, Minutes, Seconds));
end;

function TStDate.IncDate(Julian: TDateTime; Days, Months,
  Years: Integer): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.IncDate(StDate.DateTimeToStDate(Julian),
                                                   Days,
                                                   Months,
                                                   Years));
end;

procedure TStDate.IncDateTime(DT1: TDateTime; var DT2: TDateTime; Days,
  Seconds: Integer);
var
  DTR1, DTR2 : StDate.TStDateTimeRec;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  DTR1.D := StDate.DateTimeToStDate(DT1);
  DTR1.T := StDate.DateTimeToStTime(DT1);

  StDate.IncDateTime(DTR1, DTR2, Days, Seconds);

  {!! This is not right }
  DT2 := DTR2.D + DTR2.T;
end;

function TStDate.IncDateTrunc(Julian: TDateTime; Months,
  Years: Integer): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StDateToDateTime(StDate.IncDateTrunc(StDate.DateTimeToStDate(Julian),
                                                        Months,
                                                        Years));
end;

function TStDate.IncTime(T: TDateTime; Hours, Minutes,
  Seconds: Byte): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.IncTime(StDate.DateTimeToStTime(T),
                                                   Hours,
                                                   Minutes,
                                                   Seconds));
end;

function TStDate.InternationalDate(ForceCentury: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.InternationalDate(ForceCentury);
end;

function TStDate.InternationalLongDate(ShortNames,
  ExcludeDOW: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.InternationalLongDate(ShortNames, ExcludeDOW);
end;

function TStDate.InternationalTime(ShowSeconds: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.InternationalTime(ShowSeconds);
end;

function TStDate.IsLeapYear(Year: Integer): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.IsLeapYear(Year);
end;

function TStDate.MonthToString(Month: Integer): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.MonthToString(Month);
end;

function TStDate.RoundToNearestHour(T: TDateTime;
  Truncate: WordBool): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.RoundToNearestHour(StDate.DateTimeToStTime(T),
                                                              Truncate));
end;

function TStDate.RoundToNearestMinute(T: TDateTime;
  Truncate: WordBool): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDate.RoundToNearestMinute(StDate.DateTimeToStTime(T),
                                                                Truncate));
end;

function TStDate.StDateToDateString(const Picture: WideString;
  Julian: TDateTime; Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.StDateToDateString(Picture, StDate.DateTimeToStDate(Julian), Pack);
end;

procedure TStDate.StDateToDMY(Julian: TDateTime; var Day, Month,
  Year: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  StDate.StDateToDMY(StDate.DateTimeToStDate(Julian), Day, Month, Year);
end;

function TStDate.StTimeToAmPmString(const Picture: WideString;
  T: TDateTime; Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  StDateSt.StTimeToAmPmString(Picture, StDate.DateTimeToStTime(T), Pack);
end;

procedure TStDate.StTimeToHMS(T: TDateTime; var Hours, Minutes,
  Seconds: Byte);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  StDate.StTimeToHMS(StDate.DateTimeToStTime(T), Hours, Minutes, Seconds);
end;

function TStDate.StTimeToTimeString(const Picture: WideString;
  T: TDateTime; Pack: WordBool): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.StTimeToTimeString(Picture, StDate.DateTimeToStTime(T), Pack);
end;

procedure TStDate.TimeDiff(T1, T2: TDateTime; var Hours, Minutes,
  Seconds: Byte);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  StDate.TimeDiff(StDate.DateTimeToStTime(T1),
                  StDate.DateTimeToStTime(T2),
                  Hours,
                  Minutes,
                  Seconds);
end;

function TStDate.TimeStringToHMS(const Picture, TS: WideString; var Hours,
  Minutes, Seconds: Integer): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDateSt.TimeStringToHMS(Picture, TS, Hours, Minutes, Seconds);
end;

function TStDate.TimeStringToStTime(const Picture,
  S: WideString): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.StTimeToDateTime(StDateSt.TimeStringToStTime(Picture, S));
end;

function TStDate.ValidDate(Day, Month, Year, Epoch: Integer): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.ValidDate(Day, Month, Year, Epoch);
end;

function TStDate.ValidTime(Hours, Minutes, Seconds: Integer): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.ValidTime(Hours, Minutes, Seconds);
end;

function TStDate.WeekOfYear(Julian: TDateTime): Byte;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StDate.WeekOfYear(StDate.DateTimeToStDate(Julian));
end;

function TStDate.License(const Key: WideString): WordBool;
begin
  {$IFDEF LICENCE}
  Result := COMIsValidKey(Key);
  {$ELSE}
  Result := True;
  {$ENDIF}
  FIsLicensed := Result;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TStDate, Class_StDate, ciMultiInstance, tmBoth);
end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	{*********************************************************}
27	{* _STDATE.PAS 3.00 *}
28	{*********************************************************}
29
30	{$I STDEFINE.INC}
31	{$I STCOMDEF.INC}
32	unit _StDate;
33
34	interface
35
36	uses
37	ComObj, StDate, SysTools_TLB, StdVcl;
38
39	type
40	TStDate = class(TAutoObject, IStDate)
41	private
42	FIsLicensed : Boolean;
43	public
44	procedure Initialize; override;
45	protected {Protected declarations }
46	{ IStDate - Methods }
47	function AstJulianDate(Julian: TDateTime): Double; safecall;
48	function AstJulianDatePrim(Year, Month, Day: Integer; UT: TDateTime): Double; safecall;
49	function AstJulianDateToStDate(AstJD: Double; Truncate: WordBool): TDateTime; safecall;
50	function BondDateDiff(Date1, Date2: TDateTime; DayBasis: TStBondDateType): TDateTime; safecall;
51	function CurrentDate: TDateTime; safecall;
52	function CurrentDateString(const Picture: WideString; Pack: WordBool): WideString; safecall;
53	function CurrentTime: TDateTime; safecall;
54	function CurrentTimeString(const Picture: WideString; Pack: WordBool): WideString; safecall;
55	procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Integer); safecall;
56	function DateStringHMStoAstJD(const Picture, DS: WideString; Hours, Minutes, Seconds, Epoch: Integer): Double; safecall;
57	function DateStringToDMY(const Picture, S: WideString; var Day, Month, Year: Integer; Epoch: Integer): WordBool; safecall;
58	function DateStringToStDate(const Picture, S: WideString; Epoch: Integer): TDateTime; safecall;
59	procedure DateTimeDiff(DT1, DT2: TDateTime; var Days, Seconds: Integer); safecall;
60	function DayOfWeek(Julian: TDateTime): TStDayType; safecall;
61	function DayOfWeekDMY(Day, Month, Year, Epoch: Integer): TStDayType; safecall;
62	function DayOfWeekToString(WeekDay: TStDayType): WideString; safecall;
63	function DaysInMonth(Month, Year, Epoch: Integer): Integer; safecall;
64	function DecTime(T: TDateTime; Hours, Minutes, Seconds: Byte): TDateTime; safecall;
65	function DMYtoStDate(Day, Month, Year, Epoch: Integer): TDateTime; safecall;
66	function DMYtoDateString(const Picture: WideString; Day, Month, Year, Epoch: Integer; Pack: WordBool): WideString; safecall;
67	function HMStoStTime(Hours, Minutes, Seconds: Byte): TDateTime; safecall;
68	function IncDate(Julian: TDateTime; Days, Months, Years: Integer): TDateTime; safecall;
69	procedure IncDateTime(DT1: TDateTime; var DT2: TDateTime; Days,
70	Seconds: Integer); safecall;
71	function IncDateTrunc(Julian: TDateTime; Months, Years: Integer): TDateTime; safecall;
72	function IncTime(T: TDateTime; Hours, Minutes, Seconds: Byte): TDateTime; safecall;
73	function InternationalDate(ForceCentury: WordBool): WideString; safecall;
74	function InternationalLongDate(ShortNames, ExcludeDOW: WordBool): WideString; safecall;
75	function InternationalTime(ShowSeconds: WordBool): WideString; safecall;
76	function IsLeapYear(Year: Integer): WordBool; safecall;
77	function MonthToString(Month: Integer): WideString; safecall;
78	function RoundToNearestHour(T: TDateTime; Truncate: WordBool): TDateTime; safecall;
79	function RoundToNearestMinute(T: TDateTime; Truncate: WordBool): TDateTime; safecall;
80	function StDateToDateString(const Picture: WideString; Julian: TDateTime; Pack: WordBool): WideString; safecall;
81	procedure StDateToDMY(Julian: TDateTime; var Day, Month, Year: Integer); safecall;
82	function StTimeToAmPmString(const Picture: WideString; T: TDateTime; Pack: WordBool): WideString; safecall;
83	procedure StTimeToHMS(T: TDateTime; var Hours, Minutes, Seconds: Byte); safecall;
84	function StTimeToTimeString(const Picture: WideString; T: TDateTime; Pack: WordBool): WideString; safecall;
85	procedure TimeDiff(T1, T2: TDateTime; var Hours, Minutes, Seconds: Byte); safecall;
86	function TimeStringToHMS(const Picture, TS: WideString; var Hours, Minutes, Seconds: Integer): WordBool; safecall;
87	function TimeStringToStTime(const Picture, S: WideString): TDateTime; safecall;
88	function ValidDate(Day, Month, Year, Epoch: Integer): WordBool; safecall;
89	function ValidTime(Hours, Minutes, Seconds: Integer): WordBool; safecall;
90	function WeekOfYear(Julian: TDateTime): Byte; safecall;
91	function License(const Key: WideString): WordBool; safecall;
92	end;
93
94	implementation
95
96	uses ComServ, StDateSt {$IFDEF LICENSE}, ActiveX, StComLic {$ENDIF};
97
98	procedure TStDate.Initialize;
99	begin
100	inherited Initialize;
101	{$IFDEF LICENSE}
102	FIsLicensed := False;
103	{$ELSE}
104	FIsLicensed := True;
105	{$ENDIF}
106	end;
107
108	{ ******** TStDate Methods ******************************************************** }
109	function TStDate.AstJulianDate(Julian: TDateTime): Double;
110	begin
111	{$IFDEF LICENSE}
112	if (not FIsLicensed) or (not COMHasBeenLicensed) then
113	OleError(CLASS_E_NOTLICENSED);
114	{$ENDIF}
115	Result := StDate.AstJulianDate(StDate.DateTimeToStDate(Julian));
116	end;
117
118	function TStDate.AstJulianDatePrim(Year, Month, Day: Integer;
119	UT: TDateTime): Double;
120	begin
121	{$IFDEF LICENSE}
122	if (not FIsLicensed) or (not COMHasBeenLicensed) then
123	OleError(CLASS_E_NOTLICENSED);
124	{$ENDIF}
125	Result := StDate.AstJulianDatePrim(Year, Month, Day, StDate.DateTimeToStTime(UT));
126	end;
127
128	function TStDate.AstJulianDateToStDate(AstJD: Double;
129	Truncate: WordBool): TDateTime;
130	begin
131	{$IFDEF LICENSE}
132	if (not FIsLicensed) or (not COMHasBeenLicensed) then
133	OleError(CLASS_E_NOTLICENSED);
134	{$ENDIF}
135	Result := StDate.StDateToDateTime(StDate.AstJulianDatetoStDate(AstJD, Truncate));
136	end;
137
138	function TStDate.BondDateDiff(Date1, Date2: TDateTime;
139	DayBasis: TStBondDateType): TDateTime;
140	begin
141	{$IFDEF LICENSE}
142	if (not FIsLicensed) or (not COMHasBeenLicensed) then
143	OleError(CLASS_E_NOTLICENSED);
144	{$ENDIF}
145	Result := StDate.StDateToDateTime(StDate.BondDateDiff(StDate.DateTimeToStDate(Date1),
146	StDate.DateTimeToStDate(Date2),
147	StDate.TStBondDateType(DayBasis)));
148	end;
149
150	function TStDate.CurrentDate: TDateTime;
151	begin
152	{$IFDEF LICENSE}
153	if (not FIsLicensed) or (not COMHasBeenLicensed) then
154	OleError(CLASS_E_NOTLICENSED);
155	{$ENDIF}
156	Result := StDate.StDateToDateTime(StDate.CurrentDate);
157	end;
158
159	function TStDate.CurrentDateString(const Picture: WideString;
160	Pack: WordBool): WideString;
161	begin
162	{$IFDEF LICENSE}
163	if (not FIsLicensed) or (not COMHasBeenLicensed) then
164	OleError(CLASS_E_NOTLICENSED);
165	{$ENDIF}
166	Result := StDateSt.CurrentDateString(Picture, Pack);
167	end;
168
169	function TStDate.CurrentTime: TDateTime;
170	begin
171	{$IFDEF LICENSE}
172	if (not FIsLicensed) or (not COMHasBeenLicensed) then
173	OleError(CLASS_E_NOTLICENSED);
174	{$ENDIF}
175	Result := StDate.StTimeToDateTime(StDate.CurrentTime);
176	end;
177
178	function TStDate.CurrentTimeString(const Picture: WideString;
179	Pack: WordBool): WideString;
180	begin
181	{$IFDEF LICENSE}
182	if (not FIsLicensed) or (not COMHasBeenLicensed) then
183	OleError(CLASS_E_NOTLICENSED);
184	{$ENDIF}
185	Result := StDateSt.CurrentTimeString(Picture, Pack);
186	end;
187
188	procedure TStDate.DateDiff(Date1, Date2: TDateTime; var Days, Months,
189	Years: Integer);
190	begin
191	{$IFDEF LICENSE}
192	if (not FIsLicensed) or (not COMHasBeenLicensed) then
193	OleError(CLASS_E_NOTLICENSED);
194	{$ENDIF}
195	StDate.DateDiff(StDate.DateTimeToStDate(Date1),
196	StDate.DateTimeToStDate(Date2), Days, Months, Years);
197	end;
198
199	function TStDate.DateStringHMStoAstJD(const Picture, DS: WideString; Hours,
200	Minutes, Seconds, Epoch: Integer): Double;
201	begin
202	{$IFDEF LICENSE}
203	if (not FIsLicensed) or (not COMHasBeenLicensed) then
204	OleError(CLASS_E_NOTLICENSED);
205	{$ENDIF}
206	Result := StDateSt.DateStringHMStoAstJD(Picture, DS, Hours, Minutes, Seconds, Epoch);
207	end;
208
209	function TStDate.DateStringToDMY(const Picture, S: WideString; var Day,
210	Month, Year: Integer; Epoch: Integer): WordBool;
211	begin
212	{$IFDEF LICENSE}
213	if (not FIsLicensed) or (not COMHasBeenLicensed) then
214	OleError(CLASS_E_NOTLICENSED);
215	{$ENDIF}
216	Result := StDateSt.DateStringToDMY(Picture, S, Epoch, Day, Month, Year);
217	end;
218
219	function TStDate.DateStringToStDate(const Picture, S: WideString;
220	Epoch: Integer): TDateTime;
221	begin
222	{$IFDEF LICENSE}
223	if (not FIsLicensed) or (not COMHasBeenLicensed) then
224	OleError(CLASS_E_NOTLICENSED);
225	{$ENDIF}
226	Result := StDate.StDateToDateTime(StDateSt.DateStringToStDate(Picture, S, Epoch));
227	end;
228
229	procedure TStDate.DateTimeDiff(DT1, DT2: TDateTime; var Days,
230	Seconds: Integer);
231	var
232	DTR1, DTR2 : StDate.TStDateTimeRec;
233	begin
234	{$IFDEF LICENSE}
235	if (not FIsLicensed) or (not COMHasBeenLicensed) then
236	OleError(CLASS_E_NOTLICENSED);
237	{$ENDIF}
238	DTR1.D := StDate.DateTimeToStDate(DT1);
239	DTR1.T := StDate.DateTimeToStTime(DT1);
240
241	DTR2.D := StDate.DateTimeToStDate(DT2);
242	DTR2.T := StDate.DateTimeToStTime(DT2);
243
244	StDate.DateTimeDiff(DTR1, DTR2, Days, Seconds);
245	end;
246
247	function TStDate.DayOfWeek(Julian: TDateTime): TStDayType;
248	begin
249	{$IFDEF LICENSE}
250	if (not FIsLicensed) or (not COMHasBeenLicensed) then
251	OleError(CLASS_E_NOTLICENSED);
252	{$ENDIF}
253	Result := TStDayType(StDate.DayOfWeek(StDate.DateTimeToStDate(Julian)));
254	end;
255
256	function TStDate.DayOfWeekDMY(Day, Month, Year,
257	Epoch: Integer): TStDayType;
258	begin
259	{$IFDEF LICENSE}
260	if (not FIsLicensed) or (not COMHasBeenLicensed) then
261	OleError(CLASS_E_NOTLICENSED);
262	{$ENDIF}
263	Result := TStDayType(StDate.DayOfWeekDMY(Day, Month, Year, Epoch));
264	end;
265
266	function TStDate.DayOfWeekToString(WeekDay: TStDayType): WideString;
267	begin
268	{$IFDEF LICENSE}
269	if (not FIsLicensed) or (not COMHasBeenLicensed) then
270	OleError(CLASS_E_NOTLICENSED);
271	{$ENDIF}
272	Result := StDateSt.DayOfWeekToString(StDate.TStDayType(WeekDay));
273	end;
274
275	function TStDate.DaysInMonth(Month, Year, Epoch: Integer): Integer;
276	begin
277	{$IFDEF LICENSE}
278	if (not FIsLicensed) or (not COMHasBeenLicensed) then
279	OleError(CLASS_E_NOTLICENSED);
280	{$ENDIF}
281	Result := StDate.DaysInMonth(Month, Year, Epoch);
282	end;
283
284	function TStDate.DecTime(T: TDateTime; Hours, Minutes,
285	Seconds: Byte): TDateTime;
286	begin
287	{$IFDEF LICENSE}
288	if (not FIsLicensed) or (not COMHasBeenLicensed) then
289	OleError(CLASS_E_NOTLICENSED);
290	{$ENDIF}
291	Result := StDate.StTimeToDateTime(StDate.DecTime(StDate.DateTimeToStTime(T),
292	Hours,
293	Minutes,
294	Seconds));
295	end;
296
297	function TStDate.DMYtoStDate(Day, Month, Year, Epoch: Integer): TDateTime;
298	begin
299	{$IFDEF LICENSE}
300	if (not FIsLicensed) or (not COMHasBeenLicensed) then
301	OleError(CLASS_E_NOTLICENSED);
302	{$ENDIF}
303	Result := StDate.StDateToDateTime(StDate.DMYtoStDate(Day, Month, Year, Epoch));
304	end;
305
306	function TStDate.DMYtoDateString(const Picture: WideString; Day, Month,
307	Year, Epoch: Integer; Pack: WordBool): WideString;
308	begin
309	{$IFDEF LICENSE}
310	if (not FIsLicensed) or (not COMHasBeenLicensed) then
311	OleError(CLASS_E_NOTLICENSED);
312	{$ENDIF}
313	Result := StDateSt.DMYtoDateString(Picture, Day, Month, Year, Epoch, Pack);
314	end;
315
316	function TStDate.HMStoStTime(Hours, Minutes, Seconds: Byte): TDateTime;
317	begin
318	{$IFDEF LICENSE}
319	if (not FIsLicensed) or (not COMHasBeenLicensed) then
320	OleError(CLASS_E_NOTLICENSED);
321	{$ENDIF}
322	Result := StDate.StTimeToDateTime(StDate.HMStoStTime(Hours, Minutes, Seconds));
323	end;
324
325	function TStDate.IncDate(Julian: TDateTime; Days, Months,
326	Years: Integer): TDateTime;
327	begin
328	{$IFDEF LICENSE}
329	if (not FIsLicensed) or (not COMHasBeenLicensed) then
330	OleError(CLASS_E_NOTLICENSED);
331	{$ENDIF}
332	Result := StDate.StDateToDateTime(StDate.IncDate(StDate.DateTimeToStDate(Julian),
333	Days,
334	Months,
335	Years));
336	end;
337
338	procedure TStDate.IncDateTime(DT1: TDateTime; var DT2: TDateTime; Days,
339	Seconds: Integer);
340	var
341	DTR1, DTR2 : StDate.TStDateTimeRec;
342	begin
343	{$IFDEF LICENSE}
344	if (not FIsLicensed) or (not COMHasBeenLicensed) then
345	OleError(CLASS_E_NOTLICENSED);
346	{$ENDIF}
347	DTR1.D := StDate.DateTimeToStDate(DT1);
348	DTR1.T := StDate.DateTimeToStTime(DT1);
349
350	StDate.IncDateTime(DTR1, DTR2, Days, Seconds);
351
352	{!! This is not right }
353	DT2 := DTR2.D + DTR2.T;
354	end;
355
356	function TStDate.IncDateTrunc(Julian: TDateTime; Months,
357	Years: Integer): TDateTime;
358	begin
359	{$IFDEF LICENSE}
360	if (not FIsLicensed) or (not COMHasBeenLicensed) then
361	OleError(CLASS_E_NOTLICENSED);
362	{$ENDIF}
363	Result := StDate.StDateToDateTime(StDate.IncDateTrunc(StDate.DateTimeToStDate(Julian),
364	Months,
365	Years));
366	end;
367
368	function TStDate.IncTime(T: TDateTime; Hours, Minutes,
369	Seconds: Byte): TDateTime;
370	begin
371	{$IFDEF LICENSE}
372	if (not FIsLicensed) or (not COMHasBeenLicensed) then
373	OleError(CLASS_E_NOTLICENSED);
374	{$ENDIF}
375	Result := StDate.StTimeToDateTime(StDate.IncTime(StDate.DateTimeToStTime(T),
376	Hours,
377	Minutes,
378	Seconds));
379	end;
380
381	function TStDate.InternationalDate(ForceCentury: WordBool): WideString;
382	begin
383	{$IFDEF LICENSE}
384	if (not FIsLicensed) or (not COMHasBeenLicensed) then
385	OleError(CLASS_E_NOTLICENSED);
386	{$ENDIF}
387	Result := StDateSt.InternationalDate(ForceCentury);
388	end;
389
390	function TStDate.InternationalLongDate(ShortNames,
391	ExcludeDOW: WordBool): WideString;
392	begin
393	{$IFDEF LICENSE}
394	if (not FIsLicensed) or (not COMHasBeenLicensed) then
395	OleError(CLASS_E_NOTLICENSED);
396	{$ENDIF}
397	Result := StDateSt.InternationalLongDate(ShortNames, ExcludeDOW);
398	end;
399
400	function TStDate.InternationalTime(ShowSeconds: WordBool): WideString;
401	begin
402	{$IFDEF LICENSE}
403	if (not FIsLicensed) or (not COMHasBeenLicensed) then
404	OleError(CLASS_E_NOTLICENSED);
405	{$ENDIF}
406	Result := StDateSt.InternationalTime(ShowSeconds);
407	end;
408
409	function TStDate.IsLeapYear(Year: Integer): WordBool;
410	begin
411	{$IFDEF LICENSE}
412	if (not FIsLicensed) or (not COMHasBeenLicensed) then
413	OleError(CLASS_E_NOTLICENSED);
414	{$ENDIF}
415	Result := StDate.IsLeapYear(Year);
416	end;
417
418	function TStDate.MonthToString(Month: Integer): WideString;
419	begin
420	{$IFDEF LICENSE}
421	if (not FIsLicensed) or (not COMHasBeenLicensed) then
422	OleError(CLASS_E_NOTLICENSED);
423	{$ENDIF}
424	Result := StDateSt.MonthToString(Month);
425	end;
426
427	function TStDate.RoundToNearestHour(T: TDateTime;
428	Truncate: WordBool): TDateTime;
429	begin
430	{$IFDEF LICENSE}
431	if (not FIsLicensed) or (not COMHasBeenLicensed) then
432	OleError(CLASS_E_NOTLICENSED);
433	{$ENDIF}
434	Result := StDate.StTimeToDateTime(StDate.RoundToNearestHour(StDate.DateTimeToStTime(T),
435	Truncate));
436	end;
437
438	function TStDate.RoundToNearestMinute(T: TDateTime;
439	Truncate: WordBool): TDateTime;
440	begin
441	{$IFDEF LICENSE}
442	if (not FIsLicensed) or (not COMHasBeenLicensed) then
443	OleError(CLASS_E_NOTLICENSED);
444	{$ENDIF}
445	Result := StDate.StTimeToDateTime(StDate.RoundToNearestMinute(StDate.DateTimeToStTime(T),
446	Truncate));
447	end;
448
449	function TStDate.StDateToDateString(const Picture: WideString;
450	Julian: TDateTime; Pack: WordBool): WideString;
451	begin
452	{$IFDEF LICENSE}
453	if (not FIsLicensed) or (not COMHasBeenLicensed) then
454	OleError(CLASS_E_NOTLICENSED);
455	{$ENDIF}
456	Result := StDateSt.StDateToDateString(Picture, StDate.DateTimeToStDate(Julian), Pack);
457	end;
458
459	procedure TStDate.StDateToDMY(Julian: TDateTime; var Day, Month,
460	Year: Integer);
461	begin
462	{$IFDEF LICENSE}
463	if (not FIsLicensed) or (not COMHasBeenLicensed) then
464	OleError(CLASS_E_NOTLICENSED);
465	{$ENDIF}
466	StDate.StDateToDMY(StDate.DateTimeToStDate(Julian), Day, Month, Year);
467	end;
468
469	function TStDate.StTimeToAmPmString(const Picture: WideString;
470	T: TDateTime; Pack: WordBool): WideString;
471	begin
472	{$IFDEF LICENSE}
473	if (not FIsLicensed) or (not COMHasBeenLicensed) then
474	OleError(CLASS_E_NOTLICENSED);
475	{$ENDIF}
476	StDateSt.StTimeToAmPmString(Picture, StDate.DateTimeToStTime(T), Pack);
477	end;
478
479	procedure TStDate.StTimeToHMS(T: TDateTime; var Hours, Minutes,
480	Seconds: Byte);
481	begin
482	{$IFDEF LICENSE}
483	if (not FIsLicensed) or (not COMHasBeenLicensed) then
484	OleError(CLASS_E_NOTLICENSED);
485	{$ENDIF}
486	StDate.StTimeToHMS(StDate.DateTimeToStTime(T), Hours, Minutes, Seconds);
487	end;
488
489	function TStDate.StTimeToTimeString(const Picture: WideString;
490	T: TDateTime; Pack: WordBool): WideString;
491	begin
492	{$IFDEF LICENSE}
493	if (not FIsLicensed) or (not COMHasBeenLicensed) then
494	OleError(CLASS_E_NOTLICENSED);
495	{$ENDIF}
496	Result := StDateSt.StTimeToTimeString(Picture, StDate.DateTimeToStTime(T), Pack);
497	end;
498
499	procedure TStDate.TimeDiff(T1, T2: TDateTime; var Hours, Minutes,
500	Seconds: Byte);
501	begin
502	{$IFDEF LICENSE}
503	if (not FIsLicensed) or (not COMHasBeenLicensed) then
504	OleError(CLASS_E_NOTLICENSED);
505	{$ENDIF}
506	StDate.TimeDiff(StDate.DateTimeToStTime(T1),
507	StDate.DateTimeToStTime(T2),
508	Hours,
509	Minutes,
510	Seconds);
511	end;
512
513	function TStDate.TimeStringToHMS(const Picture, TS: WideString; var Hours,
514	Minutes, Seconds: Integer): WordBool;
515	begin
516	{$IFDEF LICENSE}
517	if (not FIsLicensed) or (not COMHasBeenLicensed) then
518	OleError(CLASS_E_NOTLICENSED);
519	{$ENDIF}
520	Result := StDateSt.TimeStringToHMS(Picture, TS, Hours, Minutes, Seconds);
521	end;
522
523	function TStDate.TimeStringToStTime(const Picture,
524	S: WideString): TDateTime;
525	begin
526	{$IFDEF LICENSE}
527	if (not FIsLicensed) or (not COMHasBeenLicensed) then
528	OleError(CLASS_E_NOTLICENSED);
529	{$ENDIF}
530	Result := StDate.StTimeToDateTime(StDateSt.TimeStringToStTime(Picture, S));
531	end;
532
533	function TStDate.ValidDate(Day, Month, Year, Epoch: Integer): WordBool;
534	begin
535	{$IFDEF LICENSE}
536	if (not FIsLicensed) or (not COMHasBeenLicensed) then
537	OleError(CLASS_E_NOTLICENSED);
538	{$ENDIF}
539	Result := StDate.ValidDate(Day, Month, Year, Epoch);
540	end;
541
542	function TStDate.ValidTime(Hours, Minutes, Seconds: Integer): WordBool;
543	begin
544	{$IFDEF LICENSE}
545	if (not FIsLicensed) or (not COMHasBeenLicensed) then
546	OleError(CLASS_E_NOTLICENSED);
547	{$ENDIF}
548	Result := StDate.ValidTime(Hours, Minutes, Seconds);
549	end;
550
551	function TStDate.WeekOfYear(Julian: TDateTime): Byte;
552	begin
553	{$IFDEF LICENSE}
554	if (not FIsLicensed) or (not COMHasBeenLicensed) then
555	OleError(CLASS_E_NOTLICENSED);
556	{$ENDIF}
557	Result := StDate.WeekOfYear(StDate.DateTimeToStDate(Julian));
558	end;
559
560	function TStDate.License(const Key: WideString): WordBool;
561	begin
562	{$IFDEF LICENCE}
563	Result := COMIsValidKey(Key);
564	{$ELSE}
565	Result := True;
566	{$ENDIF}
567	FIsLicensed := Result;
568	end;
569
570	initialization
571	TAutoObjectFactory.Create(ComServer, TStDate, Class_StDate, ciMultiInstance, tmBoth);
572	end.