Модераторы: Poseidon

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Файлы и папки, Сканирование 
V
    Опции темы
svarogik
Дата 27.7.2006, 21:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
Можно ли просканировать папку на наличие файлов с определенным расширением? (в моем случае *.bmp) и если присутствуют  то выполнить какие то действия, и продолжить сканирование. 
PM MAIL   Вверх
Alexeis
Дата 27.7.2006, 21:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459
http://forum.vingrad.ru/index.php?act=modu...mp;article=2507

Добавлено @ 21:59 
http://forum.vingrad.ru/index.php?act=modu...amp;article=989

Добавлено @ 22:00 
http://forum.vingrad.ru/index.php?act=modu...amp;article=993 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
svarogik
Дата 27.7.2006, 22:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
что значитпо заданной маске? расширение считается? 
PM MAIL   Вверх
Albinos_x
Дата 27.7.2006, 22:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 2
Всего: 108
вот простой пример поиска на винте файлов *.doc *.xls *.ppt *.rtf :
Код
...  
  type  
  TForm1 = class(TForm)  
  SpeedButton1: TSpeedButton;  
  SpeedButton2: TSpeedButton;  
  StatusBar1: TStatusBar;  
  Label1: TLabel;  
  Label2: TLabel;  
  ListBox1: TListbox;  
  ListBox2: TListbox;  
  ListBox3: TListbox;  
  ...  
  procedure FormDestroy(Sender: TObject);  
  private  
  ...  
  var  
  Form1: TForm1;  
  SearchRec:TSearchRec;  
  l:boolean = false; //для остановки поиска  
  ...  
 
 procedure GetAllFilesOnHdds(var DFile, NFile, AFile : TStringList);  
  procedure ScanDir(Dir:string);  
  // Поиск файлов  
  var  
  SearchRec:TSearchRec;  
  r:string; // сюда записываем расширение найденного файла  
  col:Longint; // соличество найденых файлов  
  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='.doc') or (r='.xls') or (r='.ppt') or (r='.rtf') then  
  begin  
  // добавляем имя файла  
  NFile.Add(SearchRec.name);  
  // добавляем путь к файлу  
  AFile.Add(dir);  
  // добавляем дату создания файла  
  DFile.Add(DateToStr(FileDateToDateTime(SearchRec.Time)));  
  // считаем количество найденых файлов  
  col:=col+1;  
  // отображаем на форме  
  Form1.Label1.Caption:='Найдено : '+inttostr(col)+' файлов';  
  // отображаем последний найденый  
  Form1.Label2.Caption:='Последний : '+dir+SearchRec.name;  
  end;  
  // сюда выводим просматримаемые файлы  
  Form1.StatusBar1.SimpleText:='Поиск...'+dir+SearchRec.name;  
  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;  
 
 //пример вызова  
  procedure TForm1.SpeedButton1Click(Sender: TObject);  
  var  
  DataFile, NameFile, AdrFile : TStringList;  
  begin  
  DataFile:=TStringList.Create;  
  NameFile:=TStringList.Create;  
  AdrFile:=TStringList.Create;  
  DataFile.Clear;  
  NameFile.Clear;  
  AdrFile.Clear;  
  GetAllFilesOnHdds(DataFile,NameFile,AdrFile);  
  Form1.ListBox1.Items.AddStrings(DataFile);  
  Form1.ListBox2.Items.AddStrings(NameFile);  
  Form1.ListBox3.Items.AddStrings(AdrFile);  
  end;  
 
 // останавливаем поиск  
  procedure TForm1.SpeedButton2Click(Sender: TObject);  
  begin  
  l:=true;  
  end; 
...


этот кусок кода найдёт на винте все файлы с указанными расширениями и выведет результат в листбоксы. в первый - дата создания файла, во второй - имя файла, в третий - путь к файлу.

если нужно искать только в указанной папке, то нужно использовать только функцию:
Код

  procedure ScanDir(var DFile, NFile, AFile : TStringList; Dir:string);  
  // Поиск файлов  
  var  
  SearchRec:TSearchRec;  
  r:string; // сюда записываем расширение найденного файла  
  col:Longint; // соличество найденых файлов  
  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='.doc') or (r='.xls') or (r='.ppt') or (r='.rtf') then  
  begin  
  // добавляем имя файла  
  NFile.Add(SearchRec.name);  
  // добавляем путь к файлу  
  AFile.Add(dir);  
  // добавляем дату создания файла  
  DFile.Add(DateToStr(FileDateToDateTime(SearchRec.Time)));  
  // считаем количество найденых файлов  
  col:=col+1;  
  // отображаем на форме  
  Form1.Label1.Caption:='Найдено : '+inttostr(col)+' файлов';  
  // отображаем последний найденый  
  Form1.Label2.Caption:='Последний : '+dir+SearchRec.name;  
  end;  
  // сюда выводим просматримаемые файлы  
  Form1.StatusBar1.SimpleText:='Поиск...'+dir+SearchRec.name;  
  end;  
  Application.ProcessMessages;  
  if l then Exit;  
  until FindNext(SearchRec)<>0;  
  FindClose(SearchRec);  
  end;  

// соответственно вызов
  procedure TForm1.SpeedButton1Click(Sender: TObject);  
  var  
  DataFile, NameFile, AdrFile : TStringList; 
  dir:string; 
  begin  
  dir:={здесь задаешь папку в которой необходимо искать};
  DataFile:=TStringList.Create;  
  NameFile:=TStringList.Create;  
  AdrFile:=TStringList.Create;  
  DataFile.Clear;  
  NameFile.Clear;  
  AdrFile.Clear;  
  ScanDir(DataFile,NameFile,AdrFile, dir);  
  Form1.ListBox1.Items.AddStrings(DataFile);  
  Form1.ListBox2.Items.AddStrings(NameFile);  
  Form1.ListBox3.Items.AddStrings(AdrFile);  
  ...
  

Это сообщение отредактировал(а) Albinos_x - 27.7.2006, 23:05


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
Alexeis
Дата 27.7.2006, 22:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459
Цитата(svarogik @  27.7.2006,  22:02 Найти цитируемый пост)
что значитпо заданной маске? расширение считается? 

маска может включать не только одно расширение, а несколько, так же как в программе поиска windows. Кто по опытней меня дополнят, маска понятие чуть более общее и определяет условия поиска. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Демо
Дата 27.7.2006, 23:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 2
Всего: 50
Кобимбинируй простой поиск файлов без маски и 

Unit
Masks

Category
file name utilities

function MatchesMask(const Filename, Mask: string): Boolean;

Description
Call MatchesMask to check the Filename parameter using the Mask parameter to describe valid values. A valid mask consists of literal characters, sets, and wildcards 


--------------------
    
PM MAIL ICQ Skype   Вверх
Poseidon
Дата 28.7.2006, 00:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 5
Всего: 133
Albinos_x, зачем искать сначала все файлы:
Цитата(Albinos_x @  27.7.2006,  22:19 Найти цитируемый пост)
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then  
 
а потом фильтровать нужное:
Цитата(Albinos_x @  27.7.2006,  22:19 Найти цитируемый пост)
if (r='.doc') or (r='.xls') or (r='.ppt') or (r='.rtf') then 

???

Не проще-ли сразу фильтровать?

Код

if FindFirst(Dir+'*.doc', faAnyFile, SearchRec)=0 then  {...}

 


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Демо
Дата 28.7.2006, 00:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 2
Всего: 50
Цитата(Poseidon @  28.7.2006,  00:05 Найти цитируемый пост)
Не проще-ли сразу фильтровать?


Сразу несколько расширений?
 


--------------------
    
PM MAIL ICQ Skype   Вверх
Poseidon
Дата 28.7.2006, 00:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 5
Всего: 133
Цитата(Демо @  28.7.2006,  00:26 Найти цитируемый пост)
Сразу несколько расширений?
 Ну да.

Код

Procedure ScanDir(Dir, Mask:string); 
var SearchRec:TSearchRec; 
begin 
 if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';  
  if FindFirst(Dir+Mask, 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  
 Form1.ListBox1.Items.Add(Dir+SearchRec.name); 
 until FindNext(SearchRec)<>0;  
 FindClose(SearchRec);  
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ScanDir('c:', '*.doc');  
  ScanDir('c:', '*.xls');  
  ScanDir('c:', '*.rtf');    
end; 


 


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Albinos_x
Дата 28.7.2006, 12:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 2
Всего: 108
эффект не намного лучше получится...имхо... 


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
svarogik
Дата 28.7.2006, 14:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
 с этим постараюсь разобраться, а можно еще маленкий вопросик, модераторы не хотелось отдельный топик создавать. Файл заявлен TFilestream как записать в файл переход на следующую строчку, у меня есть мысль, не знаю бредовая или нет, записать в файл символы #13 #10 но не получается вместо этого он пишет решетки. И можно ли писать последовательно, не прибегая к file.seek(,) 
PM MAIL   Вверх
Alexeis
Дата 28.7.2006, 14:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

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

var
 f : TFileStream;
 s : ShortString[2];
begin
 s := #13#10;
 f := TFileStream.Create(...);
 f.Writebuffer(s[1], 2);
end;

Цитата(svarogik @  28.7.2006,  14:03 Найти цитируемый пост)
 И можно ли писать последовательно, не прибегая к file.seek(,) 

так после очередной записи указатель смещается автоматически.
 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
svarogik
Дата 28.7.2006, 14:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
если я сделаю так
f.write('hh',2);
f.write('wh',2);
то в файле будет два символа wh
ничего у меня не смещается
а если так

fn.seek(t,sofrombeginning);
f.write('hh',2);
fn.seek(t+2,sofrombeginning);
f.write('wh',2);

вот так получится hhwh

Добавлено @ 14:55 
что такое shortstring и writebuffer? 
PM MAIL   Вверх
Демо
Дата 28.7.2006, 14:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 2
Всего: 50
Цитата(Albinos_x @  28.7.2006,  12:39 Найти цитируемый пост)
эффект не намного лучше получится...имхо... 


Проще сказать - намного хуже, так как сканирование будет идти в любом случае по всем файлам.

  

Это сообщение отредактировал(а) Демо - 28.7.2006, 14:57


--------------------
    
PM MAIL ICQ Skype   Вверх
Alexeis
Дата 28.7.2006, 14:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459
shortstring - это паскалевская строка.
writebuffer- процедура записи в поток данных любого типа. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Центр помощи"

ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Несоблюдение правил может повлечь за собой самые строгие меры от закрытия/удаления темы до бана пользователя!


  • Название темы должно отражать её суть! (Не следует добавлять туда слова "помогите", "срочно" и т.п.)
  • При создании темы, первым делом в квадратных скобках укажите область, из которой исходит вопрос (язык, дисциплина, диплом). Пример: [C++].
  • В названии темы не нужно указывать происхождение задачи (например "школьная задача", "задача из учебника" и т.п.), не нужно указывать ее сложность ("простая задача", "легкий вопрос" и т.п.). Все это можно писать в тексте самой задачи.
  • Если Вы ошиблись при вводе названия темы, отправьте письмо любому из модераторов раздела (через личные сообщения или report).
  • Для подсветки кода пользуйтесь тегами [code][/code] (выделяйте код и нажимаете на кнопку "Код"). Не забывайте выбирать при этом соответствующий язык.
  • Помните: один топик - один вопрос!
  • В данном разделе запрещено поднимать темы, т.е. при отсутствии ответов на Ваш вопрос добавлять новые ответы к теме, тем самым поднимая тему на верх списка.
  • Если вы хотите, чтобы вашу проблему решили при помощи определенного алгоритма, то не забудьте описать его!
  • Если вопрос решён, то воспользуйтесь ссылкой "Пометить как решённый", которая находится под кнопками создания темы или специальным флажком при ответе.

Более подробно с правилами данного раздела Вы можете ознакомится в этой теме.

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Poseidon, Rodman
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Центр помощи | Следующая тема »

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


 




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


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

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