Управление данными в файле своего формата

{
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
.

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!