Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

Delphi , Файловая система , Файлы

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

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


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;

Перевод контента на русский язык:

Код - рекурсивная функция, которая ищет файлы и директории в всех дисках, начиная с 'C:\'. Поиск выполняется с помощью API Windows FindFirst и FindNext.

Маска поиска берется из текстового поля на форме, и если ничего не указано, она по умолчанию равна '.'.

Вот некоторые предложения:

  1. В процедуре GetAllFiles можно добавить проверку расширения файла в маске поиска. Если расширение не указано, может быть полезно включать только файлы с определенным расширением (например, .txt, .docx и т.д.).
  2. Вам может понравиться использовать регулярные выражения вместо wildcard'ов в маске поиска.
  3. В процедуре ScanDrive можно добавить проверку типа диска перед попыткой доступа к нему. Например, если вы хотите только искать фиксированные диски и не removable или network диски, вы можете использовать функцию GetDriveType, чтобы проверить тип диска.
  4. Рекурсивная функция в процедуре ScanDrive quite сложна и может быть трудной для отладки. Вам может понравиться разбить ее на более простые функции, каждая из которых делает что-то конкретное (например, одна функция для сканирования файлов, а другая - для сканирования директорий).
  5. Код не содержит обработки ошибок. Это может сделать его трудным для отладки, если что-то пойдет не так во время поиска.
  6. В процедуре Button2Click вы сканируете все диски, начиная с 'C:\'. Если это занимает много времени, вам может понравиться добавить обратную связь пользователю (например, обновить прогресс-бар).

Вот пример модификации кода для добавления обработки ошибок и проверки расширения файлов:

function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
var
  SRec: TSearchRec;
  pathlen: Integer;
  res: Integer;
begin
  try
     // ... (rest of your code)

     // проверка расширения файла
    if Pos('.', filemask) = 0 then
      filemask += '.*';

     // ... (rest of your code)

  except
    on e: Exception do
      ShowMessage('Ошибка при сканировании диска: ' + e.Message);
  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;

Модифицированный код добавляет обработку ошибок в процедуре ScanDrive и проверяет расширение файлов перед сканированием.

Описывается рекурсивный поиск файлов на компьютере, написанный на языке программирования Delphi, который ищет файлы на всех доступных дисках и добавляет их в список.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Файлы ::


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-06-02 10:20:12
2024-07-23 21:56:23/0.0041189193725586/0