1605 lines
50 KiB
ObjectPascal
1605 lines
50 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ 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 JclSchedule.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Marcel Bestebroer. }
|
|
{ Portions created Marcel Bestebroer are Copyright (C) Marcel Bestebroer. All rights reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Marcel Bestebroer (marcelb) }
|
|
{ Robert Rossmair (rrossmair) }
|
|
{ Petr Vones (pvones) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ This unit contains scheduler classes. }
|
|
{ }
|
|
{ Unit owner: Marcel Bestebroer }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2005/03/08 08:33:17 $
|
|
// For history see end of file
|
|
|
|
unit JclSchedule;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
JclBase;
|
|
|
|
type
|
|
TScheduleRecurringKind = (srkOneShot, srkDaily, srkWeekly, srkMonthly, srkYearly);
|
|
TScheduleEndKind = (sekNone, sekDate, sekTriggerCount, sekDayCount);
|
|
TScheduleWeekDay = (swdMonday, swdTuesday, swdWednesday, swdThursday, swdFriday, swdSaturday,
|
|
swdSunday);
|
|
TScheduleWeekDays = set of TScheduleWeekDay;
|
|
TScheduleIndexKind = (sikNone, sikDay, sikWeekDay, sikWeekendDay, sikMonday, sikTuesday,
|
|
sikWednesday, sikThursday, sikFriday, sikSaturday, sikSunday);
|
|
|
|
const
|
|
sivFirst = 1;
|
|
sivSecond = 2;
|
|
sivThird = 3;
|
|
sivFourth = 4;
|
|
sivLast = -1;
|
|
|
|
type
|
|
// Forwards
|
|
IJclSchedule = interface;
|
|
IJclDailySchedule = interface;
|
|
IJclWeeklySchedule = interface;
|
|
IJclMonthlySchedule = interface;
|
|
IJclYearlySchedule = interface;
|
|
|
|
ESchedule = class(EJclError);
|
|
|
|
IJclSchedule = interface(IUnknown)
|
|
['{1CC54450-7F84-4F27-B1C1-418C451DAD80}']
|
|
function GetStartDate: TTimeStamp;
|
|
function GetRecurringType: TScheduleRecurringKind;
|
|
function GetEndType: TScheduleEndKind;
|
|
function GetEndDate: TTimeStamp;
|
|
function GetEndCount: Cardinal;
|
|
procedure SetStartDate(const Value: TTimeStamp);
|
|
procedure SetRecurringType(Value: TScheduleRecurringKind);
|
|
procedure SetEndType(Value: TScheduleEndKind);
|
|
procedure SetEndDate(const Value: TTimeStamp);
|
|
procedure SetEndCount(Value: Cardinal);
|
|
|
|
function TriggerCount: Cardinal;
|
|
function DayCount: Cardinal;
|
|
function LastTriggered: TTimeStamp;
|
|
|
|
procedure InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
|
|
LastDayCount: Cardinal);
|
|
procedure Reset;
|
|
function NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
function NextEventFrom(const FromEvent: TTimeStamp; CountMissedEvent: Boolean = False): TTimeStamp;
|
|
function NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
|
|
property StartDate: TTimeStamp read GetStartDate write SetStartDate;
|
|
property RecurringType: TScheduleRecurringKind read GetRecurringType write SetRecurringType;
|
|
property EndType: TScheduleEndKind read GetEndType write SetEndType;
|
|
property EndDate: TTimeStamp read GetEndDate write SetEndDate;
|
|
property EndCount: Cardinal read GetEndCount write SetEndCount;
|
|
end;
|
|
|
|
IJclScheduleDayFrequency = interface(IUnknown)
|
|
['{6CF37F0D-56F4-4AE6-BBCA-7B9DFE60F50D}']
|
|
function GetStartTime: Cardinal;
|
|
function GetEndTime: Cardinal;
|
|
function GetInterval: Cardinal;
|
|
procedure SetStartTime(Value: Cardinal);
|
|
procedure SetEndTime(Value: Cardinal);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property StartTime: Cardinal read GetStartTime write SetStartTime;
|
|
property EndTime: Cardinal read GetEndTime write SetEndTime;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
IJclDailySchedule = interface(IUnknown)
|
|
['{540E22C5-BE14-4539-AFB3-E24A67C58D8A}']
|
|
function GetEveryWeekDay: Boolean;
|
|
function GetInterval: Cardinal;
|
|
procedure SetEveryWeekDay(Value: Boolean);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property EveryWeekDay: Boolean read GetEveryWeekDay write SetEveryWeekDay;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
IJclWeeklySchedule = interface(IUnknown)
|
|
['{73F15D99-C6A1-4526-8DE3-A2110E099BBC}']
|
|
function GetDaysOfWeek: TScheduleWeekDays;
|
|
function GetInterval: Cardinal;
|
|
procedure SetDaysOfWeek(Value: TScheduleWeekDays);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property DaysOfWeek: TScheduleWeekDays read GetDaysOfWeek write SetDaysOfWeek;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
IJclMonthlySchedule = interface(IUnknown)
|
|
['{705E17FC-83E6-4385-8D2D-17013052E9B3}']
|
|
function GetIndexKind: TScheduleIndexKind;
|
|
function GetIndexValue: Integer;
|
|
function GetDay: Cardinal;
|
|
function GetInterval: Cardinal;
|
|
procedure SetIndexKind(Value: TScheduleIndexKind);
|
|
procedure SetIndexValue(Value: Integer);
|
|
procedure SetDay(Value: Cardinal);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind;
|
|
property IndexValue: Integer read GetIndexValue write SetIndexValue;
|
|
property Day: Cardinal read GetDay write SetDay;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
IJclYearlySchedule = interface(IUnknown)
|
|
['{3E5303B0-FFA0-495A-96BB-14A718A01C1B}']
|
|
function GetIndexKind: TScheduleIndexKind;
|
|
function GetIndexValue: Integer;
|
|
function GetDay: Cardinal;
|
|
function GetMonth: Cardinal;
|
|
function GetInterval: Cardinal;
|
|
procedure SetIndexKind(Value: TScheduleIndexKind);
|
|
procedure SetIndexValue(Value: Integer);
|
|
procedure SetDay(Value: Cardinal);
|
|
procedure SetMonth(Value: Cardinal);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind;
|
|
property IndexValue: Integer read GetIndexValue write SetIndexValue;
|
|
property Day: Cardinal read GetDay write SetDay;
|
|
property Month: Cardinal read GetMonth write SetMonth;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
function CreateSchedule: IJclSchedule;
|
|
function NullStamp: TTimeStamp;
|
|
function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64;
|
|
function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean;
|
|
function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclDateTime, JclResources;
|
|
|
|
{$IFNDEF RTL140_UP}
|
|
|
|
const
|
|
S_OK = $00000000;
|
|
E_NOINTERFACE = HRESULT($80004002);
|
|
|
|
type
|
|
TAggregatedObject = class
|
|
private
|
|
FController: Pointer;
|
|
function GetController: IUnknown;
|
|
protected
|
|
{ IUnknown }
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
public
|
|
constructor Create(Controller: IUnknown);
|
|
property Controller: IUnknown read GetController;
|
|
end;
|
|
|
|
TContainedObject = class(TAggregatedObject, IUnknown)
|
|
protected
|
|
{ IUnknown }
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
|
end;
|
|
|
|
//=== { TAggregatedObject } ==================================================
|
|
|
|
constructor TAggregatedObject.Create(Controller: IUnknown);
|
|
begin
|
|
FController := Pointer(Controller);
|
|
end;
|
|
|
|
function TAggregatedObject.GetController: IUnknown;
|
|
begin
|
|
Result := IUnknown(FController);
|
|
end;
|
|
|
|
function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
Result := IUnknown(FController).QueryInterface(IID, Obj);
|
|
end;
|
|
|
|
function TAggregatedObject._AddRef: Integer;
|
|
begin
|
|
Result := IUnknown(FController)._AddRef;
|
|
end;
|
|
|
|
function TAggregatedObject._Release: Integer; stdcall;
|
|
begin
|
|
Result := IUnknown(FController)._Release;
|
|
end;
|
|
|
|
//=== { TContainedObject } ===================================================
|
|
|
|
function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
{$ENDIF ~RTL140_UP}
|
|
|
|
// Utility functions
|
|
function NullStamp: TTimeStamp;
|
|
begin
|
|
Result.Date := 0;
|
|
Result.Time := -1;
|
|
end;
|
|
|
|
function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64;
|
|
begin
|
|
if Stamp1.Date < Stamp2.Date then
|
|
Result := -1
|
|
else
|
|
if Stamp1.Date = Stamp2.Date then
|
|
begin
|
|
if Stamp1.Time < Stamp2.Time then
|
|
Result := -1
|
|
else
|
|
if Stamp1.Time = Stamp2.Time then
|
|
Result := 0
|
|
else // If Stamp1.Time > Stamp2.Time then
|
|
Result := 1;
|
|
end
|
|
else // if Stamp1.Date > Stamp2.Date then
|
|
Result := 1;
|
|
// Result := Int64(Stamp1) - Int64(Stamp2);
|
|
end;
|
|
|
|
function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean;
|
|
begin
|
|
Result := CompareTimeStamps(Stamp1, Stamp2) = 0;
|
|
end;
|
|
|
|
function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean;
|
|
begin
|
|
Result := CompareTimeStamps(NullStamp, Stamp) = 0;
|
|
end;
|
|
|
|
function TimeStampDOW(const Stamp: TTimeStamp): Integer;
|
|
begin
|
|
Result := (Stamp.Date - 1) mod 7 + 1
|
|
end;
|
|
|
|
function ISODayOfWeek(DateTime: TDateTime): Integer;
|
|
begin
|
|
Result := (DayOfWeek(DateTime - 2 + 7) mod 7) + 1;
|
|
end;
|
|
|
|
function FirstWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1));
|
|
if DOW > 5 then
|
|
begin
|
|
Result := 9 - DOW;
|
|
DOW := 1;
|
|
end
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
function LastWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))));
|
|
if DOW > 5 then
|
|
begin
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (DOW - 5);
|
|
DOW := 5;
|
|
end
|
|
else
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1));
|
|
end;
|
|
|
|
function FirstWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1));
|
|
if DOW < 6 then
|
|
begin
|
|
Result := 7 - DOW;
|
|
DOW := 6;
|
|
end
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
function LastWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))));
|
|
if DOW < 6 then
|
|
begin
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - DOW;
|
|
DOW := 7;
|
|
end
|
|
else
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1));
|
|
end;
|
|
|
|
function FirstWeekDay(const Year, Month: Integer): Integer;
|
|
var
|
|
Dummy: Integer;
|
|
begin
|
|
Result := FirstWeekDayPrim(Year, Month, Dummy);
|
|
end;
|
|
|
|
function LastWeekDay(const Year, Month: Integer): Integer;
|
|
var
|
|
Dummy: Integer;
|
|
begin
|
|
Result := LastWeekDayPrim(Year, Month, Dummy);
|
|
end;
|
|
|
|
function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer;
|
|
var
|
|
DOW: Integer;
|
|
begin
|
|
if Index > 0 then
|
|
Result := FirstWeekDayPrim(Year, Month, DOW)
|
|
else
|
|
if Index < 0 then
|
|
Result := LastWeekDayPrim(Year, Month, DOW)
|
|
else
|
|
Result := 0;
|
|
if Index > 1 then // n-th weekday from start of month
|
|
begin
|
|
Dec(Index);
|
|
if DOW > 1 then // adjust to first monday
|
|
begin
|
|
if Index < (5 - DOW) then
|
|
begin
|
|
Inc(Result, Index);
|
|
Index := 0;
|
|
end
|
|
else
|
|
begin
|
|
Dec(Index, 6 - DOW);
|
|
Inc(Result, 8 - DOW);
|
|
end;
|
|
end;
|
|
Result := Result + (7 * (Index div 5)) + (Index mod 5);
|
|
end
|
|
else
|
|
if Index < -1 then // n-th weekday from end of month
|
|
begin
|
|
Index := Abs(Index) - 1;
|
|
if DOW < 5 then // adjust to last friday
|
|
begin
|
|
if Index < DOW then
|
|
begin
|
|
Dec(Result, Index);
|
|
Index := 0;
|
|
end
|
|
else
|
|
begin
|
|
Dec(Index, DOW);
|
|
Dec(Result, DOW + 2);
|
|
end;
|
|
end;
|
|
Result := Result - (7 * (Index div 5)) - (Index mod 5);
|
|
end;
|
|
if (Result < 0) or (Result > DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))) then
|
|
Result := 0;
|
|
end;
|
|
|
|
function FirstWeekendDay(const Year, Month: Integer): Integer;
|
|
var
|
|
Dummy: Integer;
|
|
begin
|
|
Result := FirstWeekendDayPrim(Year, Month, Dummy);
|
|
end;
|
|
|
|
function LastWeekendDay(const Year, Month: Integer): Integer;
|
|
var
|
|
Dummy: Integer;
|
|
begin
|
|
Result := LastWeekendDayPrim(Year, Month, Dummy);
|
|
end;
|
|
|
|
function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer;
|
|
var
|
|
DOW: Integer;
|
|
begin
|
|
if Index > 0 then
|
|
Result := FirstWeekendDayPrim(Year, Month, DOW)
|
|
else
|
|
if Index < 0 then
|
|
Result := LastWeekendDayPrim(Year, Month, DOW)
|
|
else
|
|
Result := 0;
|
|
if Index > 1 then // n-th weekend day from the start of the month
|
|
begin
|
|
if (DOW > 6) and not Odd(Index) then // Adjust to first saturday
|
|
begin
|
|
Inc(Result, 6);
|
|
Dec(Index);
|
|
end;
|
|
if Index > 1 then
|
|
begin
|
|
Dec(Index);
|
|
Result := Result + (7 * (Index div 2)) + (Index mod 2);
|
|
end;
|
|
end
|
|
else
|
|
if Index < -1 then // n-th weekend day from the start of the month
|
|
begin
|
|
Index := Abs(Index);
|
|
if (DOW < 7) and not Odd(Index) then // Adjust to last sunday
|
|
begin
|
|
Dec(Result, 6);
|
|
Dec(Index);
|
|
end;
|
|
if Index > 1 then
|
|
begin
|
|
Dec(Index);
|
|
Result := Result - (7 * (Index div 2)) - (Index mod 2);
|
|
end;
|
|
end;
|
|
if (Result < 0) or (Result > DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))) then
|
|
Result := 0;
|
|
end;
|
|
|
|
function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer;
|
|
var
|
|
DOW: Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1));
|
|
if DOW > DayOfWeek then
|
|
Result := 8 + DayOfWeek - DOW
|
|
else
|
|
if DOW < DayOfWeek then
|
|
Result := 1 + DayOfWeek - DOW
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
function LastDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer;
|
|
var
|
|
DOW: Integer;
|
|
begin
|
|
DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))));
|
|
if DOW > DayOfWeek then
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (DOW - DayOfWeek)
|
|
else
|
|
if DOW < DayOfWeek then
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (7 + DayOfWeek - DOW)
|
|
else
|
|
Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1));
|
|
end;
|
|
|
|
function IndexedDayOfWeek(const Year, Month, DayOfWeek, Index: Integer): Integer;
|
|
begin
|
|
if Index > 0 then
|
|
Result := FirstDayOfWeek(Year, Month, DayOfWeek) + 7 * (Index - 1)
|
|
else
|
|
if Index < 0 then
|
|
Result := LastDayOfWeek(Year, Month, DayOfWeek) - 7 * (Abs(Index) - 1)
|
|
else
|
|
Result := 0;
|
|
if (Result < 0) or (Result > DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))) then
|
|
Result := 0;
|
|
end;
|
|
|
|
//=== { TScheduleAggregate } =================================================
|
|
|
|
type
|
|
TScheduleAggregate = class(TAggregatedObject)
|
|
protected
|
|
procedure CheckInterfaceAllowed;
|
|
function InterfaceAllowed: Boolean;
|
|
function Schedule: IJclSchedule;
|
|
class function RecurringType: TScheduleRecurringKind; virtual;
|
|
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean; virtual; abstract;
|
|
procedure MakeValidStamp(var Stamp: TTimeStamp); virtual; abstract;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; virtual; abstract;
|
|
end;
|
|
|
|
procedure TScheduleAggregate.CheckInterfaceAllowed;
|
|
begin
|
|
if not InterfaceAllowed then
|
|
RunError(23); // reIntfCastError
|
|
end;
|
|
|
|
function TScheduleAggregate.InterfaceAllowed: Boolean;
|
|
begin
|
|
Result := Schedule.RecurringType = RecurringType;
|
|
end;
|
|
|
|
function TScheduleAggregate.Schedule: IJclSchedule;
|
|
begin
|
|
Result := Controller as IJclSchedule;
|
|
end;
|
|
|
|
class function TScheduleAggregate.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkOneShot;
|
|
end;
|
|
|
|
//=== { TDailyFreq } =========================================================
|
|
|
|
type
|
|
TDailyFreq = class(TAggregatedObject)
|
|
private
|
|
FStartTime: Cardinal;
|
|
FEndTime: Cardinal;
|
|
FInterval: Cardinal;
|
|
protected
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
public
|
|
constructor Create(const Controller: IUnknown);
|
|
// IJclScheduleDayFrequency
|
|
function GetStartTime: Cardinal;
|
|
function GetEndTime: Cardinal;
|
|
function GetInterval: Cardinal;
|
|
procedure SetStartTime(Value: Cardinal);
|
|
procedure SetEndTime(Value: Cardinal);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property StartTime: Cardinal read GetStartTime write SetStartTime;
|
|
property EndTime: Cardinal read GetEndTime write SetEndTime;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
constructor TDailyFreq.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FStartTime := 0;
|
|
FEndTime := HoursToMSecs(24) - 1;
|
|
FInterval := 500;
|
|
end;
|
|
|
|
function TDailyFreq.ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
begin
|
|
Result := (Cardinal(Stamp.Time) >= FStartTime) and (Cardinal(Stamp.Time) <= FEndTime) and
|
|
((Cardinal(Stamp.Time) - FStartTime) mod FInterval = 0);
|
|
end;
|
|
|
|
function TDailyFreq.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
begin
|
|
Result := Stamp;
|
|
if Stamp.Time < Integer(FStartTime) then
|
|
Result.Time := FStartTime
|
|
else
|
|
if ((Cardinal(Stamp.Time) - FStartTime) mod FInterval) <> 0 then
|
|
Result.Time := Stamp.Time + Integer(FInterval-(Cardinal(Stamp.Time) - FStartTime) mod FInterval)
|
|
else
|
|
Result.Time := Stamp.Time + Integer(FInterval);
|
|
if (Result.Time < 0) or (Cardinal(Result.Time) > FEndTime) then
|
|
Result := NullStamp;
|
|
end;
|
|
|
|
function TDailyFreq.GetStartTime: Cardinal;
|
|
begin
|
|
Result := FStartTime;
|
|
end;
|
|
|
|
function TDailyFreq.GetEndTime: Cardinal;
|
|
begin
|
|
Result := FEndTime;
|
|
end;
|
|
|
|
function TDailyFreq.GetInterval: Cardinal;
|
|
begin
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TDailyFreq.SetStartTime(Value: Cardinal);
|
|
begin
|
|
if Value <> FStartTime then
|
|
begin
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise ESchedule.CreateRes(@RsScheduleInvalidTime);
|
|
FStartTime := Value;
|
|
if EndTime < StartTime then
|
|
FEndTime := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDailyFreq.SetEndTime(Value: Cardinal);
|
|
begin
|
|
if Value <> FEndTime then
|
|
begin
|
|
if Value < FStartTime then
|
|
raise ESchedule.CreateRes(@RsScheduleEndBeforeStart);
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise ESchedule.CreateRes(@RsScheduleInvalidTime);
|
|
FEndTime := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDailyFreq.SetInterval(Value: Cardinal);
|
|
begin
|
|
if Value <> FInterval then
|
|
begin
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise ESchedule.CreateRes(@RsScheduleInvalidTime);
|
|
if Value = 0 then
|
|
begin
|
|
FEndTime := FStartTime;
|
|
FInterval := 1;
|
|
end
|
|
else
|
|
FInterval := Value;
|
|
end;
|
|
end;
|
|
|
|
//=== { TDailySchedule } =====================================================
|
|
|
|
type
|
|
TDailySchedule = class(TScheduleAggregate)
|
|
private
|
|
FEveryWeekDay: Boolean;
|
|
FInterval: Cardinal;
|
|
protected
|
|
class function RecurringType: TScheduleRecurringKind; override;
|
|
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean; override;
|
|
procedure MakeValidStamp(var Stamp: TTimeStamp); override;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override;
|
|
public
|
|
constructor Create(const Controller: IUnknown);
|
|
// IJclDailySchedule
|
|
function GetEveryWeekDay: Boolean;
|
|
function GetInterval: Cardinal;
|
|
procedure SetEveryWeekDay(Value: Boolean);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property EveryWeekDay: Boolean read GetEveryWeekDay write SetEveryWeekDay;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
constructor TDailySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FEveryWeekDay := True;
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TDailySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkDaily;
|
|
end;
|
|
|
|
function TDailySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
begin
|
|
Result := (FEveryWeekDay and (TimeStampDOW(Stamp) < 6)) or
|
|
(not FEveryWeekDay and (Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval = 0));
|
|
end;
|
|
|
|
procedure TDailySchedule.MakeValidStamp(var Stamp: TTimeStamp);
|
|
begin
|
|
if FEveryWeekDay and (TimeStampDOW(Stamp) >= 6) then
|
|
Inc(Stamp.Date, 2 - (TimeStampDOW(Stamp) - 6))
|
|
else
|
|
if not FEveryWeekDay and (Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval <> 0) then
|
|
Inc(Stamp.Date, Interval - Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval);
|
|
end;
|
|
|
|
function TDailySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
begin
|
|
Result := Stamp;
|
|
MakeValidStamp(Result);
|
|
if EqualTimeStamps(Stamp, Result) then
|
|
begin
|
|
// Time stamp has not been adjusted (it was valid). Determine the next time stamp
|
|
if FEveryWeekDay then
|
|
begin
|
|
Inc(Result.Date);
|
|
MakeValidStamp(Result); // Skip over the weekend.
|
|
end
|
|
else
|
|
Inc(Result.Date, Interval); // always valid as we started with a valid stamp
|
|
end;
|
|
end;
|
|
|
|
function TDailySchedule.GetEveryWeekDay: Boolean;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FEveryWeekDay;
|
|
end;
|
|
|
|
function TDailySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if EveryWeekDay then
|
|
Result := 0
|
|
else
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TDailySchedule.SetEveryWeekDay(Value: Boolean);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
FEveryWeekDay := Value;
|
|
end;
|
|
|
|
procedure TDailySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise ESchedule.CreateRes(@RsScheduleIntervalZero);
|
|
if FEveryWeekDay then
|
|
FEveryWeekDay := False;
|
|
if Value <> FInterval then
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TWeeklySchedule } ====================================================
|
|
|
|
type
|
|
TWeeklySchedule = class(TScheduleAggregate)
|
|
private
|
|
FDaysOfWeek: TScheduleWeekDays;
|
|
FInterval: Cardinal;
|
|
protected
|
|
class function RecurringType: TScheduleRecurringKind; override;
|
|
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean; override;
|
|
procedure MakeValidStamp(var Stamp: TTimeStamp); override;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override;
|
|
public
|
|
constructor Create(const Controller: IUnknown);
|
|
// IJclWeeklySchedule
|
|
function GetDaysOfWeek: TScheduleWeekDays;
|
|
function GetInterval: Cardinal;
|
|
procedure SetDaysOfWeek(Value: TScheduleWeekDays);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property DaysOfWeek: TScheduleWeekDays read GetDaysOfWeek write SetDaysOfWeek;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
constructor TWeeklySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FDaysOfWeek := [swdMonday];
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TWeeklySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkWeekly;
|
|
end;
|
|
|
|
function TWeeklySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
begin
|
|
Result := (TScheduleWeekDay(TimeStampDOW(Stamp)) in DaysOfWeek) and
|
|
(Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval = 0);
|
|
end;
|
|
|
|
procedure TWeeklySchedule.MakeValidStamp(var Stamp: TTimeStamp);
|
|
begin
|
|
while not (TScheduleWeekDay(TimeStampDOW(Stamp) - 1) in DaysOfWeek) do
|
|
Inc(Stamp.Date);
|
|
if (Stamp.Date - Schedule.StartDate.Date) <> 0 then
|
|
begin
|
|
if Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval <> 0 then
|
|
Inc(Stamp.Date, 7 * (Interval -
|
|
(Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval)));
|
|
end;
|
|
end;
|
|
|
|
function TWeeklySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
begin
|
|
Result := Stamp;
|
|
MakeValidStamp(Result);
|
|
if EqualTimeStamps(Stamp, Result) then
|
|
begin
|
|
// Time stamp has not been adjusted (it was valid). Determine the next time stamp
|
|
Inc(Result.Date);
|
|
MakeValidStamp(Result); // Skip over unwanted days and weeks
|
|
end;
|
|
end;
|
|
|
|
function TWeeklySchedule.GetDaysOfWeek: TScheduleWeekDays;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FDaysOfWeek;
|
|
end;
|
|
|
|
function TWeeklySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TWeeklySchedule.SetDaysOfWeek(Value: TScheduleWeekDays);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = [] then
|
|
raise ESchedule.CreateRes(@RsScheduleNoDaySpecified);
|
|
FDaysOfWeek := Value;
|
|
end;
|
|
|
|
procedure TWeeklySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise ESchedule.CreateRes(@RsScheduleIntervalZero);
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TMonthlySchedule } ===================================================
|
|
|
|
type
|
|
TMonthlySchedule = class(TScheduleAggregate)
|
|
private
|
|
FIndexKind: TScheduleIndexKind;
|
|
FIndexValue: Integer;
|
|
FDay: Cardinal;
|
|
FInterval: Cardinal;
|
|
protected
|
|
class function RecurringType: TScheduleRecurringKind; override;
|
|
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean; override;
|
|
procedure MakeValidStamp(var Stamp: TTimeStamp); override;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override;
|
|
|
|
function ValidStampMonthIndex(const TYear, TMonth, TDay: Word): Boolean;
|
|
procedure MakeValidStampMonthIndex(var TYear, TMonth, TDay: Word);
|
|
public
|
|
constructor Create(const Controller: IUnknown);
|
|
// IJclMonthlySchedule
|
|
function GetIndexKind: TScheduleIndexKind;
|
|
function GetIndexValue: Integer;
|
|
function GetDay: Cardinal;
|
|
function GetInterval: Cardinal;
|
|
procedure SetIndexKind(Value: TScheduleIndexKind);
|
|
procedure SetIndexValue(Value: Integer);
|
|
procedure SetDay(Value: Cardinal);
|
|
procedure SetInterval(Value: Cardinal);
|
|
|
|
property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind;
|
|
property IndexValue: Integer read GetIndexValue write SetIndexValue;
|
|
property Day: Cardinal read GetDay write SetDay;
|
|
property Interval: Cardinal read GetInterval write SetInterval;
|
|
end;
|
|
|
|
constructor TMonthlySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FIndexKind := sikNone;
|
|
FIndexValue := sivFirst;
|
|
FDay := 1;
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TMonthlySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkMonthly;
|
|
end;
|
|
|
|
function TMonthlySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
var
|
|
SYear, SMonth, SDay: Word;
|
|
TYear, TMonth, TDay: Word;
|
|
begin
|
|
DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
|
|
DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
|
|
Result := (((TYear * 12 + TMonth) - (SYear * 12 + SMonth)) mod Integer(Interval) = 0) and
|
|
ValidStampMonthIndex(TYear, TMonth, TDay);
|
|
end;
|
|
|
|
procedure TMonthlySchedule.MakeValidStamp(var Stamp: TTimeStamp);
|
|
var
|
|
SYear, SMonth, SDay: Word;
|
|
TYear, TMonth, TDay: Word;
|
|
MonthDiff: Integer;
|
|
begin
|
|
DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
|
|
DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
|
|
MonthDiff := (TYear * 12 + TMonth) - (SYear * 12 + SMonth);
|
|
if MonthDiff mod Integer(Interval) <> 0 then
|
|
begin
|
|
Inc(TMonth, Integer(Interval) - (MonthDiff mod Integer(Interval)));
|
|
if TMonth > 12 then
|
|
begin
|
|
Inc(TYear, TMonth div 12);
|
|
TMonth := TMonth mod 12;
|
|
end;
|
|
TDay := 1;
|
|
end;
|
|
MakeValidStampMonthIndex(TYear, TMonth, TDay);
|
|
while DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date < Stamp.Date do
|
|
begin
|
|
Inc(TMonth, Integer(Interval));
|
|
if TMonth > 12 then
|
|
begin
|
|
Inc(TYear, TMonth div 12);
|
|
TMonth := TMonth mod 12;
|
|
end;
|
|
MakeValidStampMonthIndex(TYear, TMonth, TDay);
|
|
end;
|
|
Stamp.Date := DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date;
|
|
end;
|
|
|
|
function TMonthlySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
begin
|
|
Result := Stamp;
|
|
MakeValidStamp(Result);
|
|
if EqualTimeStamps(Stamp, Result) then
|
|
begin
|
|
// Time stamp has not been adjusted (it was valid). Determine the next time stamp
|
|
Inc(Result.Date);
|
|
MakeValidStamp(Result); // Skip over unwanted days and months
|
|
end;
|
|
end;
|
|
|
|
function TMonthlySchedule.ValidStampMonthIndex(const TYear, TMonth, TDay: Word): Boolean;
|
|
var
|
|
DIM: Integer;
|
|
TempDay: Integer;
|
|
begin
|
|
DIM := DaysInMonth(JclDateTime.EncodeDate(TYear, TMonth, 1));
|
|
case IndexKind of
|
|
sikNone:
|
|
Result := (TDay = Day) or ((Integer(Day) > DIM) and (TDay = DIM));
|
|
sikDay:
|
|
Result :=
|
|
((IndexValue = sivLast) and (TDay = DIM)) or
|
|
((IndexValue <> sivLast) and (
|
|
(TDay = IndexValue) or (
|
|
(IndexValue > DIM) and
|
|
(TDay = DIM)
|
|
) or (
|
|
(IndexValue < 0) and (
|
|
(TDay = DIM + 1 + IndexValue) or (
|
|
(-IndexValue > DIM) and
|
|
(TDay = 1)
|
|
)
|
|
)
|
|
)
|
|
));
|
|
sikWeekDay:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TempDay := FirstWeekDay(TYear, TMonth);
|
|
sivLast:
|
|
TempDay := LastWeekDay(TYear, TMonth);
|
|
else
|
|
TempDay := IndexedWeekDay(TYear, TMonth, IndexValue);
|
|
if TempDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TempDay := LastWeekDay(TYear, TMonth)
|
|
else
|
|
if IndexValue < 0 then
|
|
TempDay := FirstWeekDay(TYear, TMonth);
|
|
end;
|
|
end;
|
|
Result := TDay = TempDay;
|
|
end;
|
|
sikWeekendDay:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TempDay := FirstWeekendDay(TYear, TMonth);
|
|
sivLast:
|
|
TempDay := LastWeekendDay(TYear, TMonth);
|
|
else
|
|
TempDay := IndexedWeekendDay(TYear, TMonth, IndexValue);
|
|
if TempDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TempDay := LastWeekendDay(TYear, TMonth)
|
|
else
|
|
if IndexValue < 0 then
|
|
TempDay := FirstWeekendDay(TYear, TMonth);
|
|
end;
|
|
end;
|
|
Result := TDay = TempDay;
|
|
end;
|
|
sikMonday..sikSunday:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TempDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
sivLast:
|
|
TempDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
else
|
|
TempDay := IndexedDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay),
|
|
IndexValue);
|
|
if TempDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TempDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay))
|
|
else
|
|
if IndexValue < 0 then
|
|
TempDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
end;
|
|
end;
|
|
Result := TDay = TempDay;
|
|
end;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TMonthlySchedule.MakeValidStampMonthIndex(var TYear, TMonth, TDay: Word);
|
|
var
|
|
DIM: Integer;
|
|
begin
|
|
DIM := DaysInMonth(JclDateTime.EncodeDate(TYear, TMonth, 1));
|
|
case IndexKind of
|
|
sikNone:
|
|
begin
|
|
TDay := Day;
|
|
if Integer(Day) > DIM then
|
|
TDay := DIM;
|
|
end;
|
|
sikDay:
|
|
begin
|
|
if (IndexValue = sivLast) or (Integer(IndexValue) > DIM) then
|
|
TDay := DIM
|
|
else
|
|
if IndexValue > 0 then
|
|
TDay := IndexValue
|
|
else
|
|
begin
|
|
if -IndexValue > DIM then
|
|
TDay := 1
|
|
else
|
|
TDay := DIM + 1 + IndexValue;
|
|
end;
|
|
end;
|
|
sikWeekDay:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TDay := FirstWeekDay(TYear, TMonth);
|
|
sivLast:
|
|
TDay := LastWeekDay(TYear, TMonth);
|
|
else
|
|
begin
|
|
TDay := IndexedWeekDay(TYear, TMonth, IndexValue);
|
|
if TDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TDay := LastWeekDay(TYear, TMonth)
|
|
else
|
|
if IndexValue < 0 then
|
|
TDay := FirstWeekDay(TYear, TMonth);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
sikWeekendDay:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TDay := FirstWeekendDay(TYear, TMonth);
|
|
sivLast:
|
|
TDay := LastWeekendDay(TYear, TMonth);
|
|
else
|
|
begin
|
|
TDay := IndexedWeekendDay(TYear, TMonth, IndexValue);
|
|
if TDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TDay := LastWeekendDay(TYear, TMonth)
|
|
else
|
|
if IndexValue < 0 then
|
|
TDay := FirstWeekendDay(TYear, TMonth);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
sikMonday..sikSunday:
|
|
begin
|
|
case IndexValue of
|
|
sivFirst:
|
|
TDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
sivLast:
|
|
TDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
else
|
|
TDay := IndexedDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay),
|
|
IndexValue);
|
|
if TDay = 0 then
|
|
begin
|
|
if IndexValue > 0 then
|
|
TDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay))
|
|
else
|
|
if IndexValue < 0 then
|
|
TDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMonthlySchedule.GetIndexKind: TScheduleIndexKind;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FIndexKind;
|
|
end;
|
|
|
|
function TMonthlySchedule.GetIndexValue: Integer;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikDay .. sikSunday]) then
|
|
raise ESchedule.CreateRes(@RsScheduleIndexValueSup);
|
|
Result := FIndexValue;
|
|
end;
|
|
|
|
function TMonthlySchedule.GetDay: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FDay;
|
|
end;
|
|
|
|
function TMonthlySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TMonthlySchedule.SetIndexKind(Value: TScheduleIndexKind);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
FIndexKind := Value;
|
|
end;
|
|
|
|
procedure TMonthlySchedule.SetIndexValue(Value: Integer);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikDay .. sikSunday]) then
|
|
raise ESchedule.CreateRes(@RsScheduleIndexValueSup);
|
|
if Value = 0 then
|
|
raise ESchedule.CreateRes(@RsScheduleIndexValueZero);
|
|
FIndexValue := Value;
|
|
end;
|
|
|
|
procedure TMonthlySchedule.SetDay(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikNone]) then
|
|
raise ESchedule.CreateRes(@RsScheduleDayNotSupported);
|
|
if (Value = 0) or (Value > 31) then
|
|
raise ESchedule.CreateRes(@RsScheduleDayInRange);
|
|
FDay := Value;
|
|
end;
|
|
|
|
procedure TMonthlySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise ESchedule.CreateRes(@RsScheduleIntervalZero);
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TYearlySchedule } ====================================================
|
|
|
|
type
|
|
TYearlySchedule = class(TMonthlySchedule)
|
|
private
|
|
FMonth: Cardinal;
|
|
protected
|
|
class function RecurringType: TScheduleRecurringKind; override;
|
|
|
|
function ValidStamp(const Stamp: TTimeStamp): Boolean; override;
|
|
procedure MakeValidStamp(var Stamp: TTimeStamp); override;
|
|
function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override;
|
|
public
|
|
constructor Create(const Controller: IUnknown);
|
|
// IJclYearlySchedule
|
|
function GetMonth: Cardinal;
|
|
procedure SetMonth(Value: Cardinal);
|
|
|
|
property Month: Cardinal read GetMonth write SetMonth;
|
|
end;
|
|
|
|
constructor TYearlySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FMonth := 1;
|
|
end;
|
|
|
|
class function TYearlySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkYearly;
|
|
end;
|
|
|
|
function TYearlySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean;
|
|
var
|
|
SYear, SMonth, SDay: Word;
|
|
TYear, TMonth, TDay: Word;
|
|
begin
|
|
JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
|
|
JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
|
|
Result := ((TYear - SYear) mod Integer(Interval) = 0) and (TMonth = Month) and
|
|
ValidStampMonthIndex(TYear, TMonth, TDay);
|
|
end;
|
|
|
|
procedure TYearlySchedule.MakeValidStamp(var Stamp: TTimeStamp);
|
|
var
|
|
SYear, SMonth, SDay: Word;
|
|
TYear, TMonth, TDay: Word;
|
|
YearDiff: Integer;
|
|
begin
|
|
JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
|
|
JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
|
|
YearDiff := TYear - SYear;
|
|
if YearDiff mod Integer(Interval) <> 0 then
|
|
begin
|
|
Inc(TYear, Integer(Interval) - (YearDiff mod Integer(Interval)));
|
|
TMonth := Month;
|
|
TDay := 1;
|
|
end;
|
|
MakeValidStampMonthIndex(TYear, TMonth, TDay);
|
|
while DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date < Stamp.Date do
|
|
begin
|
|
Inc(TYear, Integer(Interval));
|
|
TMonth := Month;
|
|
TDay := 1;
|
|
MakeValidStampMonthIndex(TYear, TMonth, TDay);
|
|
end;
|
|
Stamp.Date := DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date;
|
|
end;
|
|
|
|
function TYearlySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
|
|
begin
|
|
Result := Stamp;
|
|
MakeValidStamp(Result);
|
|
if EqualTimeStamps(Stamp, Result) then
|
|
begin
|
|
// Time stamp has not been adjusted (it was valid). Determine the next time stamp
|
|
Inc(Result.Date);
|
|
MakeValidStamp(Result); // Skip over unwanted days and months
|
|
end;
|
|
end;
|
|
|
|
function TYearlySchedule.GetMonth: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FMonth;
|
|
end;
|
|
|
|
procedure TYearlySchedule.SetMonth(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if (Value < 1) or (Value > 12) then
|
|
raise ESchedule.CreateRes(@RsScheduleMonthInRange);
|
|
FMonth := Value;
|
|
end;
|
|
|
|
//=== { TSchedule } ==========================================================
|
|
|
|
type
|
|
TSchedule = class(TInterfacedObject, IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule,
|
|
IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule)
|
|
private
|
|
FStartDate: TTimeStamp;
|
|
FRecurringType: TScheduleRecurringKind;
|
|
FEndType: TScheduleEndKind;
|
|
FEndDate: TTimeStamp;
|
|
FEndCount: Cardinal;
|
|
FDailyFreq: TDailyFreq;
|
|
FDailySchedule: TDailySchedule;
|
|
FWeeklySchedule: TWeeklySchedule;
|
|
FMonthlySchedule: TMonthlySchedule;
|
|
FYearlySchedule: TYearlySchedule;
|
|
protected
|
|
FTriggerCount: Cardinal;
|
|
FDayCount: Cardinal;
|
|
FLastEvent: TTimeStamp;
|
|
|
|
function GetNextEventStamp(const From: TTimeStamp): TTimeStamp;
|
|
|
|
property DailyFreq: TDailyFreq read FDailyFreq implements IJclScheduleDayFrequency;
|
|
property DailySchedule: TDailySchedule read FDailySchedule implements IJclDailySchedule;
|
|
property WeeklySchedule: TWeeklySchedule read FWeeklySchedule implements IJclWeeklySchedule;
|
|
property MonthlySchedule: TMonthlySchedule read FMonthlySchedule implements IJclMonthlySchedule;
|
|
property YearlySchedule: TYearlySchedule read FYearlySchedule implements IJclYearlySchedule;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
// IJclSchedule
|
|
function GetStartDate: TTimeStamp;
|
|
function GetRecurringType: TScheduleRecurringKind;
|
|
function GetEndType: TScheduleEndKind;
|
|
function GetEndDate: TTimeStamp;
|
|
function GetEndCount: Cardinal;
|
|
procedure SetStartDate(const Value: TTimeStamp);
|
|
procedure SetRecurringType(Value: TScheduleRecurringKind);
|
|
procedure SetEndType(Value: TScheduleEndKind);
|
|
procedure SetEndDate(const Value: TTimeStamp);
|
|
procedure SetEndCount(Value: Cardinal);
|
|
|
|
function TriggerCount: Cardinal;
|
|
function DayCount: Cardinal;
|
|
function LastTriggered: TTimeStamp;
|
|
|
|
procedure InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
|
|
LastDayCount: Cardinal);
|
|
procedure Reset;
|
|
function NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
function NextEventFrom(const FromEvent: TTimeStamp;
|
|
CountMissedEvent: Boolean = False): TTimeStamp;
|
|
function NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
|
|
property StartDate: TTimeStamp read GetStartDate write SetStartDate;
|
|
property RecurringType: TScheduleRecurringKind read GetRecurringType write SetRecurringType;
|
|
property EndType: TScheduleEndKind read GetEndType write SetEndType;
|
|
property EndDate: TTimeStamp read GetEndDate write SetEndDate;
|
|
property EndCount: Cardinal read GetEndCount write SetEndCount;
|
|
end;
|
|
|
|
constructor TSchedule.Create;
|
|
var
|
|
InitialStamp: TTimeStamp;
|
|
begin
|
|
inherited Create;
|
|
FDailyFreq := TDailyFreq.Create(Self);
|
|
FDailySchedule := TDailySchedule.Create(Self);
|
|
FWeeklySchedule := TWeeklySchedule.Create(Self);
|
|
FMonthlySchedule := TMonthlySchedule.Create(Self);
|
|
FYearlySchedule := TYearlySchedule.Create(Self);
|
|
InitialStamp := DateTimeToTimeStamp(Now);
|
|
InitialStamp.Time := 1000 * (InitialStamp.Time div 1000); // strip of milliseconds
|
|
StartDate := InitialStamp;
|
|
EndType := sekNone;
|
|
RecurringType := srkOneShot;
|
|
end;
|
|
|
|
destructor TSchedule.Destroy;
|
|
begin
|
|
FreeAndNil(FYearlySchedule);
|
|
FreeAndNil(FMonthlySchedule);
|
|
FreeAndNil(FWeeklySchedule);
|
|
FreeAndNil(FDailySchedule);
|
|
FreeAndNil(FDailyFreq);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TSchedule.GetNextEventStamp(const From: TTimeStamp): TTimeStamp;
|
|
var
|
|
UseFrom: TTimeStamp;
|
|
begin
|
|
Result := NullStamp;
|
|
UseFrom := From;
|
|
if (From.Date = 0) or (From.Date < StartDate.Date) then
|
|
begin
|
|
UseFrom := StartDate;
|
|
Dec(UseFrom.Time);
|
|
end;
|
|
case RecurringType of
|
|
srkOneShot:
|
|
if TriggerCount = 0 then
|
|
Result := StartDate;
|
|
srkDaily:
|
|
begin
|
|
Result := DailyFreq.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := DailyFreq.StartTime;
|
|
Result := DailySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
DailySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkWeekly:
|
|
begin
|
|
Result := DailyFreq.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := DailyFreq.StartTime;
|
|
Result := WeeklySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
WeeklySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkMonthly:
|
|
begin
|
|
Result := DailyFreq.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := DailyFreq.StartTime;
|
|
Result := MonthlySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
MonthlySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkYearly:
|
|
begin
|
|
Result := DailyFreq.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := DailyFreq.StartTime;
|
|
Result := YearlySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
YearlySchedule.MakeValidStamp(Result);
|
|
end;
|
|
end;
|
|
if CompareTimeStamps(Result, UseFrom) < 0 then
|
|
Result := NullStamp;
|
|
if not IsNullTimeStamp(Result) then
|
|
begin
|
|
if ((EndType = sekDate) and (CompareTimeStamps(Result, EndDate) > 0)) or
|
|
((EndType = sekDayCount) and (DayCount = EndCount) and (UseFrom.Date <> Result.Date)) or
|
|
((EndType = sekTriggerCount) and (TriggerCount = EndCount)) then
|
|
Result := NullStamp
|
|
else
|
|
begin
|
|
Inc(FTriggerCount);
|
|
if (UseFrom.Date <> Result.Date) or (DayCount = 0) then
|
|
Inc(FDayCount);
|
|
FLastEvent := Result;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TSchedule.GetStartDate: TTimeStamp;
|
|
begin
|
|
Result := FStartDate;
|
|
end;
|
|
|
|
function TSchedule.GetRecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := FRecurringType;
|
|
end;
|
|
|
|
function TSchedule.GetEndType: TScheduleEndKind;
|
|
begin
|
|
Result := FEndType;
|
|
end;
|
|
|
|
function TSchedule.GetEndDate: TTimeStamp;
|
|
begin
|
|
Result := FEndDate;
|
|
end;
|
|
|
|
function TSchedule.GetEndCount: Cardinal;
|
|
begin
|
|
Result := FEndCount;
|
|
end;
|
|
|
|
procedure TSchedule.SetStartDate(const Value: TTimeStamp);
|
|
begin
|
|
FStartDate := Value;
|
|
end;
|
|
|
|
procedure TSchedule.SetRecurringType(Value: TScheduleRecurringKind);
|
|
begin
|
|
FRecurringType := Value;
|
|
end;
|
|
|
|
procedure TSchedule.SetEndType(Value: TScheduleEndKind);
|
|
begin
|
|
FEndType := Value;
|
|
end;
|
|
|
|
procedure TSchedule.SetEndDate(const Value: TTimeStamp);
|
|
begin
|
|
FEndDate := Value;
|
|
end;
|
|
|
|
procedure TSchedule.SetEndCount(Value: Cardinal);
|
|
begin
|
|
FEndCount := Value;
|
|
end;
|
|
|
|
function TSchedule.TriggerCount: Cardinal;
|
|
begin
|
|
Result := FTriggerCount;
|
|
end;
|
|
|
|
function TSchedule.DayCount: Cardinal;
|
|
begin
|
|
Result := FDayCount;
|
|
end;
|
|
|
|
function TSchedule.LastTriggered: TTimeStamp;
|
|
begin
|
|
Result := FLastEvent;
|
|
end;
|
|
|
|
procedure TSchedule.InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
|
|
LastDayCount: Cardinal);
|
|
begin
|
|
FLastEvent := LastTriggerStamp;
|
|
FTriggerCount := LastTriggerCount;
|
|
FDayCount := LastDayCount;
|
|
end;
|
|
|
|
procedure TSchedule.Reset;
|
|
begin
|
|
FLastEvent := NullStamp;
|
|
FTriggerCount := 0;
|
|
FDayCount := 0;
|
|
end;
|
|
|
|
function TSchedule.NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
begin
|
|
Result := NextEventFrom(FLastEvent, CountMissedEvents);
|
|
end;
|
|
|
|
function TSchedule.NextEventFrom(const FromEvent: TTimeStamp;
|
|
CountMissedEvent: Boolean = False): TTimeStamp;
|
|
begin
|
|
if CountMissedEvent then
|
|
begin
|
|
Result := FLastEvent;
|
|
repeat
|
|
Result := GetNextEventStamp(Result);
|
|
until IsNullTimeStamp(Result) or (CompareTimeStamps(FromEvent, Result) <= 0);
|
|
end
|
|
else
|
|
Result := GetNextEventStamp(FromEvent);
|
|
end;
|
|
|
|
function TSchedule.NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
begin
|
|
Result := NextEventFrom(DateTimeToTimeStamp(Now), CountMissedEvents);
|
|
end;
|
|
|
|
function CreateSchedule: IJclSchedule;
|
|
begin
|
|
Result := TSchedule.Create;
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JclSchedule.pas,v $
|
|
// Revision 1.13 2005/03/08 08:33:17 marquardt
|
|
// overhaul of exceptions and resourcestrings, minor style cleaning
|
|
//
|
|
// Revision 1.12 2005/02/24 16:34:40 marquardt
|
|
// remove divider lines, add section lines (unfinished)
|
|
//
|
|
// Revision 1.11 2004/10/17 22:30:27 mthoma
|
|
// file header update
|
|
//
|
|
// Revision 1.10 2004/10/12 18:29:52 rrossmair
|
|
// cleanup
|
|
//
|
|
// Revision 1.9 2004/08/01 05:52:12 marquardt
|
|
// move constructors/destructors
|
|
//
|
|
// Revision 1.8 2004/07/28 18:00:51 marquardt
|
|
// various style cleanings, some minor fixes
|
|
//
|
|
// Revision 1.7 2004/06/16 07:30:28 marquardt
|
|
// added tilde to all IFNDEF ENDIFs, inherited qualified
|
|
//
|
|
// Revision 1.6 2004/06/14 06:24:52 marquardt
|
|
// style cleaning IFDEF
|
|
//
|
|
// Revision 1.5 2004/05/05 00:09:59 mthoma
|
|
// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary,
|
|
//
|
|
|
|
end.
|