Ищем файл рекурсивно

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:	emp'; 
  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
;

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!