(************************************************************
 * DIRMOD1.INC -2421 Bytes-                 (c) 1986 by B.O. *
 *                                                           *
 * Ermoeglicht die Ausgabe eines Directories innerhalb eines *
 * Turbo-Pascal Programmes unter CP/M-80                     *
 *************************************************************)

type filename = array[1..8] of char;
     filetype = array[1..3] of char;

     fcbtype  = record
                     drive:byte;
                     filename:filename;
                     filetype:filetype;
                     ex:byte;
                     s1:array[1..2] of byte;
                     rc:byte;
                     s2:array[1..16] of byte;
                end;

     dirtype = record
                    filename:filename;
                    filetype:filetype;
                    roflag:boolean;
                    sysflag:boolean;
               end;

     dmatype = array[0..3] of fcbtype;

var  fcbentry:fcbtype absolute $5C;
     direntry:dirtype;
     dmaentry:dmatype;
     dirflag:byte;

procedure initdir(drive:char;filename:filename;filetype:filetype);
var hvar:byte;
begin
     bdos(26,addr(dmaentry));
     fcbentry.ex:=0;
     fcbentry.drive:=ord(drive)-64;
     fcbentry.filename:=filename;
     fcbentry.filetype:=filetype;
     dirflag:=bdos(17,addr(fcbentry));
end;

procedure scanndir;
var hvar:byte;
begin
     direntry.filename:=dmaentry[dirflag].filename;
     if dmaentry[dirflag].filetype[1] > chr(127)
        then direntry.roflag:=true
        else direntry.roflag:=false;
     if dmaentry[dirflag].filetype[2] > chr(127)
        then direntry.sysflag:=true
        else direntry.sysflag:=false;
     for hvar:=1 to 3 do
     begin
          direntry.filetype[hvar]:=
          chr(ord(dmaentry[dirflag].filetype[hvar])and 127);
     end;
     dirflag:=bdos(18);
end;

procedure dir(drive:char;filename:filename;filetype:filetype);
begin
     initdir(drive,filename,filetype);
     while dirflag<>255 do
     begin
          scanndir;
          if not direntry.sysflag then
          begin
              write(direntry.filename,' ');
              write(direntry.filetype);
              if direntry.roflag then write('*   ')
                                 else write('    ');
          end;
     end;
end;