Delphi World - Ищем файл рекурсивно
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Ищем файл рекурсивно

Встречаются двое юзеров. Один говорит:
- Я тут свежий антивирус достал, не хочешь себе установить?
- Нет, мне это не нужно.
- Почему?
- Да мой комп так глючит, что на нем ни один вирус не запустится.


procedure GetAllFiles(mask: string); 
var 
  search: TSearchRec; 
  directory: string; 
begin 
  directory := ExtractFilePath(mask); 

  // find all files 
  if FindFirst(mask, $23, search) = 0 then 
  begin 
    repeat 
      // add the files to the listbox 
      Form1.ListBox1.Items.Add(directory + search.Name); 
      Inc(Count); 
    until FindNext(search) <> 0; 
  end; 

  // Subdirectories/ Unterverzeichnisse 
  if FindFirst(directory + '*.*', faDirectory, search) = 0 then 
  begin 
    repeat 
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then 
        GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask)); 
    until FindNext(search) <> 0; 
    FindClose(search); 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  directory: string; 
  mask: string; 
begin 
  Count := 0; 
  Listbox1.Items.Clear; 

  directory := 'C:\temp\'; 
  mask := '*.*'; 

  Screen.Cursor := crHourGlass; 
  try 
    GetAllFiles(directory + mask); 
  finally 
    Screen.Cursor := crDefault; 
  end; 
  ShowMessage(IntToStr(Count) + ' Files found'); 
end; 


{**************************************} 
{ Code from P. Below: } 

// recursively scanning all drives 

  { excerpt from form declaration, form has a listbox1 for the 
    results, a label1 for progress, a button2 to start the scan, 
    an edit1 to get the search mask from, a button3 to stop 
    the scan. } 
  private 
    { Private declarations } 
    FScanAborted: Boolean; 

  public 
    { Public declarations } 
     
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 

implementation 

function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 
  function ScanDirectory(var path: string): Boolean; 
  var 
    SRec: TSearchRec; 
    pathlen: Integer; 
    res: Integer; 
  begin 
    label1.Caption := path; 
    pathlen := Length(path); 
    { first pass, files } 
    res := FindFirst(path + filemask, faAnyfile, SRec); 
    if res = 0 then 
      try 
        while res = 0 do  
        begin 
          hitlist.Add(path + SRec.Name); 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
    Application.ProcessMessages; 
    Result := not (FScanAborted or Application.Terminated); 
    if not Result then Exit; 

    {second pass, directories} 
    res := FindFirst(path + '*.*', faDirectory, SRec); 
    if res = 0 then 
      try 
        while (res = 0) and Result do  
        begin 
          if ((Srec.Attr and faDirectory) = faDirectory) and 
            (Srec.Name <> '.') and 
            (Srec.Name <> '..') then  
          begin 
            path := path + SRec.Name + '\'; 
            Result := ScanDirectory(path); 
            SetLength(path, pathlen); 
          end; 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
  end; 
begin 
  FScanAborted := False; 
  Screen.Cursor := crHourglass; 
  try 
    Result := ScanDirectory(root); 
  finally 
    Screen.Cursor := crDefault 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  ch: Char; 
  root: string; 
begin 
  root := 'C:\'; 
  for ch := 'A' to 'Z' do  
  begin 
    root[1] := ch; 
    case GetDriveType(PChar(root)) of 
      DRIVE_FIXED, DRIVE_REMOTE: 
        if not ScanDrive(root, edit1.Text, listbox1.Items) then 
          Break; 
    end; 
  end; 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
begin // aborts scan 
  FScanAborted := True; 
end;

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования