jvqschedevtstore.pas

East make Tray Icon in delphi

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;

end.