Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > поиск файлов по всему харду(по маске)

Автор: ne0n 31.10.2005, 18:41

Ребята, проблема следующая:
есть у меня некая процедура назовем ее Counter(fileName : string);
Мне надо реализовать поиск файлов(mp3,ogg,avi итд) по всему жесткому диску,
но так что бы , программа выполняла мою процедуру с каждым найденным файлом!!!
Приветствуется любой вариант(особенно на Win Api)

Заранее спасибо!!!

Автор: Самурай 31.10.2005, 18:48

FindFirst() & FindNext().

Примеры использования данных функций можно найти на форуме, воспользовавшись поиском по "FindFirst" или "FindNext".

Автор: ne0n 31.10.2005, 18:53

FindFist() & FindNext() я зная как им ползоваться(поиск по известной дирректории),
главная сложность это осуществить поиск по всему харду и выполнение процедуры!!!

Автор: _hunter 31.10.2005, 18:57

нет тут никакой сложности: пишеш рекурсивную функцию, принимающую полный путь к дирректории и вызываеш ее для корневой дирректории. в функции вызываеш саму-себя для каждой найденной дирректории...

Автор: ne0n 31.10.2005, 19:00

Цитата(_hunter @ 31.10.2005, 18:57)

а на примере можно?

Автор: Poseidon 31.10.2005, 19:00

Вот, держи

Код

function ScanDir(Dir:string): TStringList;
var SearchRec:TSearchRec;
begin
 Result:= TStringList.Create;

 if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
 if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
 repeat
 if (SearchRec.name='.') or (SearchRec.name='..') then continue;
 if (SearchRec.Attr and faDirectory)<>0 then
 ScanDir(Dir+SearchRec.name) 
 else
 Result.Add(Dir+SearchRec.name); 
 until FindNext(SearchRec)<>0;
 FindClose(SearchRec);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
FList: TstringList;
i: integer;
begin
FLIst:= TstringList.Create;
FList.AddStrings(ScanDir('C:'));
FList.AddStrings(ScanDir('D:'));
// повторить со всеми дидисками

for i:= 0 to FList.Count-1 do
Counter(Flist.Strings[i]);

FList.Free;
end;

Автор: ne0n 31.10.2005, 19:04

Poseidon спасибо за код( вроде должен подойти)

Автор: Самурай 31.10.2005, 20:05

Для получения всех дисков:

Код


var
 DriveChar: char;
begin
 for DriveChar:='A' to 'Z' do
  if GetDriveType(DriveChar + ':\') = DRIVE_FIXED
   then
    ScanDir(DriveChar +':')
end;

Автор: Albinos_x 31.10.2005, 20:54

Код


...
var
  Form1: TForm1;
  SearchRec:TSearchRec;
  l:boolean = false;   // для остановки поиска
...
procedure GetAllFilesOnHdds(var DFile, NFile, AFile : TStringList);
  procedure ScanDir(Dir:string);    
  // Поиск файлов
  var
    SearchRec:TSearchRec;
    r:string;
  begin
    if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
    if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
      repeat
      if (SearchRec.name='.') or (SearchRec.name='..') then Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        ScanDir(Dir+SearchRec.name)
      else
        begin
         {Вот здесь мы можем делать с найденным файлом что угодно
          SearchRec.name - имя файла
          ExpandFileName(SearchRec.name) - имя файла с полным путем}
        r:=AnsiLowerCase(ExtractFileExt(dir+SearchRec.name));
        if (r='.mp3') or (r='.avi') or (r='.ogg') or (r='.rtf') then
           begin
           {здесь твои действия}
           end;
        end;
     Application.ProcessMessages;
     if l then Exit;
    until FindNext(SearchRec)<>0;
    FindClose(SearchRec);
  end;
var
  Drive: Char; // Буква диска    
  n: byte;
  lst:TStringList;
const
  pref = ':\';
begin
  lst:=TStringList.Create;
  lst.Clear;
  for Drive:= 'A' to 'Z' do
     if GetDriveType(PChar(Drive + pref)) = DRIVE_FIXED then
        lst.Add(Drive + pref);
      for n:= 0 to (lst.Count-1) do
          ScanDir(lst.Strings[n]);
    lst.Free;
end;

может это подойдёт... smile