uses dos, crt, debug; var f:file; p:pointer; count:integer; dirRec:SearchRec; name : string; function search2(s:pathStr; dirList:string):string; var name: String; ff_buf: SearchRec; p:longint; begin length(result) := 0; findfirst(s, anyFile, ff_buf); if (dosError = 0) then result := ff_buf.name; end; function Search(Path: PathStr; Dirlist: String): PathStr; var name: String; ff_buf: SearchRec; p: Longint; begin (* Length(Result) := 0; name := Path; repeat FindFirst('test.out', AnyFile, ff_buf); if DosError = 0 then begin Result := name; break; end else begin writeln('here'); if Length(DirList) = 0 then break; p := Pos(';', DirList); if p <> 0 then begin name := Copy(DirList, 1, p - 1) + '\' + Path; DirList := Copy(DirList, p + 1, 255); end else begin name := DirList + '\' + Path; Length(DirList) := 0; end end until FALSE; *) end; begin assign(f, 'test.out'); rewrite(f, 1); getmem(p, 4096); blockwrite(f, p^, 4096); freemem(p, 4096); count := 0; (* repeat getmem(p, 4096); // if (fsearch('test.out','') = '') then break; assign(f, 'test.out'); reset(f, 1); blockread(f, p^, 4096); reset(f, 512); blockread(f, p^, 8); close(f); freemem(p, 4096); inc(count); if (count and (1 shl 16-1) = 0) then writeln(count); until keypressed; *) repeat name:='test.out'; //search2(name,''); //if (dosError<>0) then break; //if (search('test.out','') = '') then break; findFirst(name, anyFile, dirRec); if (dosError<>0) then break; findClose(dirRec); inc(count); if (count and (1 shl 16-1) = 0) then writeln(count); until keypressed; writeln(count); end.