(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTScheduler;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,AHMSystemClass,AHMSystemConst;
type
  TAHMTriggerDaysGroup = (Mon,Tue,Wed,Thu,Fri,Sat,Sun);
  TAHMTriggerDays = Set of TAHMTriggerDaysGroup;
  TAHMOnTrigger = procedure(Sender : TObject;const ScheduleID : String;var Active : Boolean) of Object;
  TAHMScheduledTimer = class;
  TAHMScheduledTimerThread = class(TThread)
    OwnerTimer: TAHMScheduledTimer;
    Procedure Execute; override;
    Procedure DoTimer;
  end;
  TAHMScheduledTimer = class(TObject)
  private
    FEnabled: Boolean;
    FInterval: Word;
    FOnTimer: TNotifyEvent;
    FTimerThread: TAHMScheduledTimerThread;
    FThreadPriority: TThreadPriority;
    Procedure SetEnabled(Const Value: Boolean);
    Procedure SetInterval(Const Value: Word);
    Procedure SetThreadPriority(Const Value: TThreadPriority);
  Protected
    Procedure UpdateTimer;
    Procedure Timer; dynamic;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  published
    Property Enabled: Boolean read FEnabled write SetEnabled;
    Property Interval: Word read FInterval write SetInterval default 200;
    Property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    Property Priority: TThreadPriority read FThreadPriority write SetThreadPriority;
  end;
  TAHMScheduler = class;
  TAHMSchedules = class;
  TAHMScheduledTime = class(TCollectionItem)
  private
     FAHMScheduler : TAHMScheduler;
     FHasTriggered : Boolean;
     FCurrentTimer :TAHMScheduledTimer;
     FActive: Boolean;
     FTriggerDate: String;
     FTriggerTime: String;
     FOnTrigger: TAHMOnTrigger;
     FScheduleID: String;
     FAHMTriggerDays: TAHMTriggerDays;
     procedure SetActive(const Value: Boolean);
     procedure SetTriggerDate(const Value: String);
     procedure SetTriggerTime(const Value: String);
     procedure TimerActive(Sender: TObject);
    procedure SetAHMTriggerdays(const Value: TAHMTriggerDays);
  protected
     function GetDisplayName: string; override;
  public
     constructor Create(Collection: TCollection); override;
     procedure Assign(Source: TPersistent); override;
     destructor Destroy; override;
     property Owner : TAHMScheduler read FAHMScheduler;
     property DisplayName : String read GetDisplayName;
  published
     Property TriggerDate : String read FTriggerDate write SetTriggerDate;
     Property TriggerTime : String read FTriggerTime write SetTriggerTime;
     Property AllowDays : TAHMTriggerDays read FAHMTriggerDays write SetAHMTriggerdays default [Mon,Tue,Wed,Thu,Fri,Sat,Sun];
     Property ScheduleID : String read FScheduleID write FScheduleID;
     Property Active : Boolean read FActive write SetActive default False;
     Property OnTrigger : TAHMOnTrigger read FOnTrigger write FOnTrigger;
  end;
  TAHMSchedules = class(TCollection)
  private
    FAHMScheduler : TAHMScheduler;
    function GetAHMScheduledTime(Index: Integer): TAHMScheduledTime;
    procedure SetAHMScheduledTime(Index: Integer; Value: TAHMScheduledTime);
  protected
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner: TAHMScheduler);
    function Add : TAHMScheduledTime;
    function Delete(Index :Integer) :Boolean;
    property Owner : TAHMScheduler read FAHMScheduler;
    property Items[Index: Integer]: TAHMScheduledTime
             read GetAHMScheduledTime write SetAHMScheduledTime; default;
  end;
  TAHMScheduler = class(TAHMSystemsComponent)
  private
    FAHMSchedules : TAHMSchedules;
    FEnabled: Boolean;
    FBeforeAnyTrigger: TAHMOnTrigger;
    FAfterAnyTrigger: TAHMOnTrigger;
    procedure SetAHMSchedules(Value: TAHMSchedules);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About;
    property Schedules: TAHMSchedules read FAHMSchedules write SetAHMSchedules;
    property Enabled : Boolean read FEnabled write FEnabled default True;
    property BeforeAnyTrigger : TAHMOnTrigger read FBeforeAnyTrigger write FBeforeAnyTrigger;
    property AfterAnyTrigger : TAHMOnTrigger read FAfterAnyTrigger write FAfterAnyTrigger;
  end;

Function AHMAddToTime(CTime : TTime;Hours,Minutes,Seconds : Longint) : TTime;
Function AHMAddToDateTime(CDateTime : TDateTime;Day,Hours,Minutes,Seconds : Longint) : TDateTime;

implementation

Function AHMAddToTime(CTime : TTime;Hours,Minutes,Seconds : Longint) : TTime;
Var Add : LongInt;
    ConvT : Variant;
begin
  Add:=Hours*3600+Minutes*60+Seconds;
  ConvT:=Double(CTime)+(Double(StrToTime('00:00:01'))*Add);
  Result:=TTime(ConvT);
end;

Function AHMAddToDateTime(CDateTime : TDateTime;Day,Hours,Minutes,Seconds : Longint) : TDateTime;
Var Add : LongInt;
    ConvT : Variant;
begin
  Add:=Day*24*3600+Hours*3600+Minutes*60+Seconds;
  ConvT:=Double(CDateTime)+(Double(StrToTime('00:00:01'))*Add);
  Result:=TTime(ConvT);
end;

Procedure TAHMScheduledTimerThread.Execute;
begin
  Priority := OwnerTimer.FThreadPriority;
  repeat
    SleepEx(OwnerTimer.FInterval, False);
    Synchronize(DoTimer);
  until Terminated;
end;

Procedure TAHMScheduledTimerThread.DoTimer;
begin
  OwnerTimer.Timer;
end;

constructor TAHMScheduledTimer.Create;
begin
  inherited Create;
  FEnabled := True;
  FInterval := 50;
  FThreadPriority := tpTimeCritical;
  FTimerThread := TAHMScheduledTimerThread.Create(false);
  FTimerThread.OwnerTimer := Self;
  UpdateTimer;
end;

destructor TAHMScheduledTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  FTimerThread.Free;
  inherited Destroy;
end;

Procedure TAHMScheduledTimer.UpdateTimer;
begin
  if not(FTimerThread.Suspended) then FTimerThread.Suspend;
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
  if (FTimerThread.Suspended) then  FTimerThread.Resume;
end;

Procedure TAHMScheduledTimer.SetEnabled(Const Value: Boolean);
begin
  if Value <> FEnabled then FEnabled := Value;
  UpdateTimer;
end;

Procedure TAHMScheduledTimer.SetInterval(Const Value: Word);
begin
  if Value <> FInterval then FInterval := Value;
  UpdateTimer;
end;

Procedure TAHMScheduledTimer.SetThreadPriority(Const Value: TThreadPriority);
begin
  if Value <> FThreadPriority then FThreadPriority := Value;
  UpdateTimer;
end;

Procedure TAHMScheduledTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;


constructor TAHMScheduledTime.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FAHMScheduler :=(((Collection as TAHMSchedules).GetOwner)
                                          as TAHMScheduler);
  FCurrentTimer:=TAHMScheduledTimer.Create;
  FCurrentTimer.interval:=20;
  FCurrentTimer.enabled:=False;
  FCurrentTimer.ontimer:=TimerActive;
  FHasTriggered:=False;
  FActive:=False;
  FAHMTriggerDays:=[Mon,Tue,Wed,Thu,Fri,Sat,Sun];
end;

destructor TAHMScheduledTime.Destroy;
begin
  FCurrentTimer.Free;
  inherited Destroy;
end;

procedure TAHMScheduledTime.Assign(Source: TPersistent);
begin
  if Source is TAHMScheduledTime then
  begin
    TriggerDate:=TAHMScheduledTime(Source).TriggerDate;
    TriggerTime:=TAHMScheduledTime(Source).TriggerTime;
    ScheduleID:=TAHMScheduledTime(Source).ScheduleID;
    Active:=TAHMScheduledTime(Source).Active;
    OnTrigger:=TAHMScheduledTime(Source).OnTrigger;
    exit;
  end;
  inherited;
end;


function TAHMScheduledTime.GetDisplayName: string;
begin
  if (FTriggerTime<>'') and (FTriggerDate<>'') then
    result:=ahmscschedonthe+FTriggerDate+ahmscschedat+FTriggerTime
  else
    if (FTriggerTime<>'') and (FTriggerDate='') then
      result:=ahmscschedeveryday+FTriggerTime
  else
    if (FTriggerTime='') and (FTriggerDate<>'') then
      result:=ahmscschedonthe+FTriggerDate
  else
    Result:=ahmscschednotime;
end;

function TAHMSchedules.GetOwner: TPersistent;
begin
  Result := FAHMScheduler;
end;

constructor TAHMSchedules.Create(AOwner: TAHMScheduler);
begin
  inherited Create(TAHMScheduledTime);
  FAHMScheduler := AOwner;
end;

function TAHMSchedules.Add: TAHMScheduledTime;
begin
  Result := TAHMScheduledTime(inherited Add);
end;

function TAHMSchedules.GetAHMScheduledTime(Index: Integer): TAHMScheduledTime;
begin
  Result := TAHMScheduledTime(inherited GetItem(Index));
end;

procedure TAHMSchedules.SetAHMScheduledTime(Index: Integer; Value: TAHMScheduledTime);
begin
  inherited SetItem(Index, Value);
end;

constructor TAHMScheduler.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FAHMSchedules:=TAHMSchedules.Create(self);
  FEnabled:=True;
end;

destructor TAHMScheduler.Destroy;
begin
  FAHMSchedules.Free;
  inherited Destroy;
end;

procedure TAHMScheduler.SetAHMSchedules(Value: TAHMSchedules);
begin
  FAHMSchedules.Assign(Value);
end;


function TAHMSchedules.Delete(Index: Integer): Boolean;
begin
  result := true;
  Try
    Items[Index].free;
  Except
    result := false;
    Application.handleexception(self);
  End;
end;

procedure TAHMScheduledTime.SetActive(const Value: Boolean);
begin
  FActive := Value;
  FCurrentTimer.Enabled:=Value;
end;

procedure TAHMScheduledTime.SetTriggerDate(const Value: String);
begin
  if (Value='') then FTriggerDate:='' else
  try
    FTriggerDate:=Datetostr(StrtoDate(Value));
  except
    FTriggerdate:='';
  end;
end;

procedure TAHMScheduledTime.SetTriggerTime(const Value: String);
begin
  if (Value='') then FTriggerTime:='' else
  try
    FTriggerTime:=Timetostr(StrtoTime(Value));
  except
    FTriggerTime:='';
  end;
end;

procedure TAHMScheduledTime.TimerActive(Sender : TObject);
var at,ad,ab : boolean;
begin
  if not(Mon in FAHMTriggerDays) and (Pos(ahmsshortDayNameMon,FormatDateTime('ddd',Now))>0) then exit;
  if not(Tue in FAHMTriggerDays) and (Pos(ahmsshortDayNameTue,FormatDateTime('ddd',Now))>0) then exit;
  if not(Wed in FAHMTriggerDays) and (Pos(ahmsshortDayNameWed,FormatDateTime('ddd',Now))>0) then exit;
  if not(Thu in FAHMTriggerDays) and (Pos(ahmsshortDayNameThu,FormatDateTime('ddd',Now))>0) then exit;
  if not(Fri in FAHMTriggerDays) and (Pos(ahmsshortDayNameFri,FormatDateTime('ddd',Now))>0) then exit;
  if not(Sat in FAHMTriggerDays) and (Pos(ahmsshortDayNameSat,FormatDateTime('ddd',Now))>0) then exit;
  if not(Sun in FAHMTriggerDays) and (Pos(ahmsshortDayNameSun,FormatDateTime('ddd',Now))>0) then exit;
  ab:=false; at:=false; ad:=false;
  if (FTriggerDate<>'') and (FTriggerTime<>'') then
  if (FTriggerDate=Datetostr(Date)) and (FTriggerTime=Timetostr(Time)) then ab:=true;
  if (FTriggerDate='') and (FTriggerTime<>'') then
  if (FTriggerTime=Timetostr(Time)) then at:=true;
  if (FTriggerDate<>'') and (FTriggerTime='') then
  if (FTriggerDate=Datetostr(Date)) then ad:=true;
  if not(at or ab or ad) then FHasTriggered:=False;
  if (at or ab or ad) and FActive and FAHMScheduler.FEnabled and not(FHasTriggered) then
  begin
    FHasTriggered:=True;
    if assigned(FAHMScheduler.FBeforeAnyTrigger) then FAHMScheduler.FBeforeAnyTrigger(self,Self.ScheduleID,FActive);
    if assigned(FOnTrigger) then FOnTrigger(self,Self.ScheduleID,FActive);
    if assigned(FAHMScheduler.FAfterAnyTrigger) then FAHMScheduler.FAfterAnyTrigger(self,Self.ScheduleID,FActive);
  end;
end;

procedure TAHMScheduledTime.SetAHMTriggerdays(
  const Value: TAHMTriggerDays);
begin
  FAHMTriggerDays := Value;
end;

end.
