программный поиск файлов в linux
Добавлено: 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;