Помощь - Поиск - Пользователи - Календарь
Полная версия: работа с файлами через fp в win
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Free Pascal, Pascal ABC и другие
compiler
Добрый день!
Надо написать утилитку на работу с файлами, но никак не получается ...
Вопрос в следующем: как имея адрес файла получить его "SearchRec", в частности Attr...
заранее благодарен.


OS: winXP.
компилятор: fpc 2.2.0, mode objfpc.
библиотеки: dos.
volvo
Ты про это:
{$mode objfpc}
uses dos;
var
FileInfo: SearchRec;
begin
FindFirst('G:\test.pp', AnyFile, FileInfo);
if DosError = 0 then begin
writeln('Attr = ', FileInfo.Attr);
end;
end.
?
compiler
Цитата(volvo @ 9.04.2008 21:50) *
Ты про это ?
да, спасибо... только у меня возникает постоянно DosError = 18 sad.gif Из-за чего это может быть?

ps
я тут еще нашел GetFAttr, которая должна делать это же, но ситуация аналогична...
о GetFAttr в html инфу нашел в /fpcDoc/rtl/dos/getfattr.html (доки к прошлой версии)
volvo
DosError = 18 - значит "искомые файлы (при поиске по шаблонам) исчерпаны"
compiler
Огромное спасибо!
compiler
вобщем написать то я написал и даже откомпилировал smile.gif
но вот не задача она работает не как я хочу( , а я хочу всего-лишь найти все файлы которые не удается прочитать начиная с рабочей директории...
то, что у меня получилось:

{$mode objfpc}
uses dos;
const SLASH ='\';
var
workdir: string;

function getworkdir():string;
{return work directory}
var
workdir: string;
workd: word; { use as zerro:) }
begin
getdir(workd, workdir);
getworkdir := workdir
end;


function getname(const sr:SearchRec):string;
{SearchRec -> file name}
begin
getname := sr.name;
end;

function getatr(const sr:SearchRec):longint;
{SearchRec -> attr}
begin
getatr := sr.attr;
end;

function ifdir(const path:string):boolean;
{if it's directory}
function getattr(const path:string):word;
{Path -> attr}
var f:file;
begin
assign(f, path);
GetFAttr(f, result);
end;
begin
ifdir := getAttr(path) = directory;
end;

function ifread(const str:string):boolean;
{is file can be read?
if file is directory then false
result print}
var
f:file;
begin
ifread:=false;
if not ifdir(str) then begin
assign(f,'str');
{$I-} reset(f); {$I+}
if IOResult <> 0 then begin writeln('-', str); readln; read; end
else begin ifread:=true; writeln('+', str); readln; read; end;
end;
end;

procedure getunread(const fw:string);
{print unread files
function change work directory!}
var
sr:SearchRec;
begin
FindFirst('*', AnyFile, sr); //все файлы, типа инициализации
ifread(fw); //проверяем на доступность переданный файл
FindNext(sr); //получаем следующий файл
if doserror = 18 then //если в директории еще есть файлы?
if getworkdir <> workdir then ChDir ('..'+SLASH) //нет. переходим на каталог выше
else
if sr.attr = directory then begin //обнаружена директория, переходим в нее
chdir(fw+getname(sr)+SLASH);
getunread(fw+getname(sr)+SLASH);
end else
ifread(getname(sr)); //обнаружен файл, проверяем его
end;

begin
workdir:=getworkdir(); //сохраняем рабочую директорию
getunread(workdir); //ищем
ChDir(workdir); //восстанавливаем дирректорию
end.



заранее благодарен.

upd
прошу прощение за комментарии на английском, сейчас тестирую несколько новых IDE, поэтому дабы избежать проблем с кодировкой...

upd2
добавлены комментарии по алгоритму..
volvo
Так... А теперь подробнее - что именно у тебя не получается? Твоя программа должна компилироваться, насколько я вижу, уточни, что именно тебя в ней не устраивает.
compiler
Цитата(volvo @ 10.04.2008 17:14) *
Так... А теперь подробнее - что именно у тебя не получается? Твоя программа должна компилироваться, насколько я вижу, уточни, что именно тебя в ней не устраивает.
я хочу что б программа нашла все файлы которые не удается прочитать начиная с рабочей директории...
запускаю программу в на диске D:(где у меня установлен windows) и вместо списка недоступных файлов(например, D:\WINDOWS\system32\config\SAM) получаю непонятно что...
volvo
Что значит "не удается прочитать"? Те файлы, при попытке чтения которых возникает ошибка ввода/вывода, или те, для которых ошибка возникает уже при открытии?

Мне твоя программа вообще ничего не выдает кстати, она просто тихо валится с Segmentation Fault вот на этой строке:
...
getdir(workd, workdir); // <---
getworkdir := workdir
...

, и правильно делает... Кто будет инициализировать workd?
compiler
Цитата(volvo @ 10.04.2008 17:34) *
Что значит "не удается прочитать"? Те файлы, при попытке чтения которых возникает ошибка ввода/вывода, или те, для которых ошибка возникает уже при открытии?
не понял разницы..
Цитата(volvo @ 10.04.2008 17:34) *
Мне твоя программа вообще ничего не выдает кстати, она просто тихо валится с Segmentation Fault, и правильно делает... Кто будет инициализировать workd?
чесно говоря я не понял зачем этот параметр, для того что б иметь рабочии директории на каждом устройстве? тогда надо забивать туда ноль?
volvo
Цитата
я не понял зачем этот параметр
У тебя GetDir возвращает текущую директорию... ГДЕ? На каком диске? Это и указывается первым параметром процедуры... При передаче 0 ты получишь текущую папку на диске, с которого запускалась программа, чтобы получить это для D:, надо передать 4...

Хм... Так тебе что, рекурсивный поиск по всему диску с проверкой всех файлов, надо? Тогда поправляй процедуры вот так:

// здесь readln-ы я убрал, чтоб не щелкать по enter-у постоянно...
function ifread(const str:string):boolean;
var
f: file;
begin
ifread:=false;
if not ifdir(str) then begin
assign(f, str); // Почему у тебя была СТРОКА 'str', а не ее содержимое?
{$I-} reset(f); {$I+}
if IOResult <> 0 then begin
writeln('-', str);
end
else begin
ifread := true;
writeln('+', str);
end;
end;
end;

procedure getunread(const fw: string);
var
sr: SearchRec;
begin
ifread(fw);
chdir(fw);

FindFirst('*.*', AnyFile, sr);
while DosError = 0 do begin

if (sr.name <> '.') and (sr.name <> '..') then begin

if (sr.attr and directory = directory) then begin
getunread(fw + sr.name + slash);
end
else ifread(fw + getname(sr));

end;

FindNext(sr);

end;
end;

compiler
Цитата(volvo @ 10.04.2008 18:33) *
Хм... Так тебе что, рекурсивный поиск по всему диску с проверкой всех файлов, надо?
да, только не по всему, а начиная с текущей директории...

несколько вопросов по процедурам:
зачем
 if (sr.name <> '.') and (sr.name <> '..') then begin
?
где можна прочитать о сравнивании attr с directory? я об этом
 (sr.attr and directory = directory) 
наверно ifdir() тоже надо переписывать..

да, а с str баг получился)
volvo
Цитата(compiler @ 10.04.2008 21:14) *
да, только не по всему, а начиная с текущей директории...
Ну, это не имеет значения в данном случае, рекурсия будет работать, начиная с того пути, который ты туда передашь, хоть корень диска, хоть что... Главное - чтобы параметр, передаваемый в getunread завершался слэшем...


Цитата(compiler @ 10.04.2008 21:14) *
зачем
 if (sr.name <> '.') and (sr.name <> '..') then begin
?
Затем, чтобы не перемещаться бесконтрольно по папкам туда-сюда... Ну, не ограничишь ты перемещение по '.', так и будешь ходить постоянно в одной и той же папке - это ж ссылка из папки на саму себя. И зачем тебе опять возвращаться в папку уровнем выше (через '..'), если ты только что оттуда пришел? Лишние действия убираем...

Цитата(compiler @ 10.04.2008 21:14) *
где можна прочитать о сравнивании attr с directory? я об этом
 (sr.attr and directory = directory) 
наверно ifdir() тоже надо переписывать..

А это не сравнивание... Никто не обещал, что в поле Attr будет храниться Directory в чистом виде (то есть, поле Attr не должно быть равно $10), в этом байте просто будет установлен бит xxx1xxxx, а как проверяется, установлен ли бит? Правильно,
if value and mask = mask then ...

Что и было сделано...

А насчет ifdir - я просто не заметил его, да, там тоже надо менять, хотя по-моему было бы проще заменить функцию на дополнительный параметр для ifread:
function ifread(const str:string; const ifdir: boolean = true): boolean;
var
f: file;
begin
ifread:=false;
if not ifdir then begin ...

, а ниже -

...
if (sr.attr and directory = directory) then begin
getunread(fw + sr.name + slash);
end
else ifread(fw + getname(sr), false); // <---
...
, опять же, не надо делать одну и ту же работу дважды, ты ж уже знаешь, папка это или нет, зачем еще раз проверять???

Добавлено через 13 мин.
А можно пойти еще дальше, и вообще не вызывать ifread нигде, кроме как в ветке Else после проверки, папка ли это... Тогда тебе не надо ни функции ifdir(), ни дополнительного параметра... Если уж пришел в ifread() - значит, это файл. Сразу проверяй его и все...
compiler
огромное спасибо, всё тайное стало явным... или не совсем всё..
Цитата(volvo @ 10.04.2008 22:02) *
Затем, чтобы не перемещаться бесконтрольно по папкам туда-сюда... Ну, не ограничишь ты перемещение по '.', так и будешь ходить постоянно в одной и той же папке - это ж ссылка из папки на саму себя. И зачем тебе опять возвращаться в папку уровнем выше (через '..'), если ты только что оттуда пришел? Лишние действия убираем...
забавно, а откуда берутся такие папки? такие ссылки помещаются в каждую директорию и скрываются от глаз пользователя или это есть что - то виртуальное?
Цитата(volvo @ 10.04.2008 22:02) *
А можно пойти еще дальше
ну это уже потом...


volvo
Цитата
а откуда берутся такие папки? такие ссылки помещаются в каждую директорию и скрываются от глаз пользователя или это есть что - то виртуальное?
Ты никогда в консоли не набирал DIR, и не видел '.' и '..' (в самом начале) в результате выполнения?

cd .. для перехода в родительскую папку тоже не делал? Очень удобно... smile.gif Да и одинарной точкой тоже иногда приходилось пользоваться...
compiler
Цитата(volvo @ 10.04.2008 23:05) *
Ты никогда в консоли не набирал DIR, и не видел '.' и '..' (в самом начале) в результате выполнения?
никогда не пользовался этой командой, как я понял, это аналог ls в никсах... Но ls скрывает эти папки(без ключа -a или --all) и я их никогда не видел...
Цитата(volvo @ 10.04.2008 23:05) *
cd .. для перехода в родительскую папку тоже не делал?
cd делал, но не имел представления о механизме...
Цитата(volvo @ 10.04.2008 23:05) *
Да и одинарной точкой тоже иногда приходилось пользоваться...
особенно если текущий каталог не прописан в окружение smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.