Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Список файлов на всех дисках компа, Одного расширения 
:(
    Опции темы
Dr Smth
Дата 19.11.2004, 14:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 100
Регистрация: 11.10.2004
Где: New Podrezkovo

Репутация: нет
Всего: 1
Помогите! Нужно составить список путей ко всем файлам данного расширения на компе (например, в текстовом файле).

Для этого нужно программно узнать количество дисков, их названия. И искать файлы, причём во всех существующих папках!

Тут всего слишком много, чтобы мне сразу понять. К тому же, чего-то в толк не возьму, как пользоваться процедурой FindNext?

Есть какие-нибудь соображения (слёзно умоляя)?
PM MAIL WWW   Вверх
Pakshin A. S.
Дата 19.11.2004, 15:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Щас напишу... smile
PM   Вверх
Alex
Дата 19.11.2004, 15:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Код

procedure GetAllFilesOnHdds(lst: TStrings);
 procedure ScanDir(Dir:string);
 // Поиск файлов
 var
   SearchRec:TSearchRec;
 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
       lst.Add(Dir+SearchRec.name);
   until FindNext(SearchRec)<>0;
   FindClose(SearchRec);
 end;

var
 Drive: Char; // Буква диска
 n: Integer;
const
 pref = ':\';
begin
 lst.Clear;
 lst.BeginUpdate;
 with TStringList.Create do try
   for Drive:= 'A' to 'Z' do
     if GetDriveType(PChar(Drive + pref)) = DRIVE_FIXED then
       Add(Drive + pref);
   for n:= 0 to count-1 do
     ScanDir(Strings[n]);
 finally
   lst.EndUpdate;
   Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 GetAllFilesOnHdds(ListBox1.Items);
end;



--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Pakshin A. S.
Дата 19.11.2004, 15:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Вот:
Код

procedure SaveFiles(filename:string; mask:string);
var
drive:char;
procedure FindF(dir:string);
var
 f:text;
 function GetDirName(Dir: string):string;
 begin
 Result:=Dir;
 if Dir[Length(Dir)] <> '\'
  then
   Result:=Dir + '\'
 end;
 procedure FindFiles(Dir:string);
 var
  FSR, DSR:TSearchRec;
  Res:integer;
  function IsDirNotation(ADirName:string):boolean;
  begin
   Result:=(ADirName = '.') or (ADirName = '..')
  end;
 begin
  Dir:=GetDirName(Dir);
  Res:=FindFirst(Dir + Mask, faAnyFile, FSR);
  while Res = 0 do
   begin
    write(f, LowerCase(Dir + FSR.Name));
    Res:=FindNext(FSR)
   end;
  FindClose(FSR);
  Res:=FindFirst(Dir + '*.*', faDirectory, DSR);
  while Res = 0 do
   begin
    if ((DSR.Attr and faDirectory) = faDirectory) and not IsDirNotation(Dir + DSR.Name)
     then
      FindFiles(Dir + DSR.Name);
    Res:=FindNext(DSR)
   end;
  FindClose(DSR)
 end;
begin
 AssignFile(f, filename);
 rewrite(f);
 FindFiles(dir);
 CloseFile(f)
end;
begin
for drive:='a' to 'z' do
 if GetDriveType(PChar(drive + ':\')) = DRIVE_FIXED
  then
   FindF(drive + ':\')
end;

Добавлено @ 15:53
smile не поспел..
PM   Вверх
Dr Smth
Дата 21.11.2004, 16:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 100
Регистрация: 11.10.2004
Где: New Podrezkovo

Репутация: нет
Всего: 1
Что-то не выходит.
Первый код выдаёт только список файлов в корне последнего диска.
Второй работает, но в файле получается какая-то абракадабра, к тому же, похоже виснет.
PM MAIL WWW   Вверх
Alex
Дата 21.11.2004, 16:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Dr Smth Качаем пример и убеждаемся, что все работает

Присоединённый файл ( Кол-во скачиваний: 28 )
Присоединённый файл  Find.rar


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Pakshin A. S.
Дата 21.11.2004, 17:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Цитата(Dr @ 21.11.2004, 17:21)
абракадабра

Кодировка похоже... А насчет виснет: просто много файликов и дирректорий... smile
PM   Вверх
Dr Smth
Дата 22.11.2004, 13:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 100
Регистрация: 11.10.2004
Где: New Podrezkovo

Репутация: нет
Всего: 1
Да нет. С кодировкой всё нормально. И пути выводятся. Только всё в обну строку, между путями куча точек, в общем, всё как-то в одном комке...
Добавлено @ 13:30
Цитата(Alex @ 21.11.2004, 16:59)
Качаем пример

Спасибо, скачал.
Сегодня ещё раз попробую.
PM MAIL WWW   Вверх
Dr Smth
Дата 22.11.2004, 21:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 100
Регистрация: 11.10.2004
Где: New Podrezkovo

Репутация: нет
Всего: 1
Alex, всё по прежнему.
Список всех файлов процедура делает. Причём довольно быстро.
Однако если заменить в строке

Код
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then repeat


маску на ту, которая, собственно нужна, то она даёт только файлы, лежащие в корнях всех дисков, после чего вылетает из цикла. Например, я попробовал поискать INI-файлы. Получил только два (на разных дисках - в корне). Маловато для целой системы. Чего-то надо поправить.
PM MAIL WWW   Вверх
Pakshin A. S.
Дата 22.11.2004, 21:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Надо разделять поиск файлов и подкаталогов... посмотри на мой пример....
Добавлено @ 21:57
Код

procedure ScanDir(Dir:string);
// Поиск файлов
var
  SearchRec:TSearchRec;
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
      if ExtractFileExt(Dir + SearchRec.Name) = '.ini'
       then
        lst.Add(Dir+SearchRec.name);
  until FindNext(SearchRec)<>0;
  FindClose(SearchRec);
end;

Вот, доделал...
PM   Вверх
Dr Smth
Дата 24.11.2004, 13:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 100
Регистрация: 11.10.2004
Где: New Podrezkovo

Репутация: нет
Всего: 1
Нет, что-то не выходит каменный цветок. Теперь показывает только один файл.
PM MAIL WWW   Вверх
Pakshin A. S.
Дата 24.11.2004, 19:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Нее.... ну это что-то не то определённо.......
PM   Вверх
Pakshin A. S.
Дата 24.11.2004, 19:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Лови (усё проверено...):
Код

procedure FindF(dir:string; mask:string);
var
FSR: TSearchRec;
FRes: integer;
begin
if dir[Length(dir)] <> '\'
 then
  dir:=dir + '\';
FRes:=FindFirst(dir + '*.*', faAnyFile, FSR);
while FRes = 0 do
 begin
  if ((FSR.Attr and faDirectory) = faDirectory) and (FSR.Name <> '.') and (FSR.Name <> '..')
   then
    FindF(dir + FSR.Name, mask)
   else
    if ExtractFileExt(FSR.Name) = mask
     then
      begin
       Form1.RichEdit1.Lines.Add(Dir + FSR.Name);
       Application.ProcessMessages
      end;
  FRes:=FindNext(FSR)
 end;
FindClose(FSR)
end;

procedure FindFiles(mask:string);
var
c:char;
begin
for c:='a' to 'z' do
 if GetDriveType(PChar(c + ':\')) = DRIVE_FIXED
 then
  FindF(c + ':\', mask)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.Lines.Text:='';
FindFiles('.ini');
end;

Добавлено @ 20:00
Хотя разница минимальна...
Добавлено @ 20:00
И то, не существенная... на первый взгляд...
PM   Вверх
Балбес
Дата 25.11.2004, 22:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 76
Регистрация: 19.8.2004

Репутация: нет
Всего: нет
Пакшин Андрей Сергеевич хоть Dr Smth не ответил Вам, но я только что проверил, код работает на ура! smile
И это очень здорово, как раз то что мне нужно. Я рад до ушей. smile
PM MAIL   Вверх
Pakshin A. S.
Дата 25.11.2004, 22:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Ещё бы не работало... smile
PM   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0559 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.