PROCEDURE DIRECTORY;
  VAR
      FNAMES:ARRAY[0..128] OF STRING[20];
     NAM_BUF:ARRAY[0..40] OF BYTE;
    DISK_BUF:ARRAY[0..127] OF CHAR;
     X,FILES:INTEGER;
       REPLY:CHAR;

TYPE ANYSTRING = STRING [255];

PROCEDURE W (MSG:ANYSTRING); BEGIN WRITELN (MSG) END;

PROCEDURE SKIP (LINES:INTEGER); VAR I:INTEGER;
BEGIN FOR I := 1 TO LINES DO WRITELN END; {write 'SKIP (#);'}

PROCEDURE GET_NAME;
VAR
      X,Y:INTEGER;
        S:STRING[20];
BEGIN
CLRSCR;
S:='';
FOR X:=1 TO MEM[$80] DO S:=S+CHR(MEM[$80+X]);
WHILE (LENGTH(S)<>0) AND (S[1]=' ') DO DELETE(S,1,1);
IF (LENGTH(S)>=2) AND (S[2]=':') THEN

BEGIN
NAM_BUF[0]:=ORD(UPCASE(S[1]))-64;
DELETE(S,1,2);
END
ELSE
NAM_BUF[0]:=0;
IF LENGTH(S)=0 THEN S:='*.*';
FOR X:=1 TO 40 DO NAM_BUF[X]:=ORD('?');
Y:=1;
FOR X:=1 TO LENGTH(S) DO

BEGIN
CASE S[X] OF '.':Y:=9;
'*':IF Y>=9 THEN

BEGIN
FOR Y:=9 TO 11 DO NAM_BUF[Y]:=ORD('?');
Y:=9;
END
ELSE

BEGIN
FOR Y:=1 TO 8 DO NAM_BUF[Y]:=ORD('?');
Y:=1;
END;
ELSE BEGIN
NAM_BUF[Y]:=ORD(UPCASE(S[X]));
Y:=Y+1;
END;
END;
END;
END;

PROCEDURE GET_CAT;
VAR
      X,Y:INTEGER;
        S:STRING[20];

BEGIN
BDOS(26,ADDR(DISK_BUF));
X:=BDOS(17,ADDR(NAM_BUF));
FILES:=0;
WHILE X<>255 DO
BEGIN
FNAMES[FILES]:='';
FOR Y:=1 TO 8 DO FNAMES[FILES]:=FNAMES[FILES]+DISK_BUF[X*32+Y];
FNAMES[FILES]:=FNAMES[FILES]+'.';
FOR Y:=9 TO 11 DO FNAMES[FILES]:=FNAMES[FILES]+DISK_BUF[X*32+Y];
STR(ORD(DISK_BUF[X*32+15]) DIV 4+1,S);
IF LENGTH(S)=1 THEN S:=' '+S;
FNAMES[FILES]:=FNAMES[FILES]+'  '+S+'K';
FILES:=FILES+1;
X:=BDOS(18,ADDR(NAM_BUF));
END;
END;

PROCEDURE SORT_FILES;
VAR
      X:INTEGER;
      F:BOOLEAN;
      S:STRING[20];

BEGIN
REPEAT
F:=FALSE;
FOR X:=1 TO FILES-1 DO
IF FNAMES[X-1]>FNAMES[X] THEN

BEGIN
F:=TRUE;
S:=FNAMES[X-1];
FNAMES[X-1]:=FNAMES[X];
FNAMES[X]:=S;
END;
UNTIL NOT F;
END;

PROCEDURE WRITE_FILES;
VAR
  X,Y,MULT:INTEGER;

BEGIN
MULT:=FILES DIV 4+1;
IF FILES MOD 4=0 THEN MULT:=MULT-1;
FOR X:=0 TO MULT-1 DO

BEGIN
FOR Y:=0 TO 3 DO
IF X+MULT*Y<FILES THEN

BEGIN
WRITE(FNAMES[X+Y*MULT]);
IF Y<>3 THEN WRITE(' | ');
END;
SKIP(1);
IF (X MOD 20=0) AND (X<>0) THEN

BEGIN
WRITE('Press any key: ');
WHILE BDOS(6,255)=0 DO;
WRITE(^M);
END;
END;
END;

PROCEDURE FREE_SPC;
VAR
    FREE,TOTAL:INTEGER;

BEGIN
FREE:=0;
TOTAL:=0;
IF FILES=0 THEN
WRITE('No Files')
ELSE
WRITE(FILES);
W(' FILE(S) ');
END;

{-----------------------------------------}
PROCEDURE RUB;
LABEL TOP;
LABEL MORE;
LABEL BOTTOM;
VAR        FILVAR : FILE;
                I : INTEGER;
         FILENAME : STRING[14];
            REPLY : CHAR;
BEGIN
TOP:
GOTOXY (25,17); W('   RUBOUT A FILE? (Y/N):    ');
GOTOXY (50,17);
MORE:
READ (KBD,REPLY);
WRITELN (REPLY);
GOTOXY (50,17);
IF REPLY IN ['N','n'] THEN
goto BOTTOM ELSE
BEGIN
GOTOXY (25,19); W('   ENTER FILE TO RUBOUT:                  ');
GOTOXY (50,19);

READLN (FILENAME);
ASSIGN (FILVAR,FILENAME);
{$I-} RESET (FILVAR) {$I+};
IF IORESULT <> 0 THEN
goto TOP;

ERASE (FILVAR);
GOTOXY (20,21); W('        RUB MORE? (Y/N) <CR>:        ');
GOTOXY (50,21);
END;

READ (KBD,REPLY);
{GOTOXY (50,21);}
WRITELN (REPLY);
GOTOXY (50,21);
IF REPLY IN ['Y','y'] THEN
goto MORE else
goto BOTTOM;

BOTTOM:
CLOSE (FILVAR);
END;
{}
{---------------------------------------}
BEGIN
GET_NAME;
GET_CAT;
SKIP (1);
IF FILES<>0 THEN

BEGIN
SORT_FILES;
FOR X:=1 TO 4 DO

BEGIN
WRITE('NAME     EXT   KB ');
IF X<>4 THEN WRITE('  ');
END;
SKIP (2);
WRITE_FILES;
END;
SKIP(1);
FREE_SPC;
RUB;       {Calls PROCEDURE RUB}
END;