david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
1307 lines
43 KiB
ObjectPascal
1307 lines
43 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. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-09-12 15:18:12 +0200 (sam., 12 sept. 2009) $ }
|
|
{ Revision: $Rev:: 2998 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclSchedule;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
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;
|
|
|
|
EJclScheduleError = class(EJclError);
|
|
ESchedule = EJclScheduleError;
|
|
|
|
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;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/common/JclSchedule.pas $';
|
|
Revision: '$Revision: 2998 $';
|
|
Date: '$Date: 2009-09-12 15:18:12 +0200 (sam., 12 sept. 2009) $';
|
|
LogPath: 'JCL\source\common';
|
|
Extra: '';
|
|
Data: nil
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclDateTime, JclResources;
|
|
|
|
//=== { TJclScheduleAggregate } ==============================================
|
|
|
|
type
|
|
TJclScheduleAggregate = 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 TJclScheduleAggregate.CheckInterfaceAllowed;
|
|
begin
|
|
if not InterfaceAllowed then
|
|
RunError(23); // reIntfCastError
|
|
end;
|
|
|
|
function TJclScheduleAggregate.InterfaceAllowed: Boolean;
|
|
begin
|
|
Result := Schedule.RecurringType = RecurringType;
|
|
end;
|
|
|
|
function TJclScheduleAggregate.Schedule: IJclSchedule;
|
|
begin
|
|
Result := Controller as IJclSchedule;
|
|
end;
|
|
|
|
class function TJclScheduleAggregate.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkOneShot;
|
|
end;
|
|
|
|
//=== { TJclDayFrequency } ===================================================
|
|
|
|
type
|
|
TJclDayFrequency = class(TAggregatedObject, IJclScheduleDayFrequency, IInterface)
|
|
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 TJclDayFrequency.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FStartTime := 0;
|
|
FEndTime := HoursToMSecs(24) - 1;
|
|
FInterval := 500;
|
|
end;
|
|
|
|
function TJclDayFrequency.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 TJclDayFrequency.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 TJclDayFrequency.GetStartTime: Cardinal;
|
|
begin
|
|
Result := FStartTime;
|
|
end;
|
|
|
|
function TJclDayFrequency.GetEndTime: Cardinal;
|
|
begin
|
|
Result := FEndTime;
|
|
end;
|
|
|
|
function TJclDayFrequency.GetInterval: Cardinal;
|
|
begin
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TJclDayFrequency.SetStartTime(Value: Cardinal);
|
|
begin
|
|
if Value <> FStartTime then
|
|
begin
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime);
|
|
FStartTime := Value;
|
|
if EndTime < StartTime then
|
|
FEndTime := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclDayFrequency.SetEndTime(Value: Cardinal);
|
|
begin
|
|
if Value <> FEndTime then
|
|
begin
|
|
if Value < FStartTime then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleEndBeforeStart);
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime);
|
|
FEndTime := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclDayFrequency.SetInterval(Value: Cardinal);
|
|
begin
|
|
if Value <> FInterval then
|
|
begin
|
|
if Value >= Cardinal(HoursToMSecs(24)) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime);
|
|
if Value = 0 then
|
|
begin
|
|
FEndTime := FStartTime;
|
|
FInterval := 1;
|
|
end
|
|
else
|
|
FInterval := Value;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJclDailySchedule } ==================================================
|
|
|
|
type
|
|
TJclDailySchedule = class(TJclScheduleAggregate, IJclDailySchedule, IInterface)
|
|
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 TJclDailySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FEveryWeekDay := True;
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TJclDailySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkDaily;
|
|
end;
|
|
|
|
function TJclDailySchedule.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 TJclDailySchedule.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 TJclDailySchedule.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 TJclDailySchedule.GetEveryWeekDay: Boolean;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FEveryWeekDay;
|
|
end;
|
|
|
|
function TJclDailySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if EveryWeekDay then
|
|
Result := 0
|
|
else
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TJclDailySchedule.SetEveryWeekDay(Value: Boolean);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
FEveryWeekDay := Value;
|
|
end;
|
|
|
|
procedure TJclDailySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero);
|
|
if FEveryWeekDay then
|
|
FEveryWeekDay := False;
|
|
if Value <> FInterval then
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TJclWeeklySchedule } =================================================
|
|
|
|
type
|
|
TJclWeeklySchedule = class(TJclScheduleAggregate, IJclWeeklySchedule, IInterface)
|
|
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 TJclWeeklySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FDaysOfWeek := [swdMonday];
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TJclWeeklySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkWeekly;
|
|
end;
|
|
|
|
function TJclWeeklySchedule.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 TJclWeeklySchedule.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 TJclWeeklySchedule.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 TJclWeeklySchedule.GetDaysOfWeek: TScheduleWeekDays;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FDaysOfWeek;
|
|
end;
|
|
|
|
function TJclWeeklySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TJclWeeklySchedule.SetDaysOfWeek(Value: TScheduleWeekDays);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = [] then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleNoDaySpecified);
|
|
FDaysOfWeek := Value;
|
|
end;
|
|
|
|
procedure TJclWeeklySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero);
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TJclMonthlySchedule } ================================================
|
|
|
|
type
|
|
TJclMonthlySchedule = class(TJclScheduleAggregate, IJclMonthlySchedule, IInterface)
|
|
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 TJclMonthlySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FIndexKind := sikNone;
|
|
FIndexValue := sivFirst;
|
|
FDay := 1;
|
|
FInterval := 1;
|
|
end;
|
|
|
|
class function TJclMonthlySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkMonthly;
|
|
end;
|
|
|
|
function TJclMonthlySchedule.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 TJclMonthlySchedule.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 TJclMonthlySchedule.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 TJclMonthlySchedule.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 TJclMonthlySchedule.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 TJclMonthlySchedule.GetIndexKind: TScheduleIndexKind;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FIndexKind;
|
|
end;
|
|
|
|
function TJclMonthlySchedule.GetIndexValue: Integer;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikDay .. sikSunday]) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIndexValueSup);
|
|
Result := FIndexValue;
|
|
end;
|
|
|
|
function TJclMonthlySchedule.GetDay: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FDay;
|
|
end;
|
|
|
|
function TJclMonthlySchedule.GetInterval: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FInterval;
|
|
end;
|
|
|
|
procedure TJclMonthlySchedule.SetIndexKind(Value: TScheduleIndexKind);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
FIndexKind := Value;
|
|
end;
|
|
|
|
procedure TJclMonthlySchedule.SetIndexValue(Value: Integer);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikDay .. sikSunday]) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIndexValueSup);
|
|
if Value = 0 then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIndexValueZero);
|
|
FIndexValue := Value;
|
|
end;
|
|
|
|
procedure TJclMonthlySchedule.SetDay(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if not (FIndexKind in [sikNone]) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleDayNotSupported);
|
|
if (Value = 0) or (Value > 31) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleDayInRange);
|
|
FDay := Value;
|
|
end;
|
|
|
|
procedure TJclMonthlySchedule.SetInterval(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if Value = 0 then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero);
|
|
FInterval := Value;
|
|
end;
|
|
|
|
//=== { TJclYearlySchedule } =================================================
|
|
|
|
type
|
|
TJclYearlySchedule = class(TJclMonthlySchedule, IJclYearlySchedule, IInterface)
|
|
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 TJclYearlySchedule.Create(const Controller: IUnknown);
|
|
begin
|
|
inherited Create(Controller);
|
|
FMonth := 1;
|
|
end;
|
|
|
|
class function TJclYearlySchedule.RecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := srkYearly;
|
|
end;
|
|
|
|
function TJclYearlySchedule.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 TJclYearlySchedule.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 TJclYearlySchedule.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 TJclYearlySchedule.GetMonth: Cardinal;
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
Result := FMonth;
|
|
end;
|
|
|
|
procedure TJclYearlySchedule.SetMonth(Value: Cardinal);
|
|
begin
|
|
CheckInterfaceAllowed;
|
|
if (Value < 1) or (Value > 12) then
|
|
raise EJclScheduleError.CreateRes(@RsScheduleMonthInRange);
|
|
FMonth := Value;
|
|
end;
|
|
|
|
//=== { TJclSchedule } =======================================================
|
|
|
|
type
|
|
TJclSchedule = class(TInterfacedObject, IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule,
|
|
IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule)
|
|
private
|
|
FStartDate: TTimeStamp;
|
|
FRecurringType: TScheduleRecurringKind;
|
|
FEndType: TScheduleEndKind;
|
|
FEndDate: TTimeStamp;
|
|
FEndCount: Cardinal;
|
|
FDayFrequency: TJclDayFrequency;
|
|
FDailySchedule: TJclDailySchedule;
|
|
FWeeklySchedule: TJclWeeklySchedule;
|
|
FMonthlySchedule: TJclMonthlySchedule;
|
|
FYearlySchedule: TJclYearlySchedule;
|
|
protected
|
|
FTriggerCount: Cardinal;
|
|
FDayCount: Cardinal;
|
|
FLastEvent: TTimeStamp;
|
|
function GetNextEventStamp(const From: TTimeStamp): TTimeStamp;
|
|
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;
|
|
|
|
{ IJclScheduleDayFrequency }
|
|
function GetDayFrequency: IJclScheduleDayFrequency;
|
|
property DayFrequency: IJclScheduleDayFrequency read GetDayFrequency implements IJclScheduleDayFrequency;
|
|
{ IJclDailySchedule }
|
|
function GetDailySchedule: IJclDailySchedule;
|
|
property DailySchedule: IJclDailySchedule read GetDailySchedule implements IJclDailySchedule;
|
|
{ IJclWeeklySchedule }
|
|
function GetWeeklySchedule: IJclWeeklySchedule;
|
|
property WeeklySchedule: IJclWeeklySchedule read GetWeeklySchedule implements IJclWeeklySchedule;
|
|
{ IJclMonthlySchedule }
|
|
function GetMonthlySchedule: IJclMonthlySchedule;
|
|
property MonthlySchedule: IJclMonthlySchedule read GetMonthlySchedule implements IJclMonthlySchedule;
|
|
{ IJclYearlySchedule }
|
|
function GetYearlySchedule: IJclYearlySchedule;
|
|
property YearlySchedule: IJclYearlySchedule read GetYearlySchedule implements IJclYearlySchedule;
|
|
end;
|
|
|
|
constructor TJclSchedule.Create;
|
|
var
|
|
InitialStamp: TTimeStamp;
|
|
begin
|
|
inherited Create;
|
|
FDayFrequency := TJclDayFrequency.Create(Self);
|
|
FDailySchedule := TJclDailySchedule.Create(Self);
|
|
FWeeklySchedule := TJclWeeklySchedule.Create(Self);
|
|
FMonthlySchedule := TJclMonthlySchedule.Create(Self);
|
|
FYearlySchedule := TJclYearlySchedule.Create(Self);
|
|
InitialStamp := DateTimeToTimeStamp(Now);
|
|
InitialStamp.Time := 1000 * (InitialStamp.Time div 1000); // strip of milliseconds
|
|
StartDate := InitialStamp;
|
|
EndType := sekNone;
|
|
RecurringType := srkOneShot;
|
|
end;
|
|
|
|
destructor TJclSchedule.Destroy;
|
|
begin
|
|
FreeAndNil(FYearlySchedule);
|
|
FreeAndNil(FMonthlySchedule);
|
|
FreeAndNil(FWeeklySchedule);
|
|
FreeAndNil(FDailySchedule);
|
|
FreeAndNil(FDayFrequency);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclSchedule.GetDayFrequency: IJclScheduleDayFrequency;
|
|
begin
|
|
Result := FDayFrequency;
|
|
end;
|
|
|
|
function TJclSchedule.GetDailySchedule: IJclDailySchedule;
|
|
begin
|
|
Result := FDailySchedule;
|
|
end;
|
|
|
|
function TJclSchedule.GetWeeklySchedule: IJclWeeklySchedule;
|
|
begin
|
|
Result := FWeeklySchedule;
|
|
end;
|
|
|
|
function TJclSchedule.GetMonthlySchedule: IJclMonthlySchedule;
|
|
begin
|
|
Result := FMonthlySchedule;
|
|
end;
|
|
|
|
function TJclSchedule.GetYearlySchedule: IJclYearlySchedule;
|
|
begin
|
|
Result := FYearlySchedule;
|
|
end;
|
|
|
|
function TJclSchedule.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 := FDayFrequency.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := FDayFrequency.StartTime;
|
|
Result := FDailySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
FDailySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkWeekly:
|
|
begin
|
|
Result := FDayFrequency.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := FDayFrequency.StartTime;
|
|
Result := FWeeklySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
FWeeklySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkMonthly:
|
|
begin
|
|
Result := FDayFrequency.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := FDayFrequency.StartTime;
|
|
Result := FMonthlySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
FMonthlySchedule.MakeValidStamp(Result);
|
|
end;
|
|
srkYearly:
|
|
begin
|
|
Result := FDayFrequency.NextValidStamp(UseFrom);
|
|
if IsNullTimeStamp(Result) then
|
|
begin
|
|
Result.Date := UseFrom.Date;
|
|
Result.Time := FDayFrequency.StartTime;
|
|
Result := FYearlySchedule.NextValidStamp(Result);
|
|
end
|
|
else
|
|
FYearlySchedule.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 TJclSchedule.GetStartDate: TTimeStamp;
|
|
begin
|
|
Result := FStartDate;
|
|
end;
|
|
|
|
function TJclSchedule.GetRecurringType: TScheduleRecurringKind;
|
|
begin
|
|
Result := FRecurringType;
|
|
end;
|
|
|
|
function TJclSchedule.GetEndType: TScheduleEndKind;
|
|
begin
|
|
Result := FEndType;
|
|
end;
|
|
|
|
function TJclSchedule.GetEndDate: TTimeStamp;
|
|
begin
|
|
Result := FEndDate;
|
|
end;
|
|
|
|
function TJclSchedule.GetEndCount: Cardinal;
|
|
begin
|
|
Result := FEndCount;
|
|
end;
|
|
|
|
procedure TJclSchedule.SetStartDate(const Value: TTimeStamp);
|
|
begin
|
|
FStartDate := Value;
|
|
end;
|
|
|
|
procedure TJclSchedule.SetRecurringType(Value: TScheduleRecurringKind);
|
|
begin
|
|
FRecurringType := Value;
|
|
end;
|
|
|
|
procedure TJclSchedule.SetEndType(Value: TScheduleEndKind);
|
|
begin
|
|
FEndType := Value;
|
|
end;
|
|
|
|
procedure TJclSchedule.SetEndDate(const Value: TTimeStamp);
|
|
begin
|
|
FEndDate := Value;
|
|
end;
|
|
|
|
procedure TJclSchedule.SetEndCount(Value: Cardinal);
|
|
begin
|
|
FEndCount := Value;
|
|
end;
|
|
|
|
function TJclSchedule.TriggerCount: Cardinal;
|
|
begin
|
|
Result := FTriggerCount;
|
|
end;
|
|
|
|
function TJclSchedule.DayCount: Cardinal;
|
|
begin
|
|
Result := FDayCount;
|
|
end;
|
|
|
|
function TJclSchedule.LastTriggered: TTimeStamp;
|
|
begin
|
|
Result := FLastEvent;
|
|
end;
|
|
|
|
procedure TJclSchedule.InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
|
|
LastDayCount: Cardinal);
|
|
begin
|
|
FLastEvent := LastTriggerStamp;
|
|
FTriggerCount := LastTriggerCount;
|
|
FDayCount := LastDayCount;
|
|
end;
|
|
|
|
procedure TJclSchedule.Reset;
|
|
begin
|
|
FLastEvent := NullStamp;
|
|
FTriggerCount := 0;
|
|
FDayCount := 0;
|
|
end;
|
|
|
|
function TJclSchedule.NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
begin
|
|
Result := NextEventFrom(FLastEvent, CountMissedEvents);
|
|
end;
|
|
|
|
function TJclSchedule.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 TJclSchedule.NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;
|
|
begin
|
|
Result := NextEventFrom(DateTimeToTimeStamp(Now), CountMissedEvents);
|
|
end;
|
|
|
|
function CreateSchedule: IJclSchedule;
|
|
begin
|
|
Result := TJclSchedule.Create;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|