whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

14 Visitors Online


 
...search for files recursively?
Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch
[ Print tip ]  

Tip Rating (27):  
     


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;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners