{*****************************************************************************
 *
 *  PMToDoDB
 *
 *      Record Classes
 *
 *  Copyright (c) 2002 Arthur Hoogervorst
 *
 *  Author:     Arthur Hoogervorst
 *  E-mail:     ahooger@istar.ca
 *  Homepage:   http://roundabout.sourceforge.net
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *  2002-08-14  1.0    Initial Release of ToDO Record classes
 *              1.1    Delete always marks 'record + 1', changed to index -1.
 *  2002-08-16  1.2    Cleaning out, plus additional members for the records
 *                     added. Additional Header record included, including
 *                     passphrase for future processing...
 *****************************************************************************}

unit pmToDo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, controls, inifiles,
  comctrls, Dialogs;

const
  TODOVERSION = 1020;
  TODOSTRING = 'RBTDA';
  siPriority = 0;
  siDescription = 1;
  siStartDate = 2;
  siDueDate = 3;
  siEndDate = 4;
  siCategory = 5;
  siNotes = 6;
  siRecordNumber = 7;
  // For Read/Write fields...
  tdAdd = -1;
  tdCopy = -2;
  tdMove = -4;

type


  TVersionString = String[5];
  TPassPhrase = string[10];
  TNotesString = array[0..1023] of char;

  // Header record.
  TToDoHeader = packed record
    Number : word;
    VersionString : TVersionString;
    Passphrase : TPassPhrase;
    Deleted : longint;
  end;

  TToDoItem = packed record
    Deleted : boolean;
    Priority : byte;
    Description : shortstring;
    Keyword : string[32];
    StartDate, DueDate, EndDate : TDateTime;
    Notes : TNotesString;
  end;


  TToDoFile = class(TFileStream)
  private
    fToDOHeader : TToDoHeader;
    fNumRecords : LongInt;
    fFileName : string;
    fVersionNum : word;
    fVersionStr : TVersionString;
    fDelRecords : LongInt;
    fPassphrase : TPassPhrase;
    fHeaderChanged : Boolean;
    procedure GetHeader;
    procedure SetHeader;
    function NumberRecords : LongInt;
    function GetToDo(Index : LongInt) : TToDoItem;
    procedure SetToDo(Index : LongInt; Data : TToDoItem);
    function GetCurrentRec : LongInt;
    procedure SetCurrentRec(index : LongInt);
  public
    constructor Create(const FileName: string; Mode: Word);
    destructor Destroy; override;
    function Add(const a : TToDoItem) : LongInt;
    function Delete(index : LongInt) : Boolean;
    property Header : TToDoHeader read fToDoHeader;
    property DeletedCount : LongInt read fDelRecords;
    property Version : word read fVersionNum;
    property VersionString : TVersionString read fVersionStr;
    property PassPhrase : TPassPhrase read fPassPhrase;

    property FileName : string read fFileName;
    property CurrentRecord : LongInt read GetCurrentRec write SetCurrentRec;
    property ToDoItem[index : longint] : TToDoItem read GetToDo write SetToDo;
    property Count : LongInt read fNumRecords;
  end;

  function GetCategories(dir : string) : string;
  procedure NewCategory(dir : string);

implementation

uses PXStuff;

procedure NewCategory(dir : string);
var s : string;
    t : TToDoFile;
begin
  s := GetMessageString(151);
  if InputQuery(sAppTitle, GetMessageString(157), s) then
  begin
    if (s <> '')  then
    begin
      // Just create the headers....
      t := TToDoFile.Create(dir + s + '.ptd', fmCreate);
      t.Free;
    end;
  end
end;

function GetCategories(dir : string) : string;
var
  SearchRec: TSearchRec;
  Found : Integer;
  s : string;
  t : TToDoFile;
begin
  Found := FindFirst(dir + '*.ptd', faAnyFile, SearchRec);
  while Found = 0 do
  begin
    s := SearchRec.Name;
    // Test...
    t := TToDoFile.Create(dir + s, fmOpenRead);

    if t.Version = TODOVERSION then
    begin
      Delete(s, Length(s) - 3, 4);
      Result := result + s + #13#10;
    end;
    t.Free;
    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TToDoFile.GetHeader;
begin
  // ToDo add better check
  Seek(0,0);
  Read(fToDoHeader, SizeOf(TToDOHeader));
  fVersionNum := fToDoHeader.Number;
  fVersionStr := fToDoHeader.VersionString;
  fPassPhrase := fToDoHeader.Passphrase;
  fDelRecords := fToDoHeader.Deleted;
end;

procedure TToDoFile.SetHeader;
begin
  fToDoHeader.Number := TODOVERSION;
  fToDoHeader.VersionString := TODOString;
  fToDoHeader.Deleted := fDelRecords;

  fVersionNum := fToDoHeader.Number;
  fVersionStr := fToDoHeader.VersionString;
  fPassPhrase := fToDoHeader.Passphrase;
  fDelRecords := fToDoHeader.Deleted;
  Seek(0,0);
  write(fToDoHeader, SizeOf(TToDOHeader));
  fHeaderChanged := False;
end;

function TToDoFile.NumberRecords : LongInt;
begin
  Result := (Size - SizeOf(TToDoHeader))
  div SizeOf(TToDoItem);
end;

function TToDoFile.GetCurrentRec : LongInt;
begin
  // Skip beyond header...
  Result := (Position - SizeOf(TToDoHeader) -1)
  div SizeOf(TToDoItem);
end;

procedure TToDoFile.SetCurrentRec(index : LongInt);
begin
 if (index > 0) and (index <= fNumRecords) then
   Position := (index -1) * SizeOf(TToDoItem) +
    SizeOf(TToDoHeader); // was index - 1
end;

function TToDoFile.GetToDo(Index : LongInt) : TToDoItem;
begin
  // ToDo : add better check...
  if (index > 0) and (index <= fNumRecords) then
  begin
    Seek(SizeOf(TToDoHeader) + ((index -1) * SizeOf(TToDoItem)),
      soFromBeginning);
    Read(result, SizeOf(TToDoItem));
  end;
end;

procedure TToDoFile.SetToDo(Index : LongInt; Data : TToDoItem);
begin
  if (index > 0) and (index <= fNumRecords) then
  begin
    Seek(SizeOf(TToDoHeader) + ((index - 1) * SizeOf(TToDoItem)),
      soFromBeginning);
    Write(Data, SizeOf(TToDoItem));
  end;
end;

function TToDoFile.Add(const a : TToDoItem) : LongInt;
var x : LongInt;
    t : TToDoItem;
begin
  result := 0;
  if fDelRecords > 0 then
  begin
    for x := 1 to fNumRecords do
    begin
       t := GetToDo(x);
       if t.Deleted then
       begin
         Seek(-SizeOf(TToDoItem), soFromCurrent);
         Result := Write(a, SizeOf(TToDoItem));
         dec(fDelRecords);
         fHeaderChanged := True;
         break;
       end;
    end;
  end
  else
  begin
    Seek(0, 2); // End...
    result :=  Write(a, SizeOf(TToDOItem));
  end;
  fNumRecords := NumberRecords;
end;

function TTODoFIle.Delete(index : LongInt) : Boolean;
var r : TToDoItem;
begin
  Result := False;
  if (index > 0) and (index <= fNumRecords) then
  begin
    Seek(SizeOf(TToDoHeader) + ((Index  - 1) *
      SizeOf(TToDoItem)),  soFromBeginning); // AH01
    Read(r, SizeOf(TToDoItem));
    R.Deleted := True;
    Seek(-SizeOf(TToDoItem), soFromCurrent);
    Write(r, SizeOf(TToDoItem));
    inc(fDelrecords);
    fHeaderChanged := True;
    fNumRecords := NumberRecords;
  end;
end;

constructor TToDoFile.Create(const FileName: string; Mode: Word);
begin
  inherited Create(Filename, Mode);
  fFileName := FileName;
  fHeaderChanged := false;
  if ((fmOpenRead and Mode) = fmOpenRead) or
     ((fmOpenReadWrite and Mode) = fmOpenReadWrite) then
  begin
    GetHeader;
    if fToDoHeader.Number = ToDoVersion then
      fNumRecords := NumberRecords;
  end;

  if ((fmCreate and Mode) = fmCreate) then
  begin
    fDelRecords := 0;
    fPassPhrase := '';
    SetHeader;
    fNumRecords := NumberRecords;
  end;
end;

destructor TToDoFile.Destroy;
begin
  // Flush Header
  if fHeaderChanged then
    SetHeader;
  inherited Destroy;
end;

end.
