[Back to RECORDS SWAG index]  [Back to Main SWAG index]  [Original]

(* Program to demonstrate BlockRead and BlockWrite    *)
(* routines.                                          *)
Program BlockReadWriteDemo;
Uses
  Crt;
Type
  st20 = String[20];
  st40 = String[40];
  st80 = String[80];

  rcPersonInfo = Record
                   stFirst : st20;
                   stLast  : st20;
                   byAge   : Byte
                 end;
Const
  coRecSize = sizeof(rcPersonInfo);

Var
  wototalRecs : Word;
  rcTemp      : rcPersonInfo;
  fiData      : File;

  (***** Initialize Program Variables.                              *)
  Procedure Init;
  begin
    ClrScr;
    wototalRecs := 0;
    fillChar(rcTemp, coRecSize, 0);
    fillChar(fiData, sizeof(fiData), 0)
  end;        (* Init.                                              *)

  (***** Handle Program errors.                                     *)
  Procedure ErrorHandler(byErrorNumber : Byte; boHalt : Boolean);
  begin
    Case byErrorNumber of
      1 : Writeln('Error creating new data-File.');
      2 : Writeln('Error writing Record to data-File.');
      3 : Writeln('Record does not exist.');
      4 : Writeln('Error reading Record from data-File.');
      5 : Writeln('Error erasing Record in data-File.')
    end;      (* Case byErrorNumber of                              *)
    if boHalt then
      halt(byErrorNumber)
  end;        (* ErrorHandler.                                      *)

  (***** Create new data-File to hold Record data.                  *)
  Function CreateDataFile(Var fiData : File) : Boolean;
  begin
    {$I-}
    reWrite(fiData, 1);
    {$I+}
    if (ioresult = 0) then
      CreateDataFile := True
    else
      CreateDataFile := False
  end;        (* CreateDataFile.                                    *)

  (***** Open data-File.                                            *)
  Procedure OpenDataFile(Var fiData : File; stFileName : st80);
  begin
    assign(fiData, stFileName);
    {$I-}
    reset(fiData, 1);
    {$I+}
    if (ioresult <> 0) then
      begin
        if (CreateDataFile(fiData) = False) then
          ErrorHandler(1, True)
        else
          Writeln('New data-File ', stFileName, ' created.')
      end
    else
      Writeln('Data-File ', stFileName, ' opened.');
    wototalRecs := Filesize(fiData) div coRecSize
  end;        (* OpenDataFile.                                      *)

  (***** Add a Record to the data-File.                             *)
  Procedure AddRecord(woRecNum : Word; Var rcTemp : rcPersonInfo);
  Var
    woBytesWritten : Word;
  begin
    if (woRecNum > succ(wototalRecs)) then
      woRecNum := succ(wototalRecs);
    seek(fiData, (pred(woRecNum) * coRecSize));
    blockWrite(fiData, rcTemp, coRecSize, woBytesWritten);
    if (woBytesWritten = coRecSize) then
      inc(wototalRecs)
    else
      ErrorHandler(2, True)
  end;        (* AddRecord.                                         *)


(***  PART 2     *****)

  (***** Get a Record from the data-File.                           *)
  Procedure GetRecord(woRecNum : Word; Var rcTemp : rcPersonInfo);
  Var
    woBytesRead : Word;
  begin
    if (woRecNum > wototalRecs)
    or (woRecNum < 1) then
      begin
        ErrorHandler(3, False);
        Exit
      end;
    seek(fiData, (pred(woRecNum) * coRecSize));
    blockread(fiData, rcTemp, coRecSize, woBytesRead);
    if (woBytesRead <> coRecSize) then
      ErrorHandler(4, True)
  end;        (* GetRecord.                                         *)

  (***** Erase the contents of a data-File Record.                  *)
  Procedure EraseRecord(woRecNum : Word);
  Var
    woBytesWritten : Word;
    rcEmpty        : rcPersonInfo;
  begin
    if (woRecNum > wototalRecs)
    or (woRecNum < 1) then
      begin
        ErrorHandler(3, False);
        Exit
      end;
    fillChar(rcEmpty, coRecSize, 0);
    seek(fiData, (pred(woRecNum) * coRecSize));
    blockWrite(fiData, rcEmpty, coRecSize, woBytesWritten);
    if (woBytesWritten <> coRecSize) then
      ErrorHandler(5, True)
  end;        (* EraseRecord.                                       *)

  (***** Display a Record's fields.                                 *)
  Procedure DisplayRecord(Var rcTemp : rcPersonInfo);
  begin
    With rcTemp do
      begin
        Writeln;
        Writeln(' Firstname = ', stFirst);
        Writeln(' Lastname  = ', stLast);
        Writeln(' Age       = ', byAge);
        Writeln
      end
  end;        (* DisplayRecord.                                     *)

  (***** Enter data into a Record.                                  *)
  Procedure EnterRecData(Var rcTemp : rcPersonInfo);
  begin
    Writeln;
    With rcTemp do
      begin
        Write('Enter First-name : ');
        readln(stFirst);
        Write('Enter Last-name  : ');
        readln(stLast);
        Write('Enter Age        : ');
        readln(byAge)
      end;
    Writeln
  end;        (* EnterRecData.                                      *)

  (***** Obtain user response to Yes/No question.                   *)
  Function YesNo(stMessage : st40) : Boolean;
  Var
    chTemp : Char;
  begin
    Writeln;
    Write(stMessage, ' (Y/N) [ ]', #8#8);
    While KeyPressed do
      chTemp := ReadKey;
    Repeat
      chTemp := upCase(ReadKey)
    Until (chTemp in ['Y','N']);
    Writeln(chTemp);
    if (chTemp = 'Y') then
      YesNo := True
    else
      YesNo := False
  end;        (* YesNo.                                             *)

  (***** Compact data-File by removing empty Records.               *)
  Procedure PackDataFile(Var fiData : File);
  begin
    (* This one I'm leaving For you to Complete.                    *)
  end;        (* PackDataFile.                                      *)

(***** PART 3   *****)
              (* Main Program execution block.                      *)
begin
  Init;
  OpenDataFile(fiData, 'TEST.DAT');
  rcTemp.stFirst := 'Bill';
  rcTemp.stLast  := 'Gates';
  rcTemp.byAge   := 36;
  DisplayRecord(rcTemp);
  AddRecord(1, rcTemp);
  rcTemp.stFirst := 'Phillipe';
  rcTemp.stLast  := 'Khan ';
  rcTemp.byAge   := 39;
  DisplayRecord(rcTemp);
  AddRecord(2, rcTemp);
  GetRecord(1, rcTemp);
  DisplayRecord(rcTemp);
  EraseRecord(1);
  GetRecord(1, rcTemp);
  DisplayRecord(rcTemp);
  EnterRecData(rcTemp);
  AddRecord(1, rcTemp);
  DisplayRecord(rcTemp);
  close(fiData);
  if YesNo('Erase the Record data-File ?') then
    erase(fiData)
end.

[Back to RECORDS SWAG index]  [Back to Main SWAG index]  [Original]