procedure TForm1.FormCreate(Sender: TObject);
var
r: tsearchrec;
begin // поиск на диске D
chdir('D:\');
if findfirst('*', faanyfile, r)= 0 then
repeat
/////////////// если doc - файл
// if extractfileext(expandfilename(r.Name))='.doc' then
/////или вот так
if pos('.doc',r.Name)>0 then showmessage(expandfilename(r.Name));
////////////если директория
else chdir(r.Name+'\');
showmessage(getcurrentdir);
until findnext(r)<>0;
findclose(r);
end;
end.
поиск файлов на дисках
Задачу такая : нужно найти все файлы *.doc на дисках С и D и показать найденные файлы. Вот что у меня получилось, но с ошибками. Подскажите, что не так:
[COLOR=purple]при написании кода, пользуйтесь пожалуйста тэгами[/COLOR] [COLOR=blue][ code ] [ /code ][/COLOR]
Код:
[COLOR=purple]при написании кода, пользуйтесь пожалуйста тэгами[/COLOR] [COLOR=blue][ code ] [ /code ][/COLOR]
[QUOTE=GRIENDERS]Задачу такая : нужно найти все файлы *.doc на дисках С и D и показать найденные файлы. Вот что у меня получилось, но с ошибками. Подскажите, что не так:
procedure TForm1.FormCreate(Sender: TObject);
var
r: tsearchrec;
begin // поиск на диске D
chdir('D:\');
if findfirst('*', faanyfile, r)= 0 then
repeat
/////////////// если doc - файл
// if extractfileext(expandfilename(r.Name))='.doc' then
/////или вот так
if pos('.doc',r.Name)>0 then showmessage(expandfilename(r.Name));
////////////если директория
else chdir(r.Name+'\');
showmessage(getcurrentdir);
until findnext(r)<>0;
findclose(r);
end;
end.[/QUOTE]
Во-первых, если тебе нужно конкретно по маске *.doc, то так и пиши в вызове FindFirst
Во-вторых, данный алгоритм найдет файлы только для корневого каталога, необходимо написать рекурсивную функцию, которая будет "заходить" во все каталоги текущего просмотра и искать и там такие файлы
procedure TForm1.FormCreate(Sender: TObject);
var
r: tsearchrec;
begin // поиск на диске D
chdir('D:\');
if findfirst('*', faanyfile, r)= 0 then
repeat
/////////////// если doc - файл
// if extractfileext(expandfilename(r.Name))='.doc' then
/////или вот так
if pos('.doc',r.Name)>0 then showmessage(expandfilename(r.Name));
////////////если директория
else chdir(r.Name+'\');
showmessage(getcurrentdir);
until findnext(r)<>0;
findclose(r);
end;
end.[/QUOTE]
Во-первых, если тебе нужно конкретно по маске *.doc, то так и пиши в вызове FindFirst
Во-вторых, данный алгоритм найдет файлы только для корневого каталога, необходимо написать рекурсивную функцию, которая будет "заходить" во все каталоги текущего просмотра и искать и там такие файлы
извиняюсь, не усмотрел части кода с переходом по каталогам
попробуй искать так:
Код:
if findfirst('d:\*', faanyfile, r)<> 0 then exit;
while findnext(r)=0 do
if (r.Attr and faDirectory)=0 then
if extractfileext(r.Name)='.doc' then showmessage('во как!');
findclose(r);
while findnext(r)=0 do
if (r.Attr and faDirectory)=0 then
if extractfileext(r.Name)='.doc' then showmessage('во как!');
findclose(r);
[quote=DrCoder]необходимо написать рекурсивную функцию, которая будет "заходить" во все каталоги текущего просмотра и искать и там такие файлы[/quote]
а также заходить в подкаталоги этих каталогов и т.д.
+ к этому нужно будет еще из этих каталогов "выходить"
а еще нужно запоминать в какие каталоги уже заходили (запоминать такие каталоги лучше при выходе из него)
так... к слову....
Помню писал такой алгоритм, только при нахождении какого-нибудь файла не месаги показывало, а грохало этот файл. Ну и однажды случилось большое несчастье, думаю вы уже догадались что произошло, и код этого алгоритма исчез нафиг тоже, а так бы выложил сюда.
а также заходить в подкаталоги этих каталогов и т.д.
+ к этому нужно будет еще из этих каталогов "выходить"
а еще нужно запоминать в какие каталоги уже заходили (запоминать такие каталоги лучше при выходе из него)
так... к слову....
Помню писал такой алгоритм, только при нахождении какого-нибудь файла не месаги показывало, а грохало этот файл. Ну и однажды случилось большое несчастье, думаю вы уже догадались что произошло, и код этого алгоритма исчез нафиг тоже, а так бы выложил сюда.
Код:
procedure FindFile(Dir: String; Ext: String; var Strings: TStrings);
var
SearchRec: TSearchRec;
begin
Form1.Label1.Caption := Dir;
Form1.Update;
Ext := UpperCase(Ext);
if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
if (SearchRec.Attr and faDirectory) = faDirectory then FindFile(Dir + SearchRec.Name + '\', Ext, Strings)
else if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext then Strings.Add(Dir + SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
begin
SL := TStringList.Create;
FindFile('C:\', '.doc', SL);
Label1.Caption := IntToStr(SL.Count);
ListBox1.Items.Assign(SL);
SL.Free;
end;
var
SearchRec: TSearchRec;
begin
Form1.Label1.Caption := Dir;
Form1.Update;
Ext := UpperCase(Ext);
if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
if (SearchRec.Attr and faDirectory) = faDirectory then FindFile(Dir + SearchRec.Name + '\', Ext, Strings)
else if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext then Strings.Add(Dir + SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
begin
SL := TStringList.Create;
FindFile('C:\', '.doc', SL);
Label1.Caption := IntToStr(SL.Count);
ListBox1.Items.Assign(SL);
SL.Free;
end;
[QUOTE=LastSoul]а также заходить в подкаталоги этих каталогов и т.д.
+ к этому нужно будет еще из этих каталогов "выходить"
а еще нужно запоминать в какие каталоги уже заходили (запоминать такие каталоги лучше при выходе из него)
так... к слову....
Помню писал такой алгоритм, только при нахождении какого-нибудь файла не месаги показывало, а грохало этот файл. Ну и однажды случилось большое несчастье, думаю вы уже догадались что произошло, и код этого алгоритма исчез нафиг тоже, а так бы выложил сюда.[/QUOTE]
У меня аналогичная задача - подбросить ламерюге прогу, которая будет на все doc-ие файлы ставить пароль через Word. Проблема только в их поиске.
+ к этому нужно будет еще из этих каталогов "выходить"
а еще нужно запоминать в какие каталоги уже заходили (запоминать такие каталоги лучше при выходе из него)
так... к слову....
Помню писал такой алгоритм, только при нахождении какого-нибудь файла не месаги показывало, а грохало этот файл. Ну и однажды случилось большое несчастье, думаю вы уже догадались что произошло, и код этого алгоритма исчез нафиг тоже, а так бы выложил сюда.[/QUOTE]
У меня аналогичная задача - подбросить ламерюге прогу, которая будет на все doc-ие файлы ставить пароль через Word. Проблема только в их поиске.
ну ты злодей :)))
[QUOTE=verybadbug]
[/QUOTE]
Спасибо, все работает. Вот только парочка вопросов:
1.Что значит if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then...
2. Что такое if (SearchRec.Attr and faDirectory) = faDirectory then ...
Можно ли написать так if SearchRec.Attr = faDirectory then ...
3. А для чего вот это if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext
Код:
procedure FindFile(Dir: String; Ext: String; var Strings: TStrings);
var
SearchRec: TSearchRec;
begin
Form1.Label1.Caption := Dir;
Form1.Update;
Ext := UpperCase(Ext);
if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
if (SearchRec.Attr and faDirectory) = faDirectory then FindFile(Dir + SearchRec.Name + '\', Ext, Strings)
else if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext then Strings.Add(Dir + SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
begin
SL := TStringList.Create;
FindFile('C:\', '.doc', SL);
Label1.Caption := IntToStr(SL.Count);
ListBox1.Items.Assign(SL);
SL.Free;
end;
var
SearchRec: TSearchRec;
begin
Form1.Label1.Caption := Dir;
Form1.Update;
Ext := UpperCase(Ext);
if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
if (SearchRec.Attr and faDirectory) = faDirectory then FindFile(Dir + SearchRec.Name + '\', Ext, Strings)
else if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext then Strings.Add(Dir + SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
begin
SL := TStringList.Create;
FindFile('C:\', '.doc', SL);
Label1.Caption := IntToStr(SL.Count);
ListBox1.Items.Assign(SL);
SL.Free;
end;
Спасибо, все работает. Вот только парочка вопросов:
1.Что значит if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then...
2. Что такое if (SearchRec.Attr and faDirectory) = faDirectory then ...
Можно ли написать так if SearchRec.Attr = faDirectory then ...
3. А для чего вот это if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext
[QUOTE=GRIENDERS]
1.Что значит if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then...
[/QUOTE]
Они идут первыми в списке директорий. '..' - переход вверх
[QUOTE=GRIENDERS]
2. Что такое if (SearchRec.Attr and faDirectory) = faDirectory then ...
Можно ли написать так if SearchRec.Attr = faDirectory then ...
[/QUOTE]
SearchRec.Attr - набор флагов. SearchRec.Attr and faDirectory проверяет, установлен ли флаг faDirectory. Если написать if SearchRec.Attr = faDirectory then, и при этом установлены и другие флаги - условие не выполнится.
[QUOTE=GRIENDERS]
3. А для чего вот это if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext[/QUOTE]
Чтобы сделать все буквы в строке заглавными.
1.Что значит if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then...
[/QUOTE]
Они идут первыми в списке директорий. '..' - переход вверх
[QUOTE=GRIENDERS]
2. Что такое if (SearchRec.Attr and faDirectory) = faDirectory then ...
Можно ли написать так if SearchRec.Attr = faDirectory then ...
[/QUOTE]
SearchRec.Attr - набор флагов. SearchRec.Attr and faDirectory проверяет, установлен ли флаг faDirectory. Если написать if SearchRec.Attr = faDirectory then, и при этом установлены и другие флаги - условие не выполнится.
[QUOTE=GRIENDERS]
3. А для чего вот это if UpperCase(ExtractFileExt(SearchRec.Name)) = Ext[/QUOTE]
Чтобы сделать все буквы в строке заглавными.
no comment.... :)