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; { Umwandlung aller Buchstaben einer Zeile in Grossbuchstaben } var i : integer; begin for i:=1 to length(strg) do strg[i]:=upcase(strg[i]); UpString:=strg; end; function wildcard(fnam:fstr):FCBstr; { Der Dateiname wird so aufbereitet, dass er in den FCB geschrieben } { werden kann. Wildcards ('*') werden beruecksichtigt. } 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 des Punktes im Dateinamen } 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; { Schreibt einen Dateinamen in einen FCB und bereitet Systembytes vor } 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; { Schreibt einen FCB in einen Dateinamen und loescht Attribute } var a : integer; filename : fstr; procedure append(b,l:integer); { Namen oder Typen an Dateinamen haengen ohne Attributbit } 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;