VPF::Папки в pascal - Форум программистов

Proxin

Дата 17.5.2009, 14:23 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 363
Регистрация: 21.6.2008

Репутация: нет
Всего: 3

Здравствуйте. Пишу в обычном TP 7.0.

Собственно - вопроc. Как удалить папку, если она не пуста, а в ней есть ещё папки и файлы?
Пытался так

Код


procedure CatRem(PathToCat:string);
var s:searchrec;f:file;
begin
{$I-}
FindFirst('*.*',Directory,s);
while doserror=0 do
begin
if (s.name<>'.') and (s.name<>'..') then
if s.attr and Directory<>0  then
if pathtocat[length(pathtocat)]='\' then CatRem(pathtocat+s.name) else
CatRem(pathtocat+'\'+s.name);
FindNext(s);
end;
FindFirst('*.*',AnyFile,s);
while doserror=0 do
if (s.name<>'.') or (s.name<>'..') then begin
assign(f,PathToCat+'\'+s.name);
erase(f);
end;
rmdir(PathToCat);
{$I+}
end;

Но получаю ошибку stack overflow. Даже если директория с одним файлом. Как очистить стёк - есть ли команда, какая-то, или идея изначально неправильна?

И - как переименовать папку? Только с помощью кописрования всех вложенных файлов и папок в директорию с новым именем и последующим удалением старой? Или есть какой-то метод, как во freepascal?

Это сообщение отредактировал(а) Proxin - 17.5.2009, 14:25

Данкинг

Дата 17.5.2009, 14:25 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: нет
Всего: 130

Цитата(Proxin @ 17.5.2009, 15:23

)

Как удалить папку, если она не пуста, а в ней есть ещё папки и файлы?

Удалить сначала все файлы, а потом и саму папку. smile

--------------------

There's nothing left but silent epitaphs.

Proxin

Дата 17.5.2009, 14:28 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 363
Регистрация: 21.6.2008

Репутация: нет
Всего: 3

Я так и делаю, но возникает переполнение стёка.
Уважаемый, вы можете посмотреть мой код и указать на ошибку?

Proxin

Дата 17.5.2009, 22:43 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 363
Регистрация: 21.6.2008

Репутация: нет
Всего: 3

Как избежать переполнения стёка тут(код ниже, в этом посте)? Товарищ, есть же код - сложно помочь и показать ошибку?

Код


procedure CatFullRem(PathToCat:string);
var srec:searchrec;
    f:file;
    s,d:string;
begin
s:=pathtocat;
if not (pathtocat[length(pathtocat)]='\') then s:=s+'\';
d:=s;
s:=s+'*.*'; {owl:)}
FindFirst(s,AnyFile,srec);
while doserror = 0 do begin
if (srec.attr and directory) = 0 then begin assign(f,d+srec.name); erase(f); end;
if (srec.attr and directory) <> 0 then CatFullRem(d+srec.name+'\'); {подозреваю, что ругается на эу строчку}
FindNext(srec);
end;
{$I-}
rmdir(pathtocat);
end;

volvo877

Дата 19.5.2009, 10:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Цитата(Proxin @ 17.5.2009, 22:43

)

Как избежать переполнения стёка тут

Обрабатывать еще и '.' и '..' отдельно... Иначе у тебя программа точно войдет в бесконечную рекурсию. В общем, вот это:

Код

procedure CatFullRem(PathToCat:string);
var srec:searchrec;
    f:file;
    s,d:string;
begin
  s:=pathtocat;
  if not (pathtocat[length(pathtocat)]='\') then s:=s+'\';
  d:=s;
  s:=s+'*.*';
  FindFirst(s,AnyFile,srec);
  while doserror = 0 do begin
    if (srec.name <> '.') and (srec.name <> '..') then begin
      if (srec.attr and directory) = 0 then begin
        assign(f,d+srec.name); erase(f);
      end
      else CatFullRem(d+srec.name+'\');
    end;
    FindNext(srec);
  end;

  if pathtocat[length(pathtocat)]='\' then
    delete(pathtocat, length(pathtocat), 1);
  rmdir(pathtocat);
end;

прекрасно удаляет указанную папку, если даже она не была пустой. Проверено в TP7... Насчет 32-битных компиляторов - есть сомнения, что это сработает...

Proxin

Дата 19.5.2009, 23:05 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 363
Регистрация: 21.6.2008

Репутация: нет
Всего: 3

Спасибо, товарищ - большущее-пребольшущее вам.

Proxin

Дата 20.5.2009, 21:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 363
Регистрация: 21.6.2008

Репутация: нет
Всего: 3

Чтоб не быть уж совсем невежливым - ловите. Сам доехал, как переименовывать папки.

Код


uses dos;
procedure CatRename(path,newname:string);
begin
{$M 2048,0,0}
if path[length(path)]='\' then delete(path,length(path),1);
swapvectors;
exec('C:\WINDOWS\system32\cmd.exe','/C ren '+path+' '+newname);
swapvectors;
end;

Пользуйте, кому интересно.
Если кто из старожил в тему заглянет - если тут неправильно, подкорректируйте, пожалуйста.
Так же, можно как-нибудь обойтись без командной строки при переименовании, и, если да, то насколько экономичней по ресурсам будет?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »