Автор: Xavier Pacheco

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit persrec;

interface
uses Classes, dialogs, sysutils;

type

  // Define the record that will hold the person's information.
  TPersonRec = packed record
    FirstName: string[20];
    LastName: string[20];
    MI: string[1];
    BirthDay: TDateTime;
    Age: Integer;
  end;

  // Create a descendant TFileStream which knows about the TPersonRec

  TRecordStream = class(TFileStream)
  private
    function GetNumRecs: Longint;
    function GetCurRec: Longint;
    procedure SetCurRec(RecNo: Longint);
  protected
    function GetRecSize: Longint; virtual;
  public
    function SeekRec(RecNo: Longint; Origin: Word): Longint;
    function WriteRec(const Rec): Longint;
    function AppendRec(const Rec): Longint;
    function ReadRec(var Rec): Longint;
    procedure First;
    procedure Last;
    procedure NextRec;
    procedure PreviousRec;
    // NumRecs shows the number of records in the stream
    property NumRecs: Longint read GetNumRecs;
    // CurRec reflects the current record in the stream
    property CurRec: Longint read GetCurRec write SetCurRec;
  end;

implementation

function TRecordStream.GetRecSize: Longint;
begin
  { This function returns the size of the record that this stream
    knows about (TPersonRec) }
  Result := SizeOf(TPersonRec);
end;

function TRecordStream.GetNumRecs: Longint;
begin
  // This function returns the number of records in the stream
  Result := Size div GetRecSize;
end;

function TRecordStream.GetCurRec: Longint;
begin
  { This function returns the position of the current record. We must
    add one to this value because the file pointer is always at the
    beginning of the record which is not reflected in the equation:
    Position div GetRecSize }
  Result := (Position div GetRecSize) + 1;
end;

procedure TRecordStream.SetCurRec(RecNo: Longint);
begin
  { This procedure sets the position to the record in the stream
    specified by RecNo. }
  if RecNo > 0 then
    Position := (RecNo - 1) * GetRecSize
  else
    raise Exception.Create('Cannot go beyond beginning of file.');
end;

function TRecordStream.SeekRec(RecNo: Longint; Origin: Word): Longint;
begin
  { This function positions the file pointer to a location
    specified by RecNo }

  { NOTE: This method does not contain error handling to determine if this
    operation will exceed beyond the beginning/ending of the streamed
    file }
  Result := Seek(RecNo * GetRecSize, Origin);
end;

function TRecordStream.WriteRec(const Rec): Longint;
begin
  // This function writes the record Rec to the stream
  Result := Write(Rec, GetRecSize);
end;

function TRecordStream.AppendRec(const Rec): Longint;
begin
  // This function writes the record Rec to the stream
  Seek(0, 2);
  Result := Write(Rec, GetRecSize);
end;

function TRecordStream.ReadRec(var Rec): Longint;
begin
  { This function reads the record Rec from the stream and
    positions the pointer back to the beginning of the record }
  Result := Read(Rec, GetRecSize);
  Seek(-GetRecSize, 1);
end;

procedure TRecordStream.First;
begin
  { This function positions the file pointer to the beginning
     of the stream }
  Seek(0, 0);
end;

procedure TRecordStream.Last;
begin
  // This procedure positions the file pointer to the end of the stream
  Seek(0, 2);
  Seek(-GetRecSize, 1);
end;

procedure TRecordStream.NextRec;
begin
  { This procedure positions the file pointer at the next record
    location }

  { Go to the next record as long as it doesn't extend beyond the
    end of the file. }
  if ((Position + GetRecSize) div GetRecSize) = GetNumRecs then
    raise Exception.Create('Cannot read beyond end of file')
  else
    Seek(GetRecSize, 1);
end;

procedure TRecordStream.PreviousRec;
begin
  { This procedure positions the file pointer to the previous record
    in the stream }

    { Call this function as long as we don't extend beyond the
      beginning of the file }
  if (Position - GetRecSize >= 0) then
    Seek(-GetRecSize, 1)
  else
    raise Exception.Create('Cannot read beyond beginning of the  file.');
end;

end.

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Mask, Persrec, ComCtrls;

const
  // Declare the file name as a constant
  FName = 'PERSONS.DAT';

type

  TMainForm = class(TForm)
    edtFirstName: TEdit;
    edtLastName: TEdit;
    edtMI: TEdit;
    meAge: TMaskEdit;
    lblFirstName: TLabel;
    lblLastName: TLabel;
    lblMI: TLabel;
    lblBirthDate: TLabel;
    lblAge: TLabel;
    btnFirst: TButton;
    btnNext: TButton;
    btnPrev: TButton;
    btnLast: TButton;
    btnAppend: TButton;
    btnUpdate: TButton;
    btnClear: TButton;
    lblRecNoCap: TLabel;
    lblRecNo: TLabel;
    lblNumRecsCap: TLabel;
    lblNoRecs: TLabel;
    dtpBirthDay: TDateTimePicker;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnAppendClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure btnFirstClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure btnPrevClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
  public
    PersonRec: TPersonRec;
    RecordStream: TRecordStream;
    procedure ShowCurrentRecord;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  { If the file does not exist, then create it, otherwise, open it for
    both read and write access. This is done by instantiating
    a TRecordStream }
  if FileExists(FName) then
    RecordStream := TRecordStream.Create(FName, fmOpenReadWrite)
  else
    RecordStream := TRecordStream.Create(FName, fmCreate);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  RecordStream.Free; // Free the TRecordStream instance
end;

procedure TMainForm.ShowCurrentRecord;
begin
  // Read the current record.
  RecordStream.ReadRec(PersonRec);
  // Copy the data from the PersonRec to the form's controls
  with PersonRec do
  begin
    edtFirstName.Text := FirstName;
    edtLastName.Text := LastName;
    edtMI.Text := MI;
    dtpBirthDay.Date := BirthDay;
    meAge.Text := IntToStr(Age);
  end;
  // Show the record number and total records on the main form.
  lblRecNo.Caption := IntToStr(RecordStream.CurRec);
  lblNoRecs.Caption := IntToStr(RecordStream.NumRecs);
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  // Display the current record only if one exists.
  if RecordStream.NumRecs <> 0 then
    ShowCurrentRecord;
end;

procedure TMainForm.btnAppendClick(Sender: TObject);
begin
  // Copy the contents of the form controls to the PersonRec record
  with PersonRec do
  begin
    FirstName := edtFirstName.Text;
    LastName := edtLastName.Text;
    MI := edtMI.Text;
    BirthDay := dtpBirthDay.Date;
    Age := StrToInt(meAge.Text);
  end;
  // Write the new record to the stream
  RecordStream.AppendRec(PersonRec);
  // Display the current record.
  ShowCurrentRecord;
end;

procedure TMainForm.btnUpdateClick(Sender: TObject);
begin
  { Copy the contents of the form controls to the PersonRec and write
    it to the stream }
  with PersonRec do
  begin
    FirstName := edtFirstName.Text;
    LastName := edtLastName.Text;
    MI := edtMI.Text;
    BirthDay := dtpBirthDay.Date;
    Age := StrToInt(meAge.Text);
  end;
  RecordStream.WriteRec(PersonRec);
end;

procedure TMainForm.btnFirstClick(Sender: TObject);
begin
  { Go to the first record in the stream and display it as long as
    there are records that exist in the stream }
  if RecordStream.NumRecs <> 0 then
  begin
    RecordStream.First;
    ShowCurrentRecord;
  end;
end;

procedure TMainForm.btnNextClick(Sender: TObject);
begin
  // Go to the next record as long as records exist in the stream
  if RecordStream.NumRecs <> 0 then
  begin
    RecordStream.NextRec;
    ShowCurrentRecord;
  end;
end;

procedure TMainForm.btnLastClick(Sender: TObject);
begin
  { Go to the last record in the stream as long as there are records
    in the stream }
  if RecordStream.NumRecs <> 0 then
  begin
    RecordStream.Last;
    ShowCurrentRecord;
  end;
end;

procedure TMainForm.btnPrevClick(Sender: TObject);
begin
  { Go to the previous record in the stream as long as there are records
    in the stream }
  if RecordStream.NumRecs <> 0 then
  begin
    RecordStream.PreviousRec;
    ShowCurrentRecord;
  end;
end;

procedure TMainForm.btnClearClick(Sender: TObject);
begin
  // Clear all controls on the form
  edtFirstName.Text := '';
  edtLastName.Text := '';
  edtMI.Text := '';
  meAge.Text := '';
end;

end.