home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / pastrans.zip / SAMPLES / FILRECRD.PAS < prev    next >
Pascal/Delphi Source File  |  1990-04-27  |  2KB  |  76 lines
  1. {$c+}
  2. program record_file(fp);
  3. type    node = record
  4.          message1 : packed array [1 : 27] of char;
  5.          index : integer;
  6.          message2 : packed array [1 : 25] of char;
  7.          r_index : real
  8.         end;
  9.     file_record = file of node;
  10. var fp : file_record;
  11.  n_buf : node;
  12.     i  : integer;
  13.  break : boolean;
  14. begin
  15.  rewrite(fp);
  16.  for i := 1 to 3 do
  17.   begin
  18.    with n_buf do
  19.     begin
  20.      message1 := 'This is read from record # ';
  21.      index := i;
  22.      message2 := '; real value of index is ';
  23.      r_index := i
  24.     end;
  25.    write(fp, n_buf)
  26.   end;
  27.  page; writeln;
  28.  writeln('First test; use of file WRITEs and READs:');
  29.  reset(fp);
  30.  i := 1; break := true;
  31.  while break and not eof(fp) do
  32.   if i > 3 then
  33.    begin
  34.     writeln; writeln;
  35.     writeln('File error: index i is ', i : 1);
  36.     break := false
  37.    end
  38.   else
  39.    begin
  40.     read(fp, n_buf);
  41.     with n_buf do
  42.      writeln(message1, index : 1, message2, r_index : 1 : 1, ' .');
  43.     i := succ(i)
  44.    end;
  45.  writeln; writeln;
  46.  writeln('Second test; the system PUTs, then GETs, records:');
  47.  rewrite(fp);
  48.  for i := 1 to 3 do
  49.   begin
  50.    with fp^ do
  51.     begin
  52.      message1 := 'This is read from record # ';
  53.      index := i;
  54.      message2 := '; real value of index is ';
  55.      r_index := i
  56.     end;
  57.    put(fp)
  58.   end;
  59.  reset(fp);
  60.  i := 1; break := true;
  61.  while break and not eof(fp) do
  62.   if i > 3 then
  63.    begin
  64.     writeln; writeln;
  65.     writeln('File error: index i is ', i : 1);
  66.     break := false
  67.    end
  68.   else
  69.    begin
  70.     with fp^ do
  71.      writeln(message1, index : 1, message2, r_index : 1 : 1, ' .');
  72.     get(fp);
  73.     i := succ(i)
  74.    end
  75. end.
  76.