home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol019 / rt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.3 KB  |  147 lines
  1. PROGRAM RT;
  2. (**
  3.  **  PROGRAM TITLE:    Random Files IO
  4.  **
  5.  **  WRITTEN BY:    Raymond E. Penley
  6.  **  DATE WRITTEN:    11 June 1980
  7.  **
  8.  **  WRITTEN FOR:    Users of Pascal/Z
  9.  **)
  10. LABEL    99;    {place to go when all done}
  11. CONST
  12.     terminal = '/EOF/EOF/EOF/EOF/EOF';
  13.     ID     = 'RAND.TST';
  14. TYPE
  15.   Custype = record
  16.        name : STRING 20;
  17.        next : ^cust
  18.          end;
  19.  
  20.   STR255 = STRING 255;
  21.   Storetype = file of custype;
  22.  
  23. VAR
  24.     count,        (* Record counter *)
  25.     IX,
  26.     Rcd : INTEGER;
  27.     CTRLE,        (* My End_of_file flag on INPUT *)
  28.     CTRLZ : CHAR;    (* CP/M eof of file marker *)
  29.     XEOF,        (* User supplied EndOfFile flag *)
  30.     EOFS,        (* Flag for CP/M eof marker *)
  31.     done : BOOLEAN;
  32.     Customer : custype;
  33.     Store : Storetype;
  34.  
  35.  
  36. FUNCTION INDEX(X,Y: STR255): INTEGER; EXTERNAL;
  37.  
  38. Procedure SCROLL;
  39. VAR    ix : 1..25;
  40.     jx : INTEGER;
  41. begin
  42.   For ix:=1 to 25 do
  43.     begin
  44.     writeln;
  45.     For jx:=1 to 600 do {dummy};
  46.      end;
  47. end;
  48.  
  49. Procedure CLEAR;
  50. VAR    ix : 1..25;
  51. begin
  52.   For ix:=1 to 25 do Writeln;
  53. end;
  54.  
  55. Procedure PAUSE;
  56. VAR    cix : char;
  57. begin
  58.   write('Type return to continue  ');READLN(cix);
  59. end;
  60.  
  61. FUNCTION SIZE(VAR fx : Storetype): INTEGER;
  62. VAR    ix : integer;
  63. begin
  64.   RESET(ID,fx);
  65.     ix := 1;
  66.     READ(fx,Customer);
  67.     XEOF := INDEX(Customer.NAME,'/EOF/') <> 0;
  68.     While NOT XEOF do
  69.       begin
  70.     ix := ix + 1;
  71.     READ(fx,Customer);
  72.     XEOF := INDEX(Customer.NAME,'/EOF/') <> 0;
  73.       end;
  74.   SIZE := ix - 1;
  75. end{---of SIZE---};
  76.  
  77. (*$P+    [turn on symbolic output]*)
  78. BEGIN
  79.   CLEAR;
  80.   CTRLZ := CHR(26);
  81.   Customer.name := '--------------------';
  82.   Customer.next := nil;
  83.  
  84.   writeln(' ':15, 'PASCAL/Z FILE I/O Demo');
  85.   writeln(' ':15, 'File I/O on a NON Text file');
  86.   writeln;writeln;
  87.  
  88.   writeln(' ':15,'Creating file "RAND.TST"');
  89.   {
  90.     File RAND.TST will be created sequentially but
  91.     may be accessed either randomly or sequentially
  92.   }
  93.   REWRITE(ID,Store);
  94.   FOR IX:=1 TO 20 DO
  95.     begin
  96.     Customer.NAME[ix] := CHR(ix+64);
  97.     WRITE(Store,Customer);
  98.     Writeln;(*---simple scroll here---*)
  99.     end;
  100.   {---NOW mark the End_Of_File---};
  101.   Customer.name := terminal;
  102.   WRITE(Store,Customer);
  103.  
  104.   WRITELN;
  105.   WRITELN(' ':15,'---TEST ONE - SEQUENTIAL READING---');
  106.   count := SIZE(Store);
  107.   RESET(ID,Store);
  108.   WRITELN('INITIALLY AFTER A RESET EOF(Store) = ', EOF(Store) );
  109.   for ix:=1 to 5000 do {dummy};
  110.     For ix := 1 to count do
  111.       begin
  112.     READ(Store,Customer);
  113.     XEOF := INDEX(Customer.NAME,'/EOF/') <> 0;
  114.     EOFS := (Customer.NAME[1]=CTRLZ);
  115.     writeln;
  116.     IF NOT EOFS THEN WRITELN( ix:3, ': ', Customer.NAME);
  117.     writeln(' ':5,'XEOF = ', XEOF, ' ':5,'EOFS = ', EOFS );
  118.       End;
  119.   PAUSE;
  120.   SCROLL;
  121.  
  122.   WRITELN(' ':15,'---TEST TWO - RANDOM READING---');
  123.   WRITELN;writeln;
  124.   writeln('Enter <-1> to quit');
  125.   RESET(ID,Store);
  126.     DONE := FALSE;
  127.     REPEAT
  128.     WRITELN;
  129.     WRITE('Enter RECORD to be DISPLAYED  ');READ(Rcd);
  130.     If Rcd=(-1) then
  131.       begin  Done:=true;goto{exit}99 end;
  132.     If Rcd<=count then
  133.       begin
  134.         READ(Store:Rcd, Customer);
  135.         XEOF := INDEX(Customer.NAME,'/EOF/') <> 0;
  136.         EOFS := (Customer.NAME[1]=CTRLZ);
  137.         WRITELN;
  138.         IF NOT EOFS THEN WRITELN( Rcd:3, ': ', Customer.NAME);
  139.         writeln(' ':5,'XEOF = ', XEOF, ' ':5,'EOFS = ', EOFS );
  140.        end
  141.     Else
  142.       Writeln('Read Beyond End Of File');
  143.     99:{exit here when done}
  144.     UNTIL DONE;
  145.   CLEAR;{always be neat and clear the screen of your garbage}
  146. End{of Program RT}.
  147.