Модератор: Модераторы
minoshi » 07.10.2009 13:21:50
- Код: Выделить всё
procedure tmainfo.FindFile(dir, searchedfile:String; absalutfind,firstfindonly : boolean);
//dir - каталог в котором ищем, searchedfile - имя искомого файла,
//absalutfind - ищем полное совпадение
//firstfindonly - ищем только первый файл
Var fs : TSearchRec;
begin
if (length(dir)>0)and(dir[1] <> '/')
then dir := '/' + dir; //вдруг забудут первый слэш :)
if dir = '/' //необходимо, т.к. далее идет findfirst(dir + '/*'...
then dir := '';
stopsearch := false;
findfirst(dir + '/*',faAnyFile,fs);
repeat
application.ProcessMessages;
if (fs.Name='') //(fs.Name='') включать обязательно
or(fs.Name='.') //если указатель на текущий каталог
or (fs.Name='..') //если указатель на родительский каталог
then continue;
if absalutfind //абсалютный поиск
then begin
if searchedfile = fs.Name
then begin
tstringgrid1.appendrow(dir + '/' + fs.Name); //выводим имя найденного файла куда-то, в данном случае на tstringgrid1
if firstfindonly //если ищем только первый файл
then stopsearch := true;
end;
end
else begin
if substrpos(searchedfile,fs.Name) > 0 //проверку на совпадение проводим сразу,
then begin //возможно мы ищем каталог или ссылку
tstringgrid1.appendrow(dir + '/' + fs.Name);
if firstfindonly
then stopsearch := true; //если ищем только первый файл
end;
end;
if stopsearch
then begin
findclose(fs);
exit;
end;
if fpReadLink(dir+ '/' +fs.Name) <> //если линк, то пропускаем,
then continue; //чтобы избежать циклических ссылок
if ((fs.Attr and faDirectory) <> 0) //если каталог,
then findfile(dir + '/' + fs.name, searchedfile, absalutfind, firstfindonly);//то запускаем эту же функцию,
//но с новым каталогом
until findnext(fs) <> 0;
findclose(fs);
end;
-

minoshi
- постоялец
-
- Сообщения: 279
- Зарегистрирован: 17.05.2008 21:23:38
Padre_Mortius » 13.06.2011 15:31:17
Добавлю еще один момент. В качестве маски имен файлов лучше всего использовать переменную AllFilesMask
-
Padre_Mortius
- энтузиаст
-
- Сообщения: 1265
- Зарегистрирован: 29.05.2007 17:38:07
- Откуда: Спб
Вернуться в Файловая система
Кто сейчас на конференции
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0