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


Автор: svarogik 27.7.2006, 21:51
Можно ли просканировать папку на наличие файлов с определенным расширением? (в моем случае *.bmp) и если присутствуют  то выполнить какие то действия, и продолжить сканирование. 

Автор: Alexeis 27.7.2006, 21:59
http://forum.vingrad.ru/index.php?act=module&module=vingradfaq&target=main_panel&article=2507

Добавлено @ 21:59 
http://forum.vingrad.ru/index.php?act=module&module=vingradfaq&target=main_panel&article=989

Добавлено @ 22:00 
http://forum.vingrad.ru/index.php?act=module&module=vingradfaq&target=main_panel&article=993 

Автор: svarogik 27.7.2006, 22:02
что значитпо заданной маске? расширение считается? 

Автор: Albinos_x 27.7.2006, 22:19
вот простой пример поиска на винте файлов *.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);  
  ...
  

Автор: Alexeis 27.7.2006, 22:33
Цитата(svarogik @  27.7.2006,  22:02 Найти цитируемый пост)
что значитпо заданной маске? расширение считается? 

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

Автор: Демо 27.7.2006, 23:01
Кобимбинируй простой поиск файлов без маски и 

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 

Автор: Poseidon 28.7.2006, 00:05
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  {...}

 

Автор: Демо 28.7.2006, 00:26
Цитата(Poseidon @  28.7.2006,  00:05 Найти цитируемый пост)
Не проще-ли сразу фильтровать?


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

Автор: Poseidon 28.7.2006, 00:41
Цитата(Демо @  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; 


 

Автор: Albinos_x 28.7.2006, 12:39
эффект не намного лучше получится...имхо... 

Автор: svarogik 28.7.2006, 14:03
 с этим постараюсь разобраться, а можно еще маленкий вопросик, модераторы не хотелось отдельный топик создавать. Файл заявлен TFilestream как записать в файл переход на следующую строчку, у меня есть мысль, не знаю бредовая или нет, записать в файл символы #13 #10 но не получается вместо этого он пишет решетки. И можно ли писать последовательно, не прибегая к file.seek(,) 

Автор: Alexeis 28.7.2006, 14:32
Код

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(,) 

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

Автор: svarogik 28.7.2006, 14:53
если я сделаю так
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? 

Автор: Демо 28.7.2006, 14:56
Цитата(Albinos_x @  28.7.2006,  12:39 Найти цитируемый пост)
эффект не намного лучше получится...имхо... 


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

  

Автор: Alexeis 28.7.2006, 14:58
shortstring - это паскалевская строка.
writebuffer- процедура записи в поток данных любого типа. 

Автор: Демо 28.7.2006, 15:00
Цитата(alexeis1 @  28.7.2006,  14:58 Найти цитируемый пост)
writebuffer- процедура записи в поток данных любого типа. 


Как и TStream.Write 

Автор: Albinos_x 28.7.2006, 15:13
Цитата(Демо @  28.7.2006,  14:56 Найти цитируемый пост)
сканирование будет идти в любом случае по всем файлам


я о том же... 

Автор: Alexeis 28.7.2006, 15:21
Цитата(Демо @  28.7.2006,  15:00 Найти цитируемый пост)
Как и TStream.Write 

с одной разницей, если не удалось записать буфер в поток, то 
WriteBuffer - сильно матерится, тогда как Write - спокойно молчит. 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)