type
  fstr         = string[14];

function Finds(fn:fstr;num:integer):fstr;
const
  srcfrst      =  17;
  srcnxt       =  18;
  setdma       =  26;
  OSerr        = 255;
  NOATT        = $7F;
type
  FCBstr       = string[32];
var
  FCB          : FCBstr absolute $005C;    { File Control Block }
  DMA          : string[128];
  curcnt,
  direntry     : integer;

  function UpString(strg:fstr):fstr;
  { Convert entire string into upper case characters }
  var
  i            : integer;
  begin
    for i:=1 to length(strg) do strg[i]:=upcase(strg[i]);
    UpString:=strg;
  end;

  function wildcard(fnam:fstr):FCBstr;
  { Preparing file name to be written into an FCB }
  { regarding wildcards ('*')                     }
  const
    nam        = 8;
    ext        = 3;
  var
    leng,
    dot,
    ast        : integer;
    filename   : string[nam];
    fext       : string[ext];
  begin
    filename:='';
    fext:='   ';
    leng:=length(fnam);
    dot:=pos('.',fnam);        { Position of dot within file name }
    if (dot=0) and (leng>nam) then leng:=nam
                              else begin
                                     fext:=copy(fnam,succ(dot),ext)+'   ';
                                     if dot>succ(nam) then leng:=nam
                                                      else leng:=pred(dot);
                                     ast:=pos('*',fext);
                                     if ast<>0 then fext:=copy(fext,1,pred(ast))+'???';
                                   end;
    ast:=pos('*',fnam);
    if ast<>0 then filename:=copy(fnam,1,pred(ast))+'????????'
              else filename:=copy(fnam,1,leng)+'        ';
    wildcard:=filename+fext;
  end;

  procedure StringToFCB;
  { Write a file name into an FCB and prepare sysm bytes }
  const
    DSK        =  0;
    EX         = 12;
    CR         = 32;
    null       = #0;
  var
    drv        : char;
  begin
    FCB:=UpString(fn);
    drv:=FCB[1];
    if pos(':',FCB)=0 then drv:='@'
                      else delete(FCB,1,2);
    FCB:=wildcard(FCB);
    FCB[DSK]:=chr(ord(drv)-ord('@'));
    FCB[EX]:=null;
    FCB[CR]:=null;
  end;

  function FCBtoString:fstr;
  { Write an FCB into a file name and clear attributes }
  var
    a          : integer;
    filename   : fstr;

  procedure append(b,l:integer);
  { Append name or type to file name clearing attribute bit }
  var
    i          : integer;
  begin
    for i:=b to pred(b+l) do filename:=filename+chr(ord(DMA[a+i]) and NOATT);
  end;

  begin {FCBtoString}
    a:=succ(direntry SHL 5);
    filename:='' ;
    append(0,8);
    filename:=filename+'.';
    append(8,3);
    FCBtoString:=filename;
  end;

Begin {Finds}
  StringToFCB;
  curcnt:=1;
  bdos(setdma,addr(DMA));
  direntry:=bdos(srcfrst,addr(FCB));
  while (direntry<>OSerr) and (curcnt<>num) do
  begin
    curcnt:=succ(curcnt);
    direntry:=bdos(srcnxt);
  end;
  if direntry=OSerr then Finds:=''
                    else Finds:=FCBtoString;
End;