Скачать Сканирование файлов по всему диску

Unit ScanDisk;
interface
uses dos;
Type ProcessFile=Procedure(FileName:PathStr);
Procedure RecurseTree(StartDir:PathStr;Action:ProcessFile);
var SR:Searchrec;
begin
   if StartDir[Length(StartDir)]<>'\' then
      StartDir:=StartDir+'\';
   FindFirst(StartDir+'*.*',{Собака может быть зарыта
      здесь. Если вы задатите, скажем *.pas,
       вам потребуются два цикла поиска - один для
       файлов, а второй с шаблоном *.* для директорий,
       а то директории, не имеющие расширения pas не будут
       найдены ;-)}
    Archive+Directory {ReadOnly и Hidden
     добавлять по вкусу},sr);
   While DosError=0 do
     begin
       if (Sr.Attr and Directory)<>0 then
        begin
          RecurseTree(StartDir+Sr.Name,Action);
        end
       else
         Action(StartDir+Sr.Name);
       FindNext(Sr);
      end;
end;
end.