Tips (1541)

Tip Bewertung (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;