Процедура удаляет папку со всеми файлами и подпапками.
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;
if stat(fd)='F' then begin assign(f,fd); setfattr(f,0); erase(f) end;Тут ты два раза вызываешь одну и ту же функцию с тем же параметром: stat(fd). Спрашивается - зачем? Можно, например, заменить на такое:
if stat(fd)='D' then
case stat(fd) of
'F': begin ... end;
'D': begin .. end;
end;
М | Тему переношу в раздел "32-битные компиляторы" и меняю название |
Благодарю! C FindClose все отлично работает, и за CASE спасибо!
Билли Боб, не знаю, сделал ты это или нет, но при работе с FPC от модуля DOS надо бы избавляться. И цикл перебора должен быть не
findfirst(...);
while doserror=0 do
begin
// ...
findnext(s);
end;
if findfirst(...) then
repeat
// ...
until findnext(s) <> 0;
так выходит ошибка: 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.
Оказывается надо было убрать модуль DOS после USES.
Почему программа зависает, когда я пишу: uses sysu...и тут виснет
даже просто в любом месте пишу sysu, и зависает
Не знаю, как это получилось, но еще зависало когда печатал syst, хотя если напечатать sys, а через пробел utils, то после удаления пробела все нормально. Вообщем решилась проблема удалением файла fp.dsk.
Как сделать курсор снова маленьким? а то после cursorbig он остался большим, хоть я и убрал эту строку.
и как сделать, чтобы дата datetimetostring на русском отображалась?