procedure dirlesen;

type           puffer = record
                  user : byte;
                  name : array [1..8]  of char;
                  ext  : array [1..3]  of char;
                  rest : array [1..20] of byte;
               end;

               fcb = record
                  drive : byte;
                  name  : array [1..8]  of char;
                  ext   : array [1..3]  of char;
                  ex    : byte;
                  rest  : array [1..19] of byte;
                  cr    : byte;
                  rrp   : array [1..3]  of byte;
               end;

label          1, 2, 3, 4, 5;

var            pufpos    : integer;
               fcblock   : fcb;
               dmapuffer : array [0..3] of puffer;
               buf       : string [128];
               i, j, x,
               pkt, dp, lf : integer;

begin

   with fcblock do begin
      drive := 0;
      ex    := 0;
      cr    := 0;
      for i := 1 to 8 do name [i] := '?';
      for i := 1 to 3 do ext  [i] := '?';

      commandzeile;
      clreol;
      write ( '  Directory mask : ' );
      read ( buf );
      dp  := 0;
      pkt := length ( buf ) + 1;
      lf := bdos ( 25 ) + 65;
      if length ( buf ) = 0
      then begin
           write ( chr ( lf ) , ':*.*' );
           end
      else begin
{ grossbuchstaben }
           for i := 1 to length ( buf ) do
               buf [i] := upcase ( buf [i] );

{ laufwerk }
           for i := length ( buf ) downto 1 do
               if buf [i] = ':' then dp := i;
           case dp of
           0  : ;
           1  : begin
                falschein;
                write ( 'KEINE LAUFWERKSANGABE    ' , chr ( lf ) , ':' );
                end;
           else if buf [dp-1] in drives
                then begin
                     lf := ord ( buf [dp-1] ) - 65;
                     bdos ( 14 , lf );
                     end
                else begin
                     commandzeile;
                     write ( 'LAUFWERK NICHT VORHANDEN  ' , chr ( lf ) , ':' );
                     end;
           end;
{ ext oder nicht }
           for i := length ( buf ) downto dp + 1 do
               if buf [i] = '.' then pkt := i;

{ name }
           if dp <> length ( buf )
           then begin
                i := 0;
                repeat i := i + 1;
                       name [i] := buf [i+dp];
                until ( i = 8 ) or ( i + dp = pkt - 1 ) or ( name [i] = '*' );
                if name [i] <> '*'
                then for i := i + 1 to 8 do
                         name [i] := ' ';
                if name [i] = '*'
                then name [i] := '?';
                end
           else write ( '*' );
{ ext }
           if pkt < length ( buf )
           then begin
                i := 0;
                repeat i := i + 1;
                       ext [i] := buf [i+pkt];
                until ( i = 3 ) or ( i + pkt = length ( buf )) or ( ext [i] = '*' );
                if ext [i] <> '*'
                then for i := i + 1 to 3 do
                         ext [i] := ' ';
                if ext [i] = '*'
                then ext [i] := '?';
                end
           else begin
                if pkt = length ( buf )
                then write ('*')
                else write ( '.*');
                end;
           end;
     end; { with }

     filez := 0;
     bdos ( 26 , addr ( dmapuffer ) );
     pufpos := bdos ( 17 , addr ( fcblock ) );

     if pufpos <> 255 then
        repeat begin
               filez := filez + 1;
               for i := 1 to 8 do
                  inhalt [filez] .name [i] := dmapuffer [pufpos] .name [i];
               for i := 1 to 3 do
                  inhalt [filez] .ext [i] := dmapuffer [pufpos] .ext [i];
               inhalt [filez] .flag := false;
               pufpos := bdos ( 18 , addr ( fcblock ) );
               end;
        until  pufpos = 255;

        for i := 1 to filez -1 do
           for j := i to filez do
           if inhalt [i].name  > inhalt [j].name
          then
          begin for x := 1 to 8 do begin
                buf [x]             := inhalt [i].name [x];
                inhalt [i].name [x] := inhalt [j].name [x];
                inhalt [j].name [x] := buf [x];  end;
                for x := 1 to 3 do begin
                buf [x]             := inhalt [i].ext [x];
                inhalt [i].ext [x]  := inhalt [j].ext [x];
                inhalt [j].ext [x]  := buf [x];  end;
          end;
end; { dirlesen }
