PROGRAM DISKSORT(INPUT,OUTPUT);                   
(* FORMATIERTER AUSDRUCK DES DISKINHALTES       *)
(* 12.10.1986 FLORIAN MATTHES   PASCAL 2.0      *)
                                                  
CONST MAXP=250;   (* LAENGE DER NAMENSTABELLE  *) 
                                                  
TYPE  FILETYP=(PRG,SEQ,USR,REL);                  
      EINTRAG=RECORD                              
               NAME: STRING[16];                  
               TYP : FILETYP;                     
               BLK : INTEGER;                     
               ID  : ARRAY[0..1] OF CHAR;         
              END;                                
VAR   P      : INTEGER;                           
      WEITER : BOOLEAN;                           
      T      : ARRAY[0..MAXP] OF EINTRAG;         
                                                  
 PROCEDURE READALL;                               
 (* DISKETTEN-DIRECTORY KOMPLETT EINLESEN.      *)
 (* INFORMATIONEN IN T AB INDEX P ABLEGEN. P    *)
 (* WIRD GLOBAL VERAENDERT!                     *)
  VAR A,ID1,ID2: CHAR;                            
      I,N      : INTEGER;                         
      INF      : TEXT;                            
      ENDE     : BOOLEAN;                         
                                                  
   FUNCTION BYTE:INTEGER;                         
   (* ZEICHEN LESEN UND IN BYTE WANDELN         *)
     VAR C:CHAR;                                  
   BEGIN                                          
     READ(INF,C);                                 
     IF EOLN(INF) THEN BYTE:=13                   
                  ELSE BYTE:=ORD(C)               
   END; (* BYTE *)                                
                                                  
   FUNCTION NUMBER:INTEGER;                       
   (* L UND H-BYTE LESEN UND UMWANDELN          *)
   BEGIN                                          
     NUMBER:= BYTE + 256*BYTE                     
   END; (* NUMBER *)                              
                                                  
 BEGIN (* READALL *)                              
  OPEN(INF,8,0,'$0');   (* INHALTSVERZEICHNIS   *)
                        (* VON LAUFWERK 0       *)
  WRITELN; WRITELN;                               
  FOR I:=1 TO 32 DO     (* TITELZEILE AUSWERTEN:*)
   BEGIN READ(INF,A);                             
     IF I IN [9..24] THEN WRITE(A);               
     IF I=27 THEN ID1:=A;                         
     IF I=28 THEN ID2:=A                          
   END;                                           
  WRITELN; ENDE:= FALSE;                          
  WHILE (P<=MAXP) AND NOT ENDE DO                 
  BEGIN                                           
   N:=NUMBER; N:= NUMBER;   (* N=ANZAHL BLOECKE *)
   (* ANFUEHRUNGSZEICHEN ODER'BLOCKS FREE'LESEN *)
   REPEAT                                         
     ENDE:= EOF(INF)                              
   UNTIL (BYTE=34) OR ENDE;                       
   IF NOT ENDE THEN        (* ALLES EINTRAGEN:  *)
    WITH T[P] DO                                  
     BEGIN NAME:=''; READ(INF,A);                 
      WHILE A<>'"' DO                             
        BEGIN NAME:= NAME + A; READ(INF,A) END;   
      REPEAT                                      
        READ(INF,A);       (* EINTRAG TYP:      *)
      UNTIL A IN ['P','S','U','R'];               
      CASE A OF                                   
        'P':TYP:=PRG;                             
        'S':TYP:=SEQ;                             
        'U':TYP:=USR;                             
        'R':TYP:=REL                              
      END; (* CASE *)                             
      REPEAT UNTIL BYTE=0;    (* BIS ZEILENENDE *)
      BLK:=N;                                     
      ID[0]:= ID1; ID[1]:= ID2;                   
      P:= P+1;                                    
     END                                          
  END;                                            
  CLOSE(INF);                                     
 END; (* READALL *)                               
                                                  
 PROCEDURE QUICK(L,R:INTEGER);                    
 (* TABELLE NACH NAMEN AUFSTEIGEND SORTIEREN    *)
  VAR I,J:INTEGER;                                
      X,W:EINTRAG;                                
                                                  
 BEGIN                                            
  IF L<R THEN                                     
   BEGIN                                          
    I:=L; J:=R; X:=T[(L+R)DIV 2];                 
    REPEAT                                        
     WHILE T[I].NAME<X.NAME DO I:=I+1;            
     WHILE X.NAME<T[J].NAME DO J:=J-1;            
     IF I<=J THEN                                 
     BEGIN                                        
      W:=T[I]; T[I]:=T[J]; T[J]:=W;               
      I:=I+1; J:=J-1                              
     END;                                         
    UNTIL I>J;                                    
    QUICK(L,J); QUICK(I,R)                        
   END;                                           
 END; (* QUICK *)                                 
                                                  
 FUNCTION OK:BOOLEAN;                             
   VAR C:CHAR;                                    
 BEGIN                                            
  WRITELN('  (JA ODER NEIN)'); WRITE('==>');      
  REPEAT READLN(C) UNTIL C IN ['J','N'];          
  OK:= C='J'                                      
 END; (* OK *)                                    
                                                  
 PROCEDURE AUSGABE;                               
  VAR J, ZPROSEITE: INTEGER;                      
      PRT         : TEXT;                         
 BEGIN                                            
  WRITELN; WRITELN;                               
  WRITELN('DRUCKER BEREIT?');                     
  IF OK THEN                                      
   BEGIN                                          
    OPEN(PRT,4,0);                                
    WRITE('ZEILEN PRO SEITE: ');READLN(ZPROSEITE);
    FOR J:=0 TO P-1 DO                            
     WITH T[J] DO                                 
      BEGIN                                       
       IF J MOD (ZPROSEITE-2)=0 THEN              
        BEGIN                                     
         WRITE(PRT,'Ý NAME:            Ý TYP ');  
         WRITELN(PRT,'Ý BLK Ý ID Ý');             
         WRITE(PRT,'Ý £££££            Ý £££ ');  
         WRITELN(PRT,'Ý £££ Ý ££ Ý');             
        END;                                      
       WRITE(PRT,'Ý',NAME:17,' Ý');               
       CASE TYP OF                                
        PRG:WRITE(PRT,'PRG':4);                   
        SEQ:WRITE(PRT,'SEQ':4);                   
        USR:WRITE(PRT,'USR':4);                   
        REL:WRITE(PRT,'REL':4)                    
       END;                                       
       WRITELN(PRT,' Ý',BLK:4,' Ý',ID:3,' Ý');    
      END;                                        
     CLOSE(PRT)                                   
    END                                           
 END;(* AUSGABE *)                                
                                                  
BEGIN(* MAIN *)                                   
 P:=0;                          (* TABELLE LEER *)
 WRITELN(CHR(147),'DISK-SORT':24);                
 WRITELN('·········':24);                         
 REPEAT                                           
  WRITELN; WRITELN;                               
  WRITELN('WEITERE DISKETTEN?'); WEITER:=OK;      
  IF WEITER THEN READALL;                         
 UNTIL NOT WEITER;                                
 WRITELN; WRITELN;                                
 WRITELN ('*** BITTE WARTEN ***');                
 QUICK(0,P-1);                                    
 AUSGABE;                                         
END. (* MAIN *)