IPB
ЛогинПароль:

 
 Ответить  Открыть новую тему 
> FPC, удаление директорий и файлов, было: Помогите с процедурой на FPC!
Билли Боб
сообщение 18.08.2011 22:54
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Процедура удаляет папку со всеми файлами и подпапками.


procedure DELE (fd: string);
var
s: searchrec;
f: file;
delf,delfiles: string;

function STAT (fd: string): string;
var s: searchrec;
begin
stat:='';
findfirst(fd,anyfile,s); if doserror<>0 then exit;
if s.attr=VolumeID then findnext(s); if doserror<>0 then exit;
if (s.attr>=16)and(s.attr<=23) or (s.attr>=48)and(s.attr<=55)
then stat:='D' else stat:='F';
end;

begin
if stat(fd)='F' then begin assign(f,fd); setfattr(f,0); erase(f) end;
if stat(fd)='D' then
begin
delfiles:=fd+'\*.*';
findfirst(delfiles,anyfile,s);
while doserror=0 do
begin
delf:=fd+'\'+s.name;
if (s.name<>'.')and(s.name<>'..')and(s.name<>'') then
begin
if stat(delf)='F' then dele(delf);
if stat(delf)='D' then
begin
{$I-}rmdir(delf);{$I+}
if ioresult=5 then dele(delf)
end;
end;
findnext(s);
end;
rmdir(fd);
end;
end;



На TP работает, а вот на FPC как-то криво работает. Что-то удаляет,а что-то нет. Если указать просто пустой каталог, то даже его не удаляет.
В чем проблема?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 19.08.2011 5:15
Сообщение #2


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Билли Боб @ 18.08.2011 23:54) *
На TP работает, а вот на FPC как-то криво работает. Что-то удаляет,а что-то нет. Если указать просто пустой каталог, то даже его не удаляет.
В чем проблема?

Проблема в том, что в FP поиск файлов устроен несколько иначе. Тебе нужно после использования FindFirst и FindNext сначала закрыть поиск процедурой FindClose(var f: SearchRec), а потом уже удалять директорию процедурой rmdir. В качестве параметра для FindClose используй ту самую запись, с которой ты делал поиск. Если ты этого не сделаешь, то вообще-то директория все равно удалится, но только после завершения программы (что неприемлемо во многих случаях), поскольку незакрытый поиск держит ее.

Даже если не удаляешь ничего - все равно закрывай поиск, это right thing to do.

А вообще, советую посмотреть еще раз на логику программы, она явно нуждается в улучшении. Например, эти две строки:
   if stat(fd)='F' then begin assign(f,fd); setfattr(f,0); erase(f) end;
if stat(fd)='D' then
Тут ты два раза вызываешь одну и ту же функцию с тем же параметром: stat(fd). Спрашивается - зачем? Можно, например, заменить на такое:
case stat(fd) of
'F': begin ... end;
'D': begin .. end;
end;

Далеко вглубь я не смотрел пока, исправь эти ошибки - тогда продолжим разбор, если хочешь.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 19.08.2011 11:56
Сообщение #3


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


М
Тему переношу в раздел "32-битные компиляторы" и меняю название



--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 0:21
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Благодарю! C FindClose все отлично работает, и за CASE спасибо!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
IUnknown
сообщение 20.08.2011 9:46
Сообщение #5


a.k.a. volvo877
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской

Репутация: -  627  +


Билли Боб, не знаю, сделал ты это или нет, но при работе с FPC от модуля DOS надо бы избавляться. И цикл перебора должен быть не
findfirst(...);
while doserror=0 do
begin
// ...
findnext(s);
end;

, а
if findfirst(...) then
repeat
// ...
until findnext(s) <> 0;


(и FindFirst и FindNext здесь - функции, результат их работы сигнализирует об успехе)

Сообщение отредактировано: IUnknown - 20.08.2011 10:53
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 17:56
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


так выходит ошибка: Incompatible types: got "untyped" expected "LongInt"
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
IUnknown
сообщение 20.08.2011 18:27
Сообщение #7


a.k.a. volvo877
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской

Репутация: -  627  +


Цитата
так выходит ошибка: Incompatible types: got "untyped" expected "LongInt"
Как "так"? Почему у меня не выходит?

uses sysutils;

procedure DELE (fd: string);

function stat (fd : string) : char; // Char - для того, чтобы можно было использовать в Case
var s: tsearchrec;
begin
stat:=#0;
if findfirst(fd,faanyfile,s) <> 0 then exit;

if s.attr = faVolumeID then
if findnext(s) <> 0 then exit;

if (s.attr>=16) and (s.attr<=23) or
(s.attr>=48) and (s.attr<=55)
then
stat:='D'
else
stat:='F';
end;

var
s : tsearchrec;
f : file;
delf, delfiles : string;

begin
case stat(fd) of
'F' : begin
// assign(f,fd); setfattr(f,0); erase(f)
// используется filesetattr из SysUtils вместо досовского setfattr
end;
'D' : begin
delfiles:=fd+'\*.*';
if findfirst(delfiles,faanyfile,s) <> 0 then
repeat
delf:=fd+'\'+s.name;
if (s.name<>'.')and(s.name<>'..')and(s.name<>'') then
begin
case stat(delf) of
'F': dele(delf);
'D': begin
{$I-} rmdir(delf); {$I+}
if ioresult = 5 then dele(delf)
end;
end; // case
end;
until findnext(s) <> 0;
findclose(s);

rmdir(fd);
end;
end; // case;
end;

begin
// ...
end.


Ничего не менял в логике работы (хотя тут тоже есть, на что обратить внимание), просто добавил нужный модуль и поменял цикл. Компиляцию проходит успешно. FPC 2.4.4 ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 19:04
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Оказывается надо было убрать модуль DOS после USES.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 22:07
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Почему программа зависает, когда я пишу: uses sysu...и тут виснет

даже просто в любом месте пишу sysu, и зависает

Сообщение отредактировано: Билли Боб - 20.08.2011 22:08
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
IUnknown
сообщение 20.08.2011 22:33
Сообщение #10


a.k.a. volvo877
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской

Репутация: -  627  +


Цитата
даже просто в любом месте пишу sysu, и зависает
Хм... Интересно. Сама среда разработки зависает? А ты чем пользуешься, "родной" IDE? Ни разу с таким не сталкивался, чтобы какое-то определенное сочетание символов приводило к зависанию среды FPC. Ну, напечатай это слово в Блокноте, и скопируй в программу, там в меню Edit должно быть Paste from Windows.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 22:41
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Не знаю, как это получилось, но еще зависало когда печатал syst, хотя если напечатать sys, а через пробел utils, то после удаления пробела все нормально. Вообщем решилась проблема удалением файла fp.dsk.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Билли Боб
сообщение 20.08.2011 23:48
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Как сделать курсор снова маленьким? а то после cursorbig он остался большим, хоть я и убрал эту строку.

и как сделать, чтобы дата datetimetostring на русском отображалась?

Сообщение отредактировано: Билли Боб - 21.08.2011 0:04
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 21.08.2011 11:27
Сообщение #13


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Билли Боб @ 21.08.2011 0:48) *
Как сделать курсор снова маленьким? а то после cursorbig он остался большим, хоть я и убрал эту строку.

и как сделать, чтобы дата datetimetostring на русском отображалась?

Билли, пожалуйста, не флуди. Что тема начата тобой - совсем не значит, что тебе в ней позволено все. Будь добр, говори по предмету этого треда. А если есть еще вопросы - пожалуйста, начинай новые темы. И объясни в них существо вопроса поподробнее.
Спасибо за внимание.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
2 чел. читают эту тему (гостей: 2, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 28.03.2024 13:57
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"