Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/run/JvSchedEvtStore.pas

1588 lines
50 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
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.
******************************************************************************
Persistency layer for JvScheduledEvents
You may retrieve the latest version of this file at the Project JEDI home
page, located at http://www.delphi-jedi.org
-----------------------------------------------------------------------------}
// $Id: JvSchedEvtStore.pas 10612 2006-05-19 19:04:09Z jfudickar $
unit JvSchedEvtStore;
{$I jvcl.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
Classes,
JvScheduledEvents;
type
TSchedEvtStoreAttribute = (sesaStructured, sesaIdentifiers);
TSchedEvtStoreAttributes = set of TSchedEvtStoreAttribute;
TSchedEvtStructKind =
(seskState, seskEvent, seskSchedule, seskScheduleRecurInfo,
seskScheduleEndInfo, seskScheduleDayFreq, seskScheduleDaily,
seskScheduleWeekly, seskScheduleMonthly, seskScheduleMonthlyIndex,
seskScheduleYearly, seskScheduleYearlyIndex);
TSchedEvtItemKind =
(seikUnknown, seikScheduleStart, seikScheduleRecurType,
seikScheduleEndType, seikScheduleEndCount, seikScheduleEndDate,
seikFreqStart, seikFreqEnd, seikFreqInterval, seikScheduleDailyWeekdays,
seikScheduleDailyInterval, seikScheduleWeeklyDays,
seikScheduleWeeklyInterval, seikScheduleMonthlyDay,
seikScheduleMonthlyIndexType, seikScheduleMonthlyIndex,
seikScheduleMonthlyInterval, seikScheduleYearlyDay,
seikScheduleYearlyMonth, seikScheduleYearlyIndexType,
seikScheduleYearlyIndex, seikScheduleYearlyInterval);
IJvScheduledEventsStore = interface
['{FD6437D8-B951-4C72-AA5F-B96911D51B65}']
procedure LoadState(const Event: TJvEventCollectionItem);
procedure SaveState(const Event: TJvEventCollectionItem);
procedure LoadSchedule(const Event: TJvEventCollectionItem);
procedure SaveSchedule(const Event: TJvEventCollectionItem);
procedure LoadEventSettings(const Event: TJvEventCollectionItem);
procedure SaveEventSettings(const Event: TJvEventCollectionItem);
end;
TJvSchedEvtStore = class(TInterfacedObject, IJvScheduledEventsStore)
private
FEvent: TJvEventCollectionItem;
FStructStack: array of TSchedEvtStructKind;
protected
// Structure stack managment: low level
procedure PushStruct(const StructType: TSchedEvtStructKind);
function PeekStruct: TSchedEvtStructKind;
function PopStruct: TSchedEvtStructKind;
// property access methods
function GetEvent: TJvEventCollectionItem;
// Retrieving items: Schedule
procedure CheckSignature; virtual; abstract;
procedure CheckVersion; virtual; abstract;
function NextItemKind: TSchedEvtItemKind; virtual;
procedure RestoreScheduleStart; virtual; abstract;
procedure RestoreScheduleRecurType; virtual; abstract;
procedure RestoreScheduleEndType; virtual; abstract;
procedure RestoreScheduleEndCount; virtual; abstract;
procedure RestoreScheduleEndDate; virtual; abstract;
procedure RestoreFreqStart; virtual; abstract;
procedure RestoreFreqEnd; virtual; abstract;
procedure RestoreFreqInterval; virtual; abstract;
procedure RestoreScheduleDailyWeekdays; virtual; abstract;
procedure RestoreScheduleDailyInterval; virtual; abstract;
procedure RestoreScheduleWeeklyDays; virtual; abstract;
procedure RestoreScheduleWeeklyInterval; virtual; abstract;
procedure RestoreScheduleMonthlyDay; virtual; abstract;
procedure RestoreScheduleMonthlyIndexType; virtual; abstract;
procedure RestoreScheduleMonthlyIndex; virtual; abstract;
procedure RestoreScheduleMonthlyInterval; virtual; abstract;
procedure RestoreScheduleYearlyDay; virtual; abstract;
procedure RestoreScheduleYearlyMonth; virtual; abstract;
procedure RestoreScheduleYearlyIndexType; virtual; abstract;
procedure RestoreScheduleYearlyIndex; virtual; abstract;
procedure RestoreScheduleYearlyInterval; virtual; abstract;
// Storing items: signature (only for unstructured storages) and versioning
procedure StoreSignature; virtual;
procedure StoreVersion; virtual; abstract;
// Storing items: Schedule
procedure StoreScheduleStart; virtual; abstract;
procedure StoreScheduleRecurType; virtual; abstract;
procedure StoreScheduleEndType; virtual; abstract;
procedure StoreScheduleEndCount; virtual; abstract;
procedure StoreScheduleEndDate; virtual; abstract;
procedure StoreFreqStart; virtual; abstract;
procedure StoreFreqEnd; virtual; abstract;
procedure StoreFreqInterval; virtual; abstract;
procedure StoreScheduleDailyWeekdays; virtual; abstract;
procedure StoreScheduleDailyInterval; virtual; abstract;
procedure StoreScheduleWeeklyDays; virtual; abstract;
procedure StoreScheduleWeeklyInterval; virtual; abstract;
procedure StoreScheduleMonthlyDay; virtual; abstract;
procedure StoreScheduleMonthlyIndexType; virtual; abstract;
procedure StoreScheduleMonthlyIndex; virtual; abstract;
procedure StoreScheduleMonthlyInterval; virtual; abstract;
procedure StoreScheduleYearlyDay; virtual; abstract;
procedure StoreScheduleYearlyMonth; virtual; abstract;
procedure StoreScheduleYearlyIndexType; virtual; abstract;
procedure StoreScheduleYearlyIndex; virtual; abstract;
procedure StoreScheduleYearlyInterval; virtual; abstract;
// Structure stack managment: high level
procedure BeginStruct(const StructType: TSchedEvtStructKind); virtual;
procedure EndStruct; virtual;
procedure CheckBeginStruct(const StructType: TSchedEvtStructKind); virtual;
procedure CheckEndStruct; virtual;
property Event: TJvEventCollectionItem read GetEvent;
public
function IsStructured: Boolean;
function UsesIdentifiers: Boolean;
function GetAttributes: TSchedEvtStoreAttributes; virtual;
procedure LoadState(const Event: TJvEventCollectionItem);
procedure SaveState(const Event: TJvEventCollectionItem);
procedure LoadSchedule(const Event: TJvEventCollectionItem);
procedure SaveSchedule(const Event: TJvEventCollectionItem);
procedure LoadEventSettings(const Event: TJvEventCollectionItem);
procedure SaveEventSettings(const Event: TJvEventCollectionItem);
end;
function ScheduledEventStore_Stream(const Stream: TStream; const Binary: Boolean = False;
const OwnsStream: Boolean = True): IJvScheduledEventsStore;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvSchedEvtStore.pas $';
Revision: '$Revision: 10612 $';
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
uses
SysUtils, TypInfo,
JclRTTI, JclSchedule,
JvConsts, JvTypes, JvResources;
//=== { TJvSchedEvtStore } ===================================================
procedure TJvSchedEvtStore.PushStruct(const StructType: TSchedEvtStructKind);
begin
SetLength(FStructStack, Length(FStructStack) + 1);
FStructStack[High(FStructStack)] := StructType;
end;
function TJvSchedEvtStore.PeekStruct: TSchedEvtStructKind;
begin
if Length(FStructStack) = 0 then
raise EJVCLException.CreateRes(@RsEStructureStackIsEmpty);
Result := FStructStack[High(FStructStack)];
end;
function TJvSchedEvtStore.PopStruct: TSchedEvtStructKind;
begin
Result := PeekStruct;
SetLength(FStructStack, High(FStructStack));
end;
function TJvSchedEvtStore.GetEvent: TJvEventCollectionItem;
begin
Result := FEvent;
end;
function TJvSchedEvtStore.NextItemKind: TSchedEvtItemKind;
begin
Result := seikUnknown;
end;
procedure TJvSchedEvtStore.StoreSignature;
begin
// override for non-structured storages to store an identification of the stream if needed.
TProcedure(AbstractErrorProc);
end;
procedure TJvSchedEvtStore.BeginStruct(const StructType: TSchedEvtStructKind);
begin
{ override to take additional steps when a new structure is to be written. Either call inherited
or use PushStruct to store the current structure information on the stack. }
PushStruct(StructType);
end;
procedure TJvSchedEvtStore.EndStruct;
begin
{ override to take additional steps when a structure is to be terminated. Either call inherited
or use PopStruct to retrieve the structure information from the stack. }
PopStruct;
end;
procedure TJvSchedEvtStore.CheckBeginStruct(const StructType: TSchedEvtStructKind);
begin
{ override to check if the next structure is the one specified and raise an exception if it isn't.
Either call inherited or use PushStruct to store the current structure information on the
stack. }
PushStruct(StructType);
end;
procedure TJvSchedEvtStore.CheckEndStruct;
begin
{ override to check if the next item marks the end of the structure as specified on the current
stack (use PopStruct to retrieve the structure information from the stack). Raise an exception
if the next item does not mark the end of the currently active structure. }
PopStruct;
end;
function TJvSchedEvtStore.IsStructured: Boolean;
begin
Result := sesaStructured in GetAttributes;
end;
function TJvSchedEvtStore.UsesIdentifiers: Boolean;
begin
Result := sesaIdentifiers in GetAttributes;
end;
function TJvSchedEvtStore.GetAttributes: TSchedEvtStoreAttributes;
begin
Result := [];
end;
procedure TJvSchedEvtStore.LoadState(const Event: TJvEventCollectionItem);
begin
raise EJVCLException.CreateRes(@RsENotImplemented);
end;
procedure TJvSchedEvtStore.SaveState(const Event: TJvEventCollectionItem);
begin
raise EJVCLException.CreateRes(@RsENotImplemented);
end;
procedure TJvSchedEvtStore.LoadSchedule(const Event: TJvEventCollectionItem);
var
OrgSchedule: IJclSchedule;
begin
// Clear the structure stack
SetLength(FStructStack, 0);
FEvent := Event;
with Event do
begin
if not (State in [sesNotInitialized, sesEnded]) then
raise EJVCLException.CreateRes(@RsEScheduleIsActiveReadingANewSchedule);
OrgSchedule := Schedule;
try
Schedule := CreateSchedule;
// Begin of actual reading
if not IsStructured then
CheckSignature;
CheckBeginStruct(seskSchedule);
CheckVersion;
// Generic schedule info
RestoreScheduleStart;
CheckBeginStruct(seskScheduleRecurInfo);
RestoreScheduleRecurType;
if Schedule.RecurringType <> srkOneShot then
begin
CheckBeginStruct(seskScheduleEndInfo);
RestoreScheduleEndType;
if Schedule.EndType = sekDate then
RestoreScheduleEndDate
else
if Schedule.EndType in [sekTriggerCount, sekDayCount] then
RestoreScheduleEndCount;
CheckEndStruct; {seskScheduleEndInfo}
CheckBeginStruct(seskScheduleDayFreq);
RestoreFreqStart;
if not UsesIdentifiers or (NextItemKind = seikFreqEnd) then
begin
RestoreFreqEnd;
RestoreFreqInterval;
end;
CheckEndStruct; {seskScheduleDayFreq}
case Schedule.RecurringType of
srkDaily:
begin
CheckBeginStruct(seskScheduleDaily);
if not UsesIdentifiers or (NextItemKind = seikScheduleDailyWeekdays) then
RestoreScheduleDailyWeekdays;
if not UsesIdentifiers or (NextItemKind = seikScheduleDailyInterval) then
RestoreScheduleDailyInterval;
CheckEndStruct; {seskScheduleDaily}
end;
srkWeekly:
begin
CheckBeginStruct(seskScheduleWeekly);
RestoreScheduleWeeklyDays;
RestoreScheduleWeeklyInterval;
CheckEndStruct; {seskScheduleWeekly}
end;
srkMonthly:
begin
CheckBeginStruct(seskScheduleMonthly);
CheckBeginStruct(seskScheduleMonthlyIndex);
RestoreScheduleMonthlyIndexType;
if (Schedule as IJclMonthlySchedule).IndexKind <> sikNone then
RestoreScheduleMonthlyIndex;
CheckEndStruct; {seskScheduleMonthlyIndex}
if (Schedule as IJclMonthlySchedule).IndexKind = sikNone then
RestoreScheduleMonthlyDay;
RestoreScheduleMonthlyInterval;
CheckEndStruct; {seskScheduleMonthly}
end;
srkYearly:
begin
CheckBeginStruct(seskScheduleYearly);
CheckBeginStruct(seskScheduleYearlyIndex);
RestoreScheduleYearlyIndexType;
if (Schedule as IJclYearlySchedule).IndexKind <> sikNone then
RestoreScheduleYearlyIndex;
CheckEndStruct; {seskScheduleYearlyIndex}
if (Schedule as IJclYearlySchedule).IndexKind = sikNone then
RestoreScheduleYearlyDay;
RestoreScheduleYearlyMonth;
RestoreScheduleYearlyInterval;
CheckEndStruct; {seskScheduleYearly}
end;
end;
end;
CheckEndStruct; {seskScheduleRecurInfo}
CheckEndStruct; {seskSchedule}
// we succeeded in reading in the schedule.
except
{ uh-oh! reading of the schedule failed. Better restore the original
schedule so the end user won't miss it ;) }
Schedule := OrgSchedule;
raise;
end;
end;
end;
procedure TJvSchedEvtStore.SaveSchedule(const Event: TJvEventCollectionItem);
begin
// Clear the structure stack
SetLength(FStructStack, 0);
FEvent := Event;
with Event do
begin
if not (State in [sesNotInitialized, sesEnded, sesPaused]) then
raise EJVCLException.CreateRes(@RsEScheduleIsActiveStoringOfAScheduleC);
if not IsStructured then
StoreSignature;
BeginStruct(seskSchedule);
StoreVersion;
// Generic schedule info
StoreScheduleStart;
BeginStruct(seskScheduleRecurInfo);
StoreScheduleRecurType;
if Schedule.RecurringType <> srkOneShot then
begin
BeginStruct(seskScheduleEndInfo);
StoreScheduleEndType;
if Schedule.EndType = sekDate then
StoreScheduleEndDate
else
if Schedule.EndType in [sekTriggerCount, sekDayCount] then
StoreScheduleEndCount;
EndStruct; {seskScheduleEndInfo}
BeginStruct(seskScheduleDayFreq);
StoreFreqStart;
if not UsesIdentifiers or ((Schedule as IJclScheduleDayFrequency).Interval <> 0) then
begin
StoreFreqEnd;
StoreFreqInterval;
end;
EndStruct; {seskScheduleDayFreq}
case Schedule.RecurringType of
srkDaily:
begin
BeginStruct(seskScheduleDaily);
if not UsesIdentifiers or (Schedule as IJclDailySchedule).EveryWeekDay then
StoreScheduleDailyWeekdays;
if not UsesIdentifiers or not (Schedule as IJclDailySchedule).EveryWeekDay then
StoreScheduleDailyInterval;
EndStruct; {seskScheduleDaily}
end;
srkWeekly:
begin
BeginStruct(seskScheduleWeekly);
StoreScheduleWeeklyDays;
StoreScheduleWeeklyInterval;
EndStruct; {seskScheduleWeekly}
end;
srkMonthly:
begin
BeginStruct(seskScheduleMonthly);
BeginStruct(seskScheduleMonthlyIndex);
StoreScheduleMonthlyIndexType;
if (Schedule as IJclMonthlySchedule).IndexKind <> sikNone then
StoreScheduleMonthlyIndex;
EndStruct; {seskScheduleMonthlyIndex}
if (Schedule as IJclMonthlySchedule).IndexKind = sikNone then
StoreScheduleMonthlyDay;
StoreScheduleMonthlyInterval;
EndStruct; {seskScheduleMonthly}
end;
srkYearly:
begin
BeginStruct(seskScheduleYearly);
BeginStruct(seskScheduleYearlyIndex);
StoreScheduleYearlyIndexType;
if (Schedule as IJclYearlySchedule).IndexKind <> sikNone then
StoreScheduleYearlyIndex;
EndStruct; {seskScheduleYearlyIndex}
if (Schedule as IJclYearlySchedule).IndexKind = sikNone then
StoreScheduleYearlyDay;
StoreScheduleYearlyMonth;
StoreScheduleYearlyInterval;
EndStruct; {seskScheduleYearly}
end;
end;
end;
EndStruct; {seskScheduleRecurInfo}
EndStruct; {seskSchedule}
end;
end;
procedure TJvSchedEvtStore.LoadEventSettings(const Event: TJvEventCollectionItem);
begin
raise EJVCLException.CreateRes(@RsENotImplemented_);
end;
procedure TJvSchedEvtStore.SaveEventSettings(const Event: TJvEventCollectionItem);
begin
raise EJVCLException.CreateRes(@RsENotImplemented_);
end;
//=== { TBinStore } ==========================================================
const
BinStreamID = 'JVSE';
BinStreamVer = Word($0001);
type
TBinStore = class(TJvSchedEvtStore)
private
FStream: TStream;
FOwnsStream: Boolean;
FStreamVersion: Word; // Only used for reading
protected
// Retrieving items: Schedule
procedure CheckSignature; override;
procedure CheckVersion; override;
procedure RestoreScheduleStart; override;
procedure RestoreScheduleRecurType; override;
procedure RestoreScheduleEndType; override;
procedure RestoreScheduleEndCount; override;
procedure RestoreScheduleEndDate; override;
procedure RestoreFreqStart; override;
procedure RestoreFreqEnd; override;
procedure RestoreFreqInterval; override;
procedure RestoreScheduleDailyWeekdays; override;
procedure RestoreScheduleDailyInterval; override;
procedure RestoreScheduleWeeklyDays; override;
procedure RestoreScheduleWeeklyInterval; override;
procedure RestoreScheduleMonthlyDay; override;
procedure RestoreScheduleMonthlyIndexType; override;
procedure RestoreScheduleMonthlyIndex; override;
procedure RestoreScheduleMonthlyInterval; override;
procedure RestoreScheduleYearlyDay; override;
procedure RestoreScheduleYearlyMonth; override;
procedure RestoreScheduleYearlyIndexType; override;
procedure RestoreScheduleYearlyIndex; override;
procedure RestoreScheduleYearlyInterval; override;
// Storing items: signature (only for unstructured storages) and versioning
procedure StoreSignature; override;
procedure StoreVersion; override;
// Storing items: Schedule
procedure StoreScheduleStart; override;
procedure StoreScheduleRecurType; override;
procedure StoreScheduleEndType; override;
procedure StoreScheduleEndCount; override;
procedure StoreScheduleEndDate; override;
procedure StoreFreqStart; override;
procedure StoreFreqEnd; override;
procedure StoreFreqInterval; override;
procedure StoreScheduleDailyWeekdays; override;
procedure StoreScheduleDailyInterval; override;
procedure StoreScheduleWeeklyDays; override;
procedure StoreScheduleWeeklyInterval; override;
procedure StoreScheduleMonthlyDay; override;
procedure StoreScheduleMonthlyIndexType; override;
procedure StoreScheduleMonthlyIndex; override;
procedure StoreScheduleMonthlyInterval; override;
procedure StoreScheduleYearlyDay; override;
procedure StoreScheduleYearlyMonth; override;
procedure StoreScheduleYearlyIndexType; override;
procedure StoreScheduleYearlyIndex; override;
procedure StoreScheduleYearlyInterval; override;
public
constructor Create(const AStream: TStream; const AOwnsStream: Boolean = True);
destructor Destroy; override;
end;
constructor TBinStore.Create(const AStream: TStream; const AOwnsStream: Boolean);
begin
inherited Create;
FStream := AStream;
FOwnsStream := AOwnsStream;
end;
destructor TBinStore.Destroy;
begin
if FOwnsStream then
FreeAndNil(FStream);
inherited Destroy;
end;
procedure TBinStore.CheckSignature;
var
S: string;
begin
SetLength(S, Length(BinStreamID));
FStream.ReadBuffer(S[1], Length(BinStreamID));
if S <> BinStreamID then
raise EJVCLException.CreateRes(@RsENotASchedule);
end;
procedure TBinStore.CheckVersion;
begin
FStream.ReadBuffer(FStreamVersion, SizeOf(FStreamVersion));
if FStreamVersion > BinStreamVer then
raise EJVCLException.CreateResFmt(@RsEUnknownScheduleVersions, [IntToHex(FStreamVersion, 4)]);
end;
procedure TBinStore.RestoreScheduleStart;
var
I: TTimeStamp;
begin
FStream.ReadBuffer(I, SizeOf(I));
Event.Schedule.StartDate := I;
end;
procedure TBinStore.RestoreScheduleRecurType;
var
I: TScheduleRecurringKind;
begin
FStream.ReadBuffer(I, SizeOf(I));
Event.Schedule.RecurringType := I;
end;
procedure TBinStore.RestoreScheduleEndType;
var
I: TScheduleEndKind;
begin
FStream.ReadBuffer(I, SizeOf(I));
Event.Schedule.EndType := I;
end;
procedure TBinStore.RestoreScheduleEndCount;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
Event.Schedule.EndCount := I;
end;
procedure TBinStore.RestoreScheduleEndDate;
var
I: TTimeStamp;
begin
FStream.ReadBuffer(I, SizeOf(I));
Event.Schedule.EndDate := I;
end;
procedure TBinStore.RestoreFreqStart;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclScheduleDayFrequency).StartTime := I;
end;
procedure TBinStore.RestoreFreqEnd;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclScheduleDayFrequency).EndTime := I;
end;
procedure TBinStore.RestoreFreqInterval;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclScheduleDayFrequency).Interval := I;
end;
procedure TBinStore.RestoreScheduleDailyWeekdays;
var
I: Boolean;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclDailySchedule).EveryWeekDay := I;
end;
procedure TBinStore.RestoreScheduleDailyInterval;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclDailySchedule).Interval := I;
end;
procedure TBinStore.RestoreScheduleWeeklyDays;
var
I: TScheduleWeekDays;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclWeeklySchedule).DaysOfWeek := I;
end;
procedure TBinStore.RestoreScheduleWeeklyInterval;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclWeeklySchedule).Interval := I;
end;
procedure TBinStore.RestoreScheduleMonthlyDay;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclMonthlySchedule).Day := I;
end;
procedure TBinStore.RestoreScheduleMonthlyIndexType;
var
I: TScheduleIndexKind;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclMonthlySchedule).IndexKind := I;
end;
procedure TBinStore.RestoreScheduleMonthlyIndex;
var
I: Integer;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclMonthlySchedule).IndexValue := I;
end;
procedure TBinStore.RestoreScheduleMonthlyInterval;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclMonthlySchedule).Interval := I;
end;
procedure TBinStore.RestoreScheduleYearlyDay;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclYearlySchedule).Day := I;
end;
procedure TBinStore.RestoreScheduleYearlyMonth;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclYearlySchedule).Month := I;
end;
procedure TBinStore.RestoreScheduleYearlyIndexType;
var
I: TScheduleIndexKind;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclYearlySchedule).IndexKind := I;
end;
procedure TBinStore.RestoreScheduleYearlyIndex;
var
I: Integer;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclYearlySchedule).IndexValue := I;
end;
procedure TBinStore.RestoreScheduleYearlyInterval;
var
I: Cardinal;
begin
FStream.ReadBuffer(I, SizeOf(I));
(Event.Schedule as IJclYearlySchedule).Interval := I;
end;
procedure TBinStore.StoreSignature;
var
S: string;
begin
S := BinStreamID;
FStream.WriteBuffer(S[1], Length(S));
end;
procedure TBinStore.StoreVersion;
var
W: Word;
begin
W := BinStreamVer;
FStream.WriteBuffer(W, SizeOf(W));
end;
procedure TBinStore.StoreScheduleStart;
var
Stamp: TTimeStamp;
begin
Stamp := Event.Schedule.StartDate;
FStream.WriteBuffer(Stamp, SizeOf(Stamp));
end;
procedure TBinStore.StoreScheduleRecurType;
var
RT: TScheduleRecurringKind;
begin
RT := Event.Schedule.RecurringType;
FStream.WriteBuffer(RT, SizeOf(RT));
end;
procedure TBinStore.StoreScheduleEndType;
var
ET: TScheduleEndKind;
begin
ET := Event.Schedule.EndType;
FStream.WriteBuffer(ET, SizeOf(ET));
end;
procedure TBinStore.StoreScheduleEndCount;
var
I: Cardinal;
begin
I := Event.Schedule.EndCount;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleEndDate;
var
Stamp: TTimeStamp;
begin
Stamp := Event.Schedule.EndDate;
FStream.WriteBuffer(Stamp, SizeOf(Stamp));
end;
procedure TBinStore.StoreFreqStart;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclScheduleDayFrequency).StartTime;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreFreqEnd;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclScheduleDayFrequency).EndTime;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreFreqInterval;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclScheduleDayFrequency).Interval;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleDailyWeekdays;
var
EWD: Boolean;
begin
EWD := (Event.Schedule as IJclDailySchedule).EveryWeekDay;
FStream.WriteBuffer(EWD, SizeOf(EWD));
end;
procedure TBinStore.StoreScheduleDailyInterval;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclDailySchedule).Interval;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleWeeklyDays;
var
WD: TScheduleWeekDays;
begin
WD := (Event.Schedule as IJclWeeklySchedule).DaysOfWeek;
FStream.WriteBuffer(WD, SizeOf(WD));
end;
procedure TBinStore.StoreScheduleWeeklyInterval;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclWeeklySchedule).Interval;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleMonthlyDay;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclMonthlySchedule).Day;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleMonthlyIndexType;
var
I: TScheduleIndexKind;
begin
I := (Event.Schedule as IJclMonthlySchedule).IndexKind;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleMonthlyIndex;
var
I: Integer;
begin
I := (Event.Schedule as IJclMonthlySchedule).IndexValue;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleMonthlyInterval;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclMonthlySchedule).Interval;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleYearlyDay;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclYearlySchedule).Day;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleYearlyMonth;
var
I: Cardinal;
begin
I := (Event.Schedule as IJclYearlySchedule).Month;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleYearlyIndexType;
var
I: TScheduleIndexKind;
begin
I := (Event.Schedule as IJclYearlySchedule).IndexKind;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleYearlyIndex;
var
I: Integer;
begin
I := (Event.Schedule as IJclYearlySchedule).IndexValue;
FStream.WriteBuffer(I, SizeOf(I));
end;
procedure TBinStore.StoreScheduleYearlyInterval;
var
I: Integer;
begin
I := (Event.Schedule as IJclYearlySchedule).Interval;
FStream.WriteBuffer(I, SizeOf(I));
end;
//=== { TTxtStore } ==========================================================
const
TxtIdentifiers: array [TSchedEvtItemKind] of PChar =
('', {seikUnknown}
'Start', {seikScheduleStart}
'Recur type', {seikScheduleRecurType}
'End type', {seikScheduleEndType}
'End count', {seikScheduleEndCount}
'End', {seikScheduleEndDate}
'Frequency start', {seikFreqStart}
'Frequency end', {seikFreqEnd}
'Frequency interval', {seikFreqInterval}
'Daily every weekday', {seikScheduleDailyWeekdays}
'Daily interval', {seikScheduleDailyInterval}
'Weekly days', {seikScheduleWeeklyDays}
'Weekly interval', {seikScheduleWeeklyInterval}
'Monthly day', {seikScheduleMonthlyDay}
'Monthly index type', {seikScheduleMonthlyIndexType}
'Monthly index', {seikScheduleMonthlyIndex}
'Monthly interval', {seikScheduleMonthlyInterval}
'Yearly day', {seikScheduleYearlyDay}
'Yearly month', {seikScheduleYearlyMonth}
'Yearly index type', {seikScheduleYearlyIndexType}
'Yearly index', {seikScheduleYearlyIndex}
'Yearly interval'); {seikScheduleYearlyInterval}
sTXTID_SchedGeneric = '# Schedule: Generic';
sTXTID_SchedRecur = '# Schedule: Recurring info';
sTXTID_SchedEnd = '# Schedule: End info';
sTXTID_SchedFreq = '# Schedule: Day frequency';
sTXTID_SchedDaily = '# Schedule: Daily info';
sTXTID_SchedWeekly = '# Schedule: Weekly info';
sTXTID_SchedMonthly = '# Schedule: Monthly info';
sTXTID_SchedYearly = '# Schedule: Yearly info';
type
TTxtStore = class(TJvSchedEvtStore)
private
FStream: TStream;
FOwnsStream: Boolean;
protected
// Retrieving items: Schedule
procedure CheckSignature; override;
procedure CheckVersion; override;
function NextItemKind: TSchedEvtItemKind; override;
procedure RestoreScheduleStart; override;
procedure RestoreScheduleRecurType; override;
procedure RestoreScheduleEndType; override;
procedure RestoreScheduleEndCount; override;
procedure RestoreScheduleEndDate; override;
procedure RestoreFreqStart; override;
procedure RestoreFreqEnd; override;
procedure RestoreFreqInterval; override;
procedure RestoreScheduleDailyWeekdays; override;
procedure RestoreScheduleDailyInterval; override;
procedure RestoreScheduleWeeklyDays; override;
procedure RestoreScheduleWeeklyInterval; override;
procedure RestoreScheduleMonthlyDay; override;
procedure RestoreScheduleMonthlyIndexType; override;
procedure RestoreScheduleMonthlyIndex; override;
procedure RestoreScheduleMonthlyInterval; override;
procedure RestoreScheduleYearlyDay; override;
procedure RestoreScheduleYearlyMonth; override;
procedure RestoreScheduleYearlyIndexType; override;
procedure RestoreScheduleYearlyIndex; override;
procedure RestoreScheduleYearlyInterval; override;
// Storing items: signature (only for unstructured storages) and versioning
procedure StoreSignature; override;
procedure StoreVersion; override;
// Storing items: Schedule
procedure StoreScheduleStart; override;
procedure StoreScheduleRecurType; override;
procedure StoreScheduleEndType; override;
procedure StoreScheduleEndCount; override;
procedure StoreScheduleEndDate; override;
procedure StoreFreqStart; override;
procedure StoreFreqEnd; override;
procedure StoreFreqInterval; override;
procedure StoreScheduleDailyWeekdays; override;
procedure StoreScheduleDailyInterval; override;
procedure StoreScheduleWeeklyDays; override;
procedure StoreScheduleWeeklyInterval; override;
procedure StoreScheduleMonthlyDay; override;
procedure StoreScheduleMonthlyIndexType; override;
procedure StoreScheduleMonthlyIndex; override;
procedure StoreScheduleMonthlyInterval; override;
procedure StoreScheduleYearlyDay; override;
procedure StoreScheduleYearlyMonth; override;
procedure StoreScheduleYearlyIndexType; override;
procedure StoreScheduleYearlyIndex; override;
procedure StoreScheduleYearlyInterval; override;
procedure BeginStruct(const StructType: TSchedEvtStructKind); override;
procedure EndStruct; override;
procedure CheckBeginStruct(const StructType: TSchedEvtStructKind); override;
procedure CheckEndStruct; override;
function ReadLn: string;
function ReadNextLine: string;
function ReadItem(out AName: string): string;
procedure WriteLn(const S: string);
function ReadEnum(const AName: string; TypeInfo: PTypeInfo): Integer;
function ReadInt(const AName: string): Int64;
procedure ReadSet(const AName: string; out Value; TypeInfo: PTypeInfo);
function ReadStamp(const AName: string): TTimeStamp;
function ReadStampDate(const AName: string): Integer;
function ReadStampTime(const AName: string): Integer;
procedure WriteEnum(const AName: string; const Ordinal: Integer; TypeInfo: PTypeInfo);
procedure WriteInt(const AName: string; const Value: Int64);
procedure WriteSet(const AName: string; const Value; TypeInfo: PTypeInfo);
procedure WriteStamp(const AName: string; const Stamp: TTimeStamp);
procedure WriteStampDate(const AName: string; const Date: Integer);
procedure WriteStampTime(const AName: string; const Time: Integer);
public
function GetAttributes: TSchedEvtStoreAttributes; override;
constructor Create(const AStream: TStream; const AOwnsStream: Boolean = True);
destructor Destroy; override;
end;
constructor TTxtStore.Create(const AStream: TStream; const AOwnsStream: Boolean);
begin
inherited Create;
FStream := AStream;
FOwnsStream := AOwnsStream;
end;
destructor TTxtStore.Destroy;
begin
if FOwnsStream then
FreeAndNil(FStream);
inherited Destroy;
end;
procedure TTxtStore.CheckSignature;
begin
end;
procedure TTxtStore.CheckVersion;
begin
end;
function TTxtStore.NextItemKind: TSchedEvtItemKind;
var
SPos: Integer;
ItemName: string;
I: Integer;
begin
SPos := FStream.Position;
try
ReadItem(ItemName);
I := Pos('.', ItemName);
if I > 0 then
ItemName := Copy(ItemName, 1, I - 1);
Result := High(TSchedEvtItemKind);
while (Result > Low(TSchedEvtItemKind)) and
not AnsiSameText(ItemName, TxtIdentifiers[Result]) do
Dec(Result);
finally
FStream.Position := SPos;
end;
end;
procedure TTxtStore.RestoreScheduleStart;
begin
Event.Schedule.StartDate := ReadStamp(TxtIdentifiers[seikScheduleStart]);
end;
procedure TTxtStore.RestoreScheduleRecurType;
begin
Event.Schedule.RecurringType := TScheduleRecurringKind(ReadEnum(
TxtIdentifiers[seikScheduleRecurType], TypeInfo(TScheduleRecurringKind)));
end;
procedure TTxtStore.RestoreScheduleEndType;
begin
Event.Schedule.EndType := TScheduleEndKind(ReadEnum(
TxtIdentifiers[seikScheduleEndType], TypeInfo(TScheduleEndKind)));
end;
procedure TTxtStore.RestoreScheduleEndCount;
begin
Event.Schedule.EndCount := ReadInt(TxtIdentifiers[seikScheduleEndCount]);
end;
procedure TTxtStore.RestoreScheduleEndDate;
begin
Event.Schedule.EndDate := ReadStamp(TxtIdentifiers[seikScheduleEndDate]);
end;
procedure TTxtStore.RestoreFreqStart;
begin
(Event.Schedule as IJclScheduleDayFrequency).StartTime := ReadStampTime(TxtIdentifiers[seikFreqStart]);
end;
procedure TTxtStore.RestoreFreqEnd;
begin
(Event.Schedule as IJclScheduleDayFrequency).EndTime := ReadStampTime(TxtIdentifiers[seikFreqEnd]);
end;
procedure TTxtStore.RestoreFreqInterval;
begin
(Event.Schedule as IJclScheduleDayFrequency).Interval := ReadStampTime(TxtIdentifiers[seikFreqInterval]);
end;
procedure TTxtStore.RestoreScheduleDailyWeekdays;
begin
(Event.Schedule as IJclDailySchedule).EveryWeekDay := Boolean(ReadEnum(TxtIdentifiers[seikScheduleDailyWeekdays],
TypeInfo(Boolean)));
end;
procedure TTxtStore.RestoreScheduleDailyInterval;
begin
(Event.Schedule as IJclDailySchedule).Interval := ReadInt(TxtIdentifiers[seikScheduleDailyInterval]);
end;
procedure TTxtStore.RestoreScheduleWeeklyDays;
var
I: TScheduleWeekDays;
begin
ReadSet(TxtIdentifiers[seikScheduleWeeklyDays], I, TypeInfo(TScheduleWeekDays));
(Event.Schedule as IJclWeeklySchedule).DaysOfWeek := I;
end;
procedure TTxtStore.RestoreScheduleWeeklyInterval;
begin
(Event.Schedule as IJclWeeklySchedule).Interval := ReadInt(TxtIdentifiers[seikScheduleWeeklyInterval]);
end;
procedure TTxtStore.RestoreScheduleMonthlyDay;
begin
(Event.Schedule as IJclMonthlySchedule).Day := ReadInt(TxtIdentifiers[seikScheduleMonthlyDay]);
end;
procedure TTxtStore.RestoreScheduleMonthlyIndexType;
begin
(Event.Schedule as IJclMonthlySchedule).IndexKind :=
TScheduleIndexKind(ReadEnum(TxtIdentifiers[seikScheduleMonthlyIndexType], TypeInfo(TScheduleIndexKind)));
end;
procedure TTxtStore.RestoreScheduleMonthlyIndex;
begin
(Event.Schedule as IJclMonthlySchedule).IndexValue := ReadInt(TxtIdentifiers[seikScheduleMonthlyIndex]);
end;
procedure TTxtStore.RestoreScheduleMonthlyInterval;
begin
(Event.Schedule as IJclMonthlySchedule).Interval := ReadInt(TxtIdentifiers[seikScheduleMonthlyInterval]);
end;
procedure TTxtStore.RestoreScheduleYearlyDay;
begin
(Event.Schedule as IJclYearlySchedule).Day := ReadInt(TxtIdentifiers[seikScheduleYearlyDay]);
end;
procedure TTxtStore.RestoreScheduleYearlyMonth;
begin
(Event.Schedule as IJclYearlySchedule).Month := ReadInt(TxtIdentifiers[seikScheduleYearlyMonth]);
end;
procedure TTxtStore.RestoreScheduleYearlyIndexType;
begin
(Event.Schedule as IJclYearlySchedule).IndexKind :=
TScheduleIndexKind(ReadEnum(TxtIdentifiers[seikScheduleYearlyIndexType], TypeInfo(TScheduleIndexKind)));
end;
procedure TTxtStore.RestoreScheduleYearlyIndex;
begin
(Event.Schedule as IJclYearlySchedule).IndexValue := ReadInt(TxtIdentifiers[seikScheduleYearlyIndex]);
end;
procedure TTxtStore.RestoreScheduleYearlyInterval;
begin
(Event.Schedule as IJclYearlySchedule).Interval := ReadInt(TxtIdentifiers[seikScheduleYearlyInterval]);
end;
procedure TTxtStore.StoreSignature;
begin
end;
procedure TTxtStore.StoreVersion;
begin
end;
procedure TTxtStore.StoreScheduleStart;
begin
WriteStamp(TxtIdentifiers[seikScheduleStart], Event.Schedule.StartDate);
end;
procedure TTxtStore.StoreScheduleRecurType;
begin
WriteEnum(TxtIdentifiers[seikScheduleRecurType], Ord(Event.Schedule.RecurringType), TypeInfo(TScheduleRecurringKind));
end;
procedure TTxtStore.StoreScheduleEndType;
begin
WriteEnum(TxtIdentifiers[seikScheduleEndType], Ord(Event.Schedule.EndType), TypeInfo(TScheduleEndKind));
end;
procedure TTxtStore.StoreScheduleEndCount;
begin
WriteInt(TxtIdentifiers[seikScheduleEndCount], Event.Schedule.EndCount);
end;
procedure TTxtStore.StoreScheduleEndDate;
begin
WriteStamp(TxtIdentifiers[seikScheduleEndDate], Event.Schedule.EndDate);
end;
procedure TTxtStore.StoreFreqStart;
begin
WriteStampTime(TxtIdentifiers[seikFreqStart], (Event.Schedule as IJclScheduleDayFrequency).StartTime);
end;
procedure TTxtStore.StoreFreqEnd;
begin
WriteStampTime(TxtIdentifiers[seikFreqEnd], (Event.Schedule as IJclScheduleDayFrequency).EndTime);
end;
procedure TTxtStore.StoreFreqInterval;
begin
WriteStampTime(TxtIdentifiers[seikFreqInterval], (Event.Schedule as IJclScheduleDayFrequency).Interval);
end;
procedure TTxtStore.StoreScheduleDailyWeekdays;
begin
WriteEnum(TxtIdentifiers[seikScheduleDailyWeekdays], Ord((Event.Schedule as IJclDailySchedule).EveryWeekDay),
TypeInfo(Boolean));
end;
procedure TTxtStore.StoreScheduleDailyInterval;
begin
WriteInt(TxtIdentifiers[seikScheduleDailyInterval], (Event.Schedule as IJclDailySchedule).Interval);
end;
procedure TTxtStore.StoreScheduleWeeklyDays;
var
WD: TScheduleWeekDays;
begin
WD := (Event.Schedule as IJclWeeklySchedule).DaysOfWeek;
WriteSet(TxtIdentifiers[seikScheduleWeeklyDays], WD, TypeInfo(TScheduleWeekDays));
end;
procedure TTxtStore.StoreScheduleWeeklyInterval;
begin
WriteInt(TxtIdentifiers[seikScheduleWeeklyInterval], (Event.Schedule as IJclWeeklySchedule).Interval);
end;
procedure TTxtStore.StoreScheduleMonthlyDay;
begin
WriteInt(TxtIdentifiers[seikScheduleMonthlyDay], (Event.Schedule as IJclMonthlySchedule).Day);
end;
procedure TTxtStore.StoreScheduleMonthlyIndexType;
begin
WriteEnum(TxtIdentifiers[seikScheduleMonthlyIndexType], Ord((Event.Schedule as IJclMonthlySchedule).IndexKind),
TypeInfo(TScheduleIndexKind));
end;
procedure TTxtStore.StoreScheduleMonthlyIndex;
begin
WriteInt(TxtIdentifiers[seikScheduleMonthlyIndex], (Event.Schedule as IJclMonthlySchedule).IndexValue);
end;
procedure TTxtStore.StoreScheduleMonthlyInterval;
begin
WriteInt(TxtIdentifiers[seikScheduleMonthlyInterval], (Event.Schedule as IJclMonthlySchedule).Interval);
end;
procedure TTxtStore.StoreScheduleYearlyDay;
begin
WriteInt(TxtIdentifiers[seikScheduleYearlyDay], (Event.Schedule as IJclYearlySchedule).Day);
end;
procedure TTxtStore.StoreScheduleYearlyMonth;
begin
WriteInt(TxtIdentifiers[seikScheduleYearlyMonth], (Event.Schedule as IJclYearlySchedule).Month);
end;
procedure TTxtStore.StoreScheduleYearlyIndexType;
begin
WriteEnum(TxtIdentifiers[seikScheduleYearlyIndexType], Ord((Event.Schedule as IJclYearlySchedule).IndexKind),
TypeInfo(TScheduleIndexKind));
end;
procedure TTxtStore.StoreScheduleYearlyIndex;
begin
WriteInt(TxtIdentifiers[seikScheduleYearlyIndex], (Event.Schedule as IJclYearlySchedule).IndexValue);
end;
procedure TTxtStore.StoreScheduleYearlyInterval;
begin
WriteInt(TxtIdentifiers[seikScheduleYearlyInterval], (Event.Schedule as IJclYearlySchedule).Interval);
end;
procedure TTxtStore.BeginStruct(const StructType: TSchedEvtStructKind);
begin
PushStruct(StructType);
case StructType of
seskSchedule:
WriteLn(sTXTID_SchedGeneric);
seskScheduleRecurInfo:
WriteLn(sTXTID_SchedRecur);
seskScheduleEndInfo:
WriteLn(sTXTID_SchedEnd);
seskScheduleDayFreq:
WriteLn(sTXTID_SchedFreq);
seskScheduleDaily:
WriteLn(sTXTID_SchedDaily);
seskScheduleWeekly:
WriteLn(sTXTID_SchedWeekly);
seskScheduleMonthly:
WriteLn(sTXTID_SchedMonthly);
seskScheduleYearly:
WriteLn(sTXTID_SchedYearly);
else
raise EJVCLException.CreateRes(@RsEUnexpectedStructure);
end;
end;
procedure TTxtStore.EndStruct;
begin
PopStruct;
end;
procedure TTxtStore.CheckBeginStruct(const StructType: TSchedEvtStructKind);
var
S: string;
begin
PushStruct(StructType);
S := ReadNextLine;
case StructType of
seskSchedule:
if not AnsiSameText(S, sTXTID_SchedGeneric) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleRecurInfo:
if not AnsiSameText(S, sTXTID_SchedRecur) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleEndInfo:
if not AnsiSameText(S, sTXTID_SchedEnd) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleDayFreq:
if not AnsiSameText(S, sTXTID_SchedFreq) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleDaily:
if not AnsiSameText(S, sTXTID_SchedDaily) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleWeekly:
if not AnsiSameText(S, sTXTID_SchedWeekly) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleMonthly:
if not AnsiSameText(S, sTXTID_SchedMonthly) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
seskScheduleYearly:
if not AnsiSameText(S, sTXTID_SchedYearly) then
raise EJVCLException.CreateRes(@RsEIncorrectStructure);
else
raise EJVCLException.CreateRes(@RsEUnexpectedStructure);
end;
end;
procedure TTxtStore.CheckEndStruct;
begin
PopStruct;
end;
function TTxtStore.ReadLn: string;
var
OrgPos: Integer;
SIdx: Integer;
Done: Boolean;
begin
OrgPos := FStream.Position;
Result := '';
SIdx := 0;
repeat
Inc(SIdx);
SetLength(Result, Length(Result) + 255);
SetLength(Result, SIdx + FStream.Read(Result[SIdx], 255));
Done := SIdx = Length(Result);
if not Done then
begin
while (SIdx < Length(Result)) and (Copy(Result, SIdx, Length(sLineBreak)) <> sLineBreak) do
Inc(SIdx);
Done := Copy(Result, SIdx, Length(sLineBreak)) = sLineBreak;
if Done then
SetLength(Result, SIdx + 1);
end;
until Done;
FStream.Position := OrgPos + Length(Result);
if Copy(Result, Length(Result) - 1, Length(sLineBreak)) = sLineBreak then
SetLength(Result, Length(Result) - Length(sLineBreak));
end;
function TTxtStore.ReadNextLine: string;
begin
repeat
Result := ReadLn;
until (Trim(Result) <> '') or (FStream.Position = FStream.Size);
Result := Trim(Result);
end;
function TTxtStore.ReadItem(out AName: string): string;
var
I: Integer;
begin
AName := '';
Result := ReadNextLine;
if Result <> '' then
begin
I := Pos('=', Result);
if I > 0 then
begin
AName := Trim(Copy(Result, 1, I - 1));
Result := Trim(Copy(Result, I + 1, Length(Result) - I));
end;
end;
end;
procedure TTxtStore.WriteLn(const S: string);
var
S2: string;
begin
S2 := S + sLineBreak;
FStream.WriteBuffer(S2[1], Length(S2));
end;
function TTxtStore.ReadEnum(const AName: string; TypeInfo: PTypeInfo): Integer;
var
ItemName: string;
Value: string;
begin
Value := ReadItem(ItemName);
if not AnsiSameText(AName, ItemName) then
raise EJVCLException.CreateRes(@RsEIncorrectIdentifierFound);
Result := GetEnumValue(TypeInfo, Value);
end;
function TTxtStore.ReadInt(const AName: string): Int64;
var
ItemName: string;
Value: string;
begin
Value := ReadItem(ItemName);
if not AnsiSameText(AName, ItemName) then
raise EJVCLException.CreateRes(@RsEIncorrectIdentifierFound);
Result := StrToInt64(Value);
end;
procedure TTxtStore.ReadSet(const AName: string; out Value; TypeInfo: PTypeInfo);
var
ItemName: string;
StrValue: string;
begin
StrValue := ReadItem(ItemName);
if not AnsiSameText(AName, ItemName) then
raise EJVCLException.CreateRes(@RsEIncorrectIdentifierFound);
JclStrToSet(TypeInfo, Value, StrValue);
end;
function TTxtStore.ReadStamp(const AName: string): TTimeStamp;
begin
Result.Date := ReadStampDate(AName + '.Date');
Result.Time := ReadStampTime(AName + '.Time');
end;
function TTxtStore.ReadStampDate(const AName: string): Integer;
var
ItemName: string;
Value: string;
Y: Word;
M: Word;
D: Word;
begin
Value := ReadItem(ItemName);
if not AnsiSameText(AName, ItemName) then
raise EJVCLException.CreateRes(@RsEIncorrectIdentifierFound);
Y := StrToInt(Copy(Value, 1, 4));
M := StrToInt(Copy(Value, 6, 2));
D := StrToInt(Copy(Value, 9, 2));
Result := DateTimeToTimeStamp(EncodeDate(Y, M, D)).Date;
end;
function TTxtStore.ReadStampTime(const AName: string): Integer;
var
ItemName: string;
Value: string;
H: Word;
Min: Word;
MSecs: Integer;
begin
Value := ReadItem(ItemName);
if not AnsiSameText(AName, ItemName) then
raise EJVCLException.CreateRes(@RsEIncorrectIdentifierFound);
if (Length(Value) < 3) or (Value[3] in DigitChars) then
Result := StrToInt(Value)
else
begin
H := StrToInt(Copy(Value, 1, 2));
Min := StrToInt(Copy(Value, 4, 2));
MSecs := StrToInt(Copy(Value, 7, 2)) * 1000 + StrToInt(Copy(Value, 10, 3));
Result := H * 3600000 + Min * 60000 + MSecs;
end;
end;
procedure TTxtStore.WriteEnum(const AName: string; const Ordinal: Integer; TypeInfo: PTypeInfo);
begin
WriteLn(AName + ' = ' + GetEnumName(TypeInfo, Ordinal));
end;
procedure TTxtStore.WriteInt(const AName: string; const Value: Int64);
begin
WriteLn(AName + ' = ' + IntToStr(Value));
end;
procedure TTxtStore.WriteSet(const AName: string; const Value; TypeInfo: PTypeInfo);
begin
WriteLn(AName + ' = ' + JclSetToStr(TypeInfo, Value));
end;
procedure TTxtStore.WriteStamp(const AName: string; const Stamp: TTimeStamp);
begin
WriteStampDate(AName + '.Date', Stamp.Date);
WriteStampTime(AName + '.Time', Stamp.Time);
end;
procedure TTxtStore.WriteStampDate(const AName: string; const Date: Integer);
var
TmpStamp: TTimeStamp;
TmpDate: TDateTime;
Y: Word;
M: Word;
D: Word;
begin
TmpStamp.Date := Date;
TmpStamp.Time := 0;
TmpDate := TimeStampToDateTime(TmpStamp);
DecodeDate(TmpDate, Y, M, D);
WriteLn(AName + ' = ' + Format('%.4d/%.2d/%.2d', [Y, M, D]));
end;
procedure TTxtStore.WriteStampTime(const AName: string; const Time: Integer);
begin
WriteLn(AName + ' = ' + Format(
'%.2d:%.2d:%.2d.%.3d',
[(Time div 3600000) mod 24,
(Time div 60000) mod 60,
(Time div 1000) mod 60,
Time mod 1000]));
end;
function TTxtStore.GetAttributes: TSchedEvtStoreAttributes;
begin
Result := [sesaStructured, sesaIdentifiers];
end;
{ schedule persistency factories }
function ScheduledEventStore_Stream(const Stream: TStream;
const Binary, OwnsStream: Boolean): IJvScheduledEventsStore;
begin
if Binary then
Result := TBinStore.Create(Stream, OwnsStream)
else
Result := TTxtStore.Create(Stream, OwnsStream);
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.
Reference in New Issue View Git Blame Copy Permalink