Program Listdirectory;

Const
   FCBlength = 35;
   BuffLength = 127;
   Namelength = 14;

Type
   FCB = Array[0..FCBlength] of Byte  (* File Control Block *);
   BUF = Array[0..BuffLength] of Byte (* Filebuffer *);
   filename = string[Namelength];

var LW: char;

Procedure PrepeareFCB(drive: char; var aktfcb: FCB);
  (* Besetzen des FCB mit Laufwerksangabe und Wildcards *)
  (* Hier kann spaeter eine Maske fuer das Directory auf-
     gebaut werden, z.B. ????????.PAS *)
Const Questionmark = 63;
Var   i: Integer;
Begin
  aktfcb[0] := ord (drive)-64;
  for i:=1 to 11 do aktfcb[i] := Questionmark;
  for i:= 12 to 14 do aktfcb[i] := 0;
End;

Procedure getdir(Block: Byte; Puffer: BUF; var S:filename);
  (* Liefert Dateinamen oder '--nil--' *)
Var j: Integer;
Begin
  If Puffer[32*block+12]<2 then
    begin (* first entry *)
    S := '        .   '; (* 8 Blanks.3Blanks *)
    for j := 1 to 8 do S[j] := chr(Puffer[32*Block+J]);
    for j := 10 to 12 do S[j] := chr(Puffer[32*block+j-1]);
    end
  else
    S := '--nil--';
End;

Procedure Directory(Drive: char);
  (* Listet das Directory aus *)
Const
  Setdma = 26 (* BDOS: Setze DMA-Puffer *);
  First  = 17 (* BDOS: Suche ersten Eintrag *);
  Next   = 18 (* BDOS: Suche naechsten Eintrag *);
  error = 255 (* Fehler bei BDOS-Aufrufen *);
var i: Integer;
    res : Byte;
    fn: filename;
    aktfcb: FCB;
    Puffer: BUF;
Begin
  Drive := upcase(Drive);
  for i := 0 to Bufflength do Puffer[i] := 0;
  for i := 0 to FCBlength do aktfcb[i] := 0;
  bdos(Setdma, Addr(Puffer[0]));
  Clrscr; I := 1;
  Writeln('Laufwerk : ',Drive);
  Writeln('------------');
  PrepeareFCB(Drive,aktfcb);
  res := bdos(First,Addr(aktfcb[0]));
  if res <> error then begin
    getdir(res,Puffer,fn); if fn <> '--nil--' then write(fn,' : ');
    repeat
      PrepeareFCB(Drive,aktfcb); res := bdos(Next,Addr(aktfcb[0]));
      if res <> error then begin
        getdir(res,Puffer,fn);
        if fn <>'--nil--' then write(fn,' : ');
        i := succ(i); if (i mod 5)=0 then writeln end;
    until res = error;
    writeln; writeln(i,' Dateien !'); end
  else
    writeln('No File.');
end;

begin (* Main *)
Writeln('Laufwerk ? ');
Read(kbd,LW); writeln(LW);
Directory(LW);
end.