Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 678

/ вопрос открыт /

Здравствуйте, уважаемые эксперты!
Не могу написать полную программу поиска файлов? Искал в книгах и в интернете везде только ссылки или короткие коды.

Филаретов Мансур Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Филаретов Мансур (статус: Посетитель)
Вопрос отправлен: 29 июня 2007, 18:29
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Градов Ю.М.

Здравствуйте, Филаретов Мансур!
В приложении есть пример процедуры поиска и пример применения процедуры:

Приложение:
  1. procedure TForm1.ScanDir(StartDir, Mask: string; List: TStrings);
  2. var
  3. SearchRec: TSearchRec;
  4. begin
  5. if Mask = '' then
  6. Mask := '*.*';
  7. if StartDir[Length(StartDir)] <> '' then
  8. StartDir := StartDir + '';
  9. if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
  10. begin
  11. repeat Application.ProcessMessages;
  12. if (SearchRec.Attr and faDirectory) <> faDirectory then
  13. List.Add(StartDir + SearchRec.Name)
  14. else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
  15. begin
  16. List.Add(StartDir + SearchRec.Name + '');
  17. ScanDir(StartDir + SearchRec.Name + '', Mask, List);
  18. end;
  19. until FindNext(SearchRec) <> 0;
  20. FindClose(SearchRec);
  21. end;
  22. end;
  23.  
  24.  
  25. procedure TForm1.Button1Click(Sender: TObject);
  26. begin
  27. ListBox1.Items.Clear;
  28. ScanDir('c:', '', ListBox1.Items);
  29. Label1.Caption := IntToStr(ListBox1.Items.Count);
  30. end;
  31.  


Ответ отправил: Градов Ю.М. (статус: 8-ой класс)
Время отправки: 30 июня 2007, 01:08

Ответ #2. Отвечает эксперт: Матвеев Игорь Владимирович

Здравствуйте, Филаретов Мансур!

А какие файлы Вы собираетесь искать: на локальном компьютере или в сети? Как собираетесь производить проверку: по маске файла, по регулярному выражению, или по содержимому файла?

Все зависит от конкретной задачи. Банальный перебор файлов - это рекурсивная функция, использующая FindFirst/FindNext/FindClose. Но этот метод не годится для поиска файлов в сети (вернее годится, но только внутри расшаренных каталогов, но не по компьютеру вцелом и не по всей сети).

Если ведется поиск по сети - нужно сначала для каждого компьютера найти расшаренные каталоги, что делается с помощю WNetOpenEnum - в приложении функция, которая заполнит список FF (TStringList) всеми открытыми каталогами всех компьютеров в сети (привожу ее потому что она работает довольно быстро, в отличии от большинства аналогов).

Также нужно грамотно распаралеливать вычисления - если поиск в сети - на каждый компьютер по потоку, также на каждый физический диск.

В заключении могу порекомендовать компонент TFileFinder - http://www.delphiworld.harod.ru/base/tfilefinder html, я с него начинал, только имейте ввиду - в нем есть несколько ошибок (все в той же функции перечисления расшаренных каталогов при поиске по сети, замените ее на предложенную мной).

А что косается сравнения - сравнение по маске файлов - MatchesMask из Masks.pas, регулярные выражения - рекомендую модуль SynRegExpr.pas от Андрея Сорокина из SynEdit, а при поиске по содержимому следует иметь ввиду алгоритм Ахо-Корасика, поиска нескольких подстрок в строке, пожробнее на http://algolist.manual.ru/ - это будет намного быстрее последовательного поиска нескольких подстрок.

Приложение:
  1. function FindComputers(pNet: PNetResource): Integer;
  2. const
  3. cbBuffer: DWORD = 16384;
  4. var
  5. hEnum, dwResult, dwResultEnum: DWORD;
  6. lpnrLocal: array [0..16384 div SizeOf(TNetResource)] of TNetResource;
  7. i: integer;
  8. pp : integer;
  9. cEntries: Longint;
  10. function DeleteSlash(DirName: string): string;
  11. begin
  12. if Length(DirName) = 0 then Exit;
  13. Result := DirName;
  14. if DirName[Length(DirName)] = '' then
  15. Result := Copy(DirName, 1, Length(DirName)-1);
  16. end;
  17. function IsNetHost(TestStr: string): Boolean;
  18. begin
  19. Result := False;
  20. if Copy(TestStr, 1, 2) = '\' then Result := True;
  21. end;
  22. begin
  23. centries := -1;
  24. Result := 0;
  25.  
  26. pp := RESOURCE_CONTEXT;
  27. if pNet <> nil then pp := RESOURCE_GLOBALNET;
  28. dwResult := WNetOpenEnum(
  29. pp, // Enumerate currently connected resources.
  30. RESOURCETYPE_ANY, // all resources
  31. 0, // enumerate all resources
  32. pNet, // NULL first time the function is called
  33. hEnum // handle to the resource
  34. );
  35.  
  36. if (dwResult <> NO_ERROR) then
  37. begin
  38. Result := -1;
  39. Exit;
  40. end;
  41.  
  42. FillChar(lpnrLocal, cbBuffer, 0);
  43.  
  44. i := cbBuffer;
  45. dwResultEnum := WNetEnumResource(hEnum, // resource handle
  46. DWORD(cEntries), // defined locally as -1
  47. @lpnrLocal, // LPNETRESOURCE
  48. DWORD(i)); // buffer size
  49.  
  50. for i := 0 to cEntries - 1 do
  51. if DirectoryExists(DeleteSlash(lpnrLocal[i].lpRemoteName)) then
  52. begin
  53. FF.Dirs.Add(lpnrLocal[i].lpRemoteName);
  54. Inc(Result);
  55. end else if IsNetHost(lpnrLocal[i].lpRemoteName) then
  56. FindComputers(@lpnrLocal[i]);
  57.  
  58. dwResult := WNetCloseEnum(hEnum);
  59.  
  60. if (dwResult <> NO_ERROR) then
  61. Result := -1;
  62. end;


Ответ отправил: Матвеев Игорь Владимирович (статус: Студент)
Время отправки: 30 июня 2007, 04:24


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 22 февраля 2025, 12:02
Выполнено за 0.03 сек.