PROGRAM RELATIVDATEI(INPUT,OUTPUT);               
(*BEISPIEL EINER RELATIVEN DATEI MIT PUT UND GET*)
(*WEGEN EINES BETRIEBSSYSTEMFEHLERS MUSS JEDER  *)
(*SATZ ZWEIMAL GELESEN WERDEN! (21.3.1987)      *)
                                                  
CONST RSIZE=6;  (*LAENGE VON TRECORD IN BYTES   *)
      DEVICE=8; (*GERAETEADRESSE DISKETTE       *)
      SEKOND=2; (*SEKUNDAERADRESSE DER DATEI    *)
                                                  
TYPE TRECORD=RECORD                               
              A,B:INTEGER;                        
              MARKE:CHAR;  (* WIRD MIT CHR(13)  *)
             END;          (* BEENDET           *)
                                                  
VAR REL   :FILE OF TRECORD;(* RELATIVE DATEI    *)
    DSK   :TEXT;           (* KOMMANDO-KANAL    *)
    NUMMER:INTEGER;                               
    WAHL  :CHAR;                                  
                                                  
 PROCEDURE DSTATUS;                               
 (*FEHLERKANAL DISKETTE AUSLESEN, FEHLER IM     *)
 (*KLARTEXT ANZEIGEN:                           *)
   VAR C1,C2:CHAR;                                
 BEGIN                                            
  READ(DSK,C1,C2);                                
  IF C1>"1" THEN                                  
    BEGIN                                         
      REPEAT                                      
        READ(DSK,C1); WRITE(C1)                   
      UNTIL EOLN(DSK);                            
      WRITELN                                     
    END;                                          
 END; (* DSTATUS *)                               
                                                  
 PROCEDURE SETRECORD (RNUM: INTEGER);             
 (*RNUM 0..MAXINT. RELATIVE RECORDNUMMER SENDEN *)
 (*POSITIONIERT ALSO ZEIGER AUF DIE KOMPONENTE  *)
 (*MIT DER NUMMER RNUM.                         *)
 BEGIN                                            
   WRITE(DSK,"P",     (*BEFEHL: POINTER SETZEN  *)
    CHR(SEKOND),      (*IN DIESER DATEI         *)
    CHR(RNUM AND 255),(*AUF DIESEN RECORD       *)
    CHR(RNUM DIV 256),(* (LOW UND HIGH-BYTE)    *)
    CHR(1));          (*AUF DAS ERSTE BYTE IN   *)
                      (* DER KOMPONENTE TRECORD *)
 END;(* SETRECORD *)                              
                                                  
 PROCEDURE INITREL;                               
 (*RELATIVE DATEI INITIALISIEREN. FALLS DER     *)
 (*"SCRATCH"-BEFEHL (IM KOMMENTAR) EINGEFUEGT   *)
 (*WIRD, WIRD EINE EVTL. BESTEHENDE DATEI MIT   *)
 (*GLEICHEM NAMEN GELOESCHT.                    *)
   CONST LEN=16;                                  
   VAR DNAME: ARRAY[1..LEN]OF CHAR;               
       C: CHAR; I: INTEGER;                       
 BEGIN                                            
  WRITELN("EINGABE DATEINAME");                   
  WRITE  ("==>");I:=1;                            
  REPEAT                                          
   READ(DNAME[I]);I:=I+1                          
  UNTIL EOLN OR(I=LEN-3);WRITELN;                 
  DNAME[I-1]:=","; DNAME[I  ]:="L";               
  DNAME[I+1]:=","; DNAME[I+2]:=CHR(RSIZE);        
  OPEN(DSK,DEVICE,15,"I0");                       
  (* WRITELN(DSK,"S0:",DNAME); DSTATUS;         *)
  OPEN(REL,DEVICE,SEKOND,DNAME);                  
  DSTATUS;                                        
 END; (* INITREL *)                               
                                                  
 PROCEDURE READRECORD(RNUM:INTEGER);              
 BEGIN                                            
  WRITELN;                                        
  WRITELN("LESEN SATZ:",RNUM);                    
  WRITELN;                                        
  SETRECORD(RNUM);GET(REL);  (* UND NOCHEINMAL: *)
  SETRECORD(RNUM);GET(REL);DSTATUS;               
  WITH REL^ DO                                    
   BEGIN                                          
    WRITELN("A :",A);                             
    WRITELN("B :",B)                              
   END                                            
 END; (* READRECORD *)                            
                                                  
 PROCEDURE WRITERECORD(RNUM:INTEGER);             
 BEGIN                                            
  WRITELN;                                        
  WRITELN("SCHREIBE SATZ:",RNUM);                 
  WRITELN;                                        
  WITH REL^ DO                                    
   BEGIN                                          
    WRITE("A :");READLN(A);                       
    WRITE("B :");READLN(B);                       
   END;                                           
  SETRECORD(RNUM);PUT(REL);DSTATUS                
 END;                                             
                                                  
BEGIN                                             
 REL^.MARKE:=CHR(13);                             
 (*TRECORD MUSS UM EINE MARKE AM SATZENDE ER-   *)
 (*WEITERT WERDEN, DAMIT DAS BETRIEBSSYSTEM DER *)
 (*FLOPPY DEN SATZ KORREKT EINLIEST.            *)
 WRITELN("“DATEI-DEMO:");                         
 WRITELN("···········");                          
 WRITELN;                                         
 WRITELN("ES WIRD EINE RELATIVDATEI EROEFFNET:"); 
 WRITELN;                                         
 INITREL;                                         
 WRITELN("JETZT KOENNEN DIE  SAETZE DURCH");      
 WRITELN("EINGABE DER SATZNUMMER (#)");           
 WRITELN("BEARBEITET WERDEN:");                   
 REPEAT                                           
  WRITELN("WAEHLEN SIE:");                       
  WRITELN("X   BEENDEEN");                        
  WRITELN("R # LESEN   ");                        
  WRITELN("W # SCHREIBEN");                       
  WRITE("==>");READ(WAHL);                        
  CASE WAHL OF                                    
  "X":;                                           
  "R":BEGIN READLN(NUMMER);READRECORD(NUMMER) END;
  "W":BEGIN READLN(NUMMER);WRITERECORD(NUMMER) END
   ELSE WRITELN("  UNGUELTIGE WAHL!")             
  END;(*CASE*)                                    
  WRITELN                                         
 UNTIL WAHL="X";                                  
 CLOSE(REL);CLOSE(DSK)                            
END.