jvscheduledevents.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------

 Project JEDI Visible Component Library (J-VCL)

 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 Initial Developer of the Original Code is Marcel Bestebroer
  <marcelb att zeelandnet dott nl>.
 Portions created by Marcel Bestebroer are Copyright (C) 2000 - 2002 mbeSoft.
 All Rights Reserved.

 ******************************************************************************

 Event scheduling component. Allows to schedule execution of events, with
 optional recurring schedule options.

 You may retrieve the latest version of this file at the Project JEDI home
 page, located at http://www.delphi-jedi.org
-----------------------------------------------------------------------------}
// $Id: JvScheduledEvents.pas,v 1.27 2005/02/17 10:20:52 marquardt Exp $

unit JvScheduledEvents;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes, Contnrs, SyncObjs,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  {$IFDEF VCL}
  Messages, Forms,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Qt, QForms, Types, QWindows,
  {$ENDIF VisualCLX}
  JclSchedule,
  JvAppStorage;

const
  CM_EXECEVENT = WM_USER + $1000;

type
  TJvCustomScheduledEvents = class;
  TJvEventCollection = class;
  TJvEventCollectionItem = class;

  TScheduledEventState =
    (sesNotInitialized, sesWaiting, sesTriggered, sesExecuting, sesPaused, sesEnded);
  TScheduledEventExecute = procedure(Sender: TJvEventCollectionItem; const IsSnoozeEvent: Boolean) of object;

  TJvCustomScheduledEvents = class(TComponent)
  private
    FAppStorage: TJvCustomAppStorage;
    FAppStoragePath: string;
    FAutoSave: Boolean;
    FEvents: TJvEventCollection;
    FOnStartEvent: TNotifyEvent;
    FOnEndEvent: TNotifyEvent;
    FWnd: HWND;
  protected
    procedure DoEndEvent(const Event: TJvEventCollectionItem);
    procedure DoStartEvent(const Event: TJvEventCollectionItem);
    function GetAppStorage: TJvCustomAppStorage;
    procedure SetAppStorage(Value: TJvCustomAppStorage);
    function GetEvents: TJvEventCollection;
    procedure InitEvents;
    procedure Loaded; override;
    procedure LoadSingleEvent(Sender: TJvCustomAppStorage;
      const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
    procedure SaveSingleEvent(Sender: TJvCustomAppStorage;
      const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
    procedure DeleteSingleEvent(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const First, Last: Integer; const ItemName: string);
    procedure SetEvents(Value: TJvEventCollection);
    {$IFDEF VCL}
    procedure WndProc(var Msg: TMessage); virtual;
    {$ENDIF VCL}
    procedure CMExecEvent(var Msg: TMessage); message CM_EXECEVENT;
    property AutoSave: Boolean read FAutoSave write FAutoSave;
    property OnStartEvent: TNotifyEvent read FOnStartEvent write FOnStartEvent;
    property OnEndEvent: TNotifyEvent read FOnEndEvent write FOnEndEvent;
    property AppStorage: TJvCustomAppStorage read GetAppStorage write SetAppStorage;
    property AppStoragePath: string read FAppStoragePath write FAppStoragePath;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Handle: HWND read FWnd;
    property Events: TJvEventCollection read GetEvents write SetEvents;
    procedure LoadEventStates(const ClearBefore: Boolean = True);
    procedure SaveEventStates;
    procedure StartAll;
    procedure StopAll;
    procedure PauseAll;
  end;

  TJvScheduledEvents = class(TJvCustomScheduledEvents)
  published
    property AppStorage;
    property AppStoragePath;
    property AutoSave;
    property Events;
    property OnStartEvent;
    property OnEndEvent;
  end;

  TJvEventCollection = class(TOwnedCollection)
  protected
    function GetItem(Index: Integer): TJvEventCollectionItem;
    procedure SetItem(Index: Integer; Value: TJvEventCollectionItem);
  public
    constructor Create(AOwner: TPersistent);
    function Add: TJvEventCollectionItem;
    function Insert(Index: Integer): TJvEventCollectionItem;
    property Items[Index: Integer]: TJvEventCollectionItem read GetItem write SetItem; default;
  end;

  TJvEventCollectionItem = class(TCollectionItem)
  private
    FCountMissedEvents: Boolean;
    FName: string;
    FState: TScheduledEventState;
    FData: Pointer;
    FOnExecute: TScheduledEventExecute;
    FSchedule: IJclSchedule;
    FLastSnoozeInterval: TSystemTime;
    FScheduleFire: TTimeStamp;
    FSnoozeFire: TTimeStamp;
    FReqTriggerTime: TTimeStamp;
    FActualTriggerTime: TTimeStamp;
    procedure Triggered;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoExecute(const IsSnoozeFire: Boolean);
    function GetDisplayName: string; override;
    function GetNextFire: TTimeStamp;
    procedure Execute; virtual;
    // schedule property readers/writers
    procedure PropDateRead(Reader: TReader; var Stamp: TTimeStamp);
    procedure PropDateWrite(Writer: TWriter; const Stamp: TTimeStamp);
    procedure PropDailyEveryWeekDayRead(Reader: TReader);
    procedure PropDailyEveryWeekDayWrite(Writer: TWriter);
    procedure PropDailyIntervalRead(Reader: TReader);
    procedure PropDailyIntervalWrite(Writer: TWriter);
    procedure PropEndCountRead(Reader: TReader);
    procedure PropEndCountWrite(Writer: TWriter);
    procedure PropEndDateRead(Reader: TReader);
    procedure PropEndDateWrite(Writer: TWriter);
    procedure PropEndTypeRead(Reader: TReader);
    procedure PropEndTypeWrite(Writer: TWriter);
    procedure PropFreqEndTimeRead(Reader: TReader);
    procedure PropFreqEndTimeWrite(Writer: TWriter);
    procedure PropFreqIntervalRead(Reader: TReader);
    procedure PropFreqIntervalWrite(Writer: TWriter);
    procedure PropFreqStartTimeRead(Reader: TReader);
    procedure PropFreqStartTimeWrite(Writer: TWriter);
    procedure PropMonthlyDayRead(Reader: TReader);
    procedure PropMonthlyDayWrite(Writer: TWriter);
    procedure PropMonthlyIndexKindRead(Reader: TReader);
    procedure PropMonthlyIndexKindWrite(Writer: TWriter);
    procedure PropMonthlyIndexValueRead(Reader: TReader);
    procedure PropMonthlyIndexValueWrite(Writer: TWriter);
    procedure PropMonthlyIntervalRead(Reader: TReader);
    procedure PropMonthlyIntervalWrite(Writer: TWriter);
    procedure PropRecurringTypeRead(Reader: TReader);
    procedure PropRecurringTypeWrite(Writer: TWriter);
    procedure PropStartDateRead(Reader: TReader);
    procedure PropStartDateWrite(Writer: TWriter);
    procedure PropWeeklyDaysOfWeekRead(Reader: TReader);
    procedure PropWeeklyDaysOfWeekWrite(Writer: TWriter);
    procedure PropWeeklyIntervalRead(Reader: TReader);
    procedure PropWeeklyIntervalWrite(Writer: TWriter);
    procedure PropYearlyDayRead(Reader: TReader);
    procedure PropYearlyDayWrite(Writer: TWriter);
    procedure PropYearlyIndexKindRead(Reader: TReader);
    procedure PropYearlyIndexKindWrite(Writer: TWriter);
    procedure PropYearlyIndexValueRead(Reader: TReader);
    procedure PropYearlyIndexValueWrite(Writer: TWriter);
    procedure PropYearlyIntervalRead(Reader: TReader);
    procedure PropYearlyIntervalWrite(Writer: TWriter);
    procedure PropYearlyMonthRead(Reader: TReader);
    procedure PropYearlyMonthWrite(Writer: TWriter);
    procedure SetName(Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure LoadState(const TriggerStamp: TTimeStamp; const TriggerCount, DayCount: Integer;
      const SnoozeStamp: TTimeStamp; const ALastSnoozeInterval: TSystemTime); virtual;
    procedure Pause;
    procedure SaveState(out TriggerStamp: TTimeStamp; out TriggerCount, DayCount: Integer;
      out SnoozeStamp: TTimeStamp; out ALastSnoozeInterval: TSystemTime); virtual;
    procedure Snooze(const MSecs: Word; const Secs: Word = 0; const Mins: Word = 0;
      const Hrs: Word = 0; const Days: Word = 0);
    procedure Start;
    procedure Stop;
    // Persisting schedules: deprecated as of 2002/11/30
    // (rom) deleted for JVCL 2.1
    (*
    procedure LoadFromStreamBin(const S: TStream);
      {$IFDEF COMPILER6_UP} deprecated; {$ENDIF}
    procedure SaveToStreamBin(const S: TStream);
      {$IFDEF COMPILER6_UP} deprecated; {$ENDIF}
    *)
    property Data: Pointer read FData write FData;
    property LastSnoozeInterval: TSystemTime read FLastSnoozeInterval;
    property NextFire: TTimeStamp read GetNextFire;
    property State: TScheduledEventState read FState;
    property NextScheduleFire: TTimeStamp read FScheduleFire;
    property RequestedTriggerTime: TTimeStamp read FReqTriggerTime;
    property ActualTriggerTime: TTimeStamp read FActualTriggerTime;
  published
    property CountMissedEvents: Boolean read FCountMissedEvents write FCountMissedEvents default False;
    property Name: string read FName write SetName;
    property Schedule: IJclSchedule read FSchedule write FSchedule stored False;
    property OnExecute: TScheduledEventExecute read FOnExecute write FOnExecute;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvScheduledEvents.pas,v $';
    Revision: '$Revision: 1.27 $';
    Date: '$Date: 2005/02/17 10:20:52 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  TypInfo,
  JclDateTime, JclRTTI,
  JvJVCLUtils, JvResources, JvTypes;

const
  cEventPrefix = 'Event ';

//=== { TScheduleThread } ====================================================

type
  TScheduleThread = class(TThread)
  private
    FCritSect: TCriticalSection;
    FEnded: Boolean;
    FEventComponents: TComponentList;
    FEventIdx: Integer;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    procedure AddEventComponent(const AComp: TJvCustomScheduledEvents);
    procedure RemoveEventComponent(const AComp: TJvCustomScheduledEvents);
    procedure Lock;
    procedure Unlock;
    property Ended: Boolean read FEnded;
  end;

constructor TScheduleThread.Create;
begin
  inherited Create(True);
  FCritSect := TCriticalSection.Create;
  FEventComponents := TComponentList.Create(False);
end;

destructor TScheduleThread.Destroy;
begin
  inherited Destroy;
  FreeAndNil(FCritSect);
end;

procedure TScheduleThread.Execute;
var
  TskColl: TJvEventCollection;
  I: Integer;
  SysTime: TSystemTime;
  NowStamp: TTimeStamp;
begin
  try
    FEnded := False;
    while not Terminated do
    begin
      if (FCritSect <> nil) and (FEventComponents <> nil) then
      begin
        FCritSect.Enter;
        try
          FEventIdx := FEventComponents.Count - 1;
          while (FEventIdx > -1) and not Terminated do
          begin
            GetLocalTime(SysTime);
            NowStamp := DateTimeToTimeStamp(Now);
            with SysTime do
              NowStamp.Time := wHour * 3600000 + wMinute * 60000 + wSecond * 1000 + wMilliseconds;
            TskColl := TJvCustomScheduledEvents(FEventComponents[FEventIdx]).Events;
            I := 0;
            while (I < TskColl.Count) and not Terminated do
            begin
              if (TskColl[I].State = sesWaiting) and
                (CompareTimeStamps(NowStamp, TskColl[I].NextFire) >= 0) then
              begin
                TskColl[I].Triggered;
                PostMessage(TJvCustomScheduledEvents(FEventComponents[FEventIdx]).Handle,
                  CM_EXECEVENT, Integer(TskColl[I]), 0);
              end;
              Inc(I);
            end;
            Dec(FEventIdx);
          end;
        finally
          FCritSect.Leave;
        end;
      end;
      if not Terminated then
        Sleep(1);
    end;
  except
  end;
  FEnded := True;
end;

procedure TScheduleThread.BeforeDestruction;
begin
  if (FCritSect = nil) or (FEventComponents = nil) then
    Exit;
  FCritSect.Enter;
  try
    FreeAndNil(FEventComponents);
  finally
    FCritSect.Leave;
  end;
  inherited BeforeDestruction;
end;

procedure TScheduleThread.AddEventComponent(const AComp: TJvCustomScheduledEvents);
begin
  if (FCritSect = nil) or (FEventComponents = nil) then
    Exit;
  FCritSect.Enter;
  try
    if FEventComponents.IndexOf(AComp) = -1 then
    begin
      FEventComponents.Add(AComp);
      if Suspended then
        Resume;
    end;
  finally
    FCritSect.Leave;
  end;
end;

procedure TScheduleThread.RemoveEventComponent(const AComp: TJvCustomScheduledEvents);
begin
  if (FCritSect = nil) or (FEventComponents = nil) then
    Exit;
  FCritSect.Enter;
  try
    FEventComponents.Remove(AComp);
  finally
    FCritSect.Leave;
  end;
end;

procedure TScheduleThread.Lock;
begin
  FCritSect.Enter;
end;

procedure TScheduleThread.Unlock;
begin
  FCritSect.Leave;
end;

{ TScheduleThread instance }

var
  GScheduleThread: TScheduleThread = nil;

procedure FinalizeScheduleThread;
begin
  if GScheduleThread <> nil then
  begin
    if GScheduleThread.Suspended then
      GScheduleThread.Resume;
    GScheduleThread.FreeOnTerminate := False;
    GScheduleThread.Terminate;
    while not GScheduleThread.Ended do
      Application.ProcessMessages;
    FreeAndNil(GScheduleThread);
  end;
end;

function ScheduleThread: TScheduleThread;
begin
  if GScheduleThread = nil then
    GScheduleThread := TScheduleThread.Create;
  Result := GScheduleThread;
end;

//=== { THackWriter } ========================================================

type
  TReaderAccessProtected = class(TReader);

type
  THackWriter = class(TWriter)
  protected
    procedure WriteSet(SetType: Pointer; Value: Integer);
  end;

// Copied from D5 Classes.pas and modified a bit.