И снова удаление файлов :((

← →
Dmitry Toropov (2002-07-25 18:22) [0]

Но ничего не могу сделать - сегодня часов 6 потратил, чтобы найти ответ на вопрос, как правильно удалять файлы. Проблема, как я понял, у меня с удалением файлов с длинным fullname и помеченных read only.
Вот такая вот у меня процедурка получилась, подскажити, кто захочет, где грабли? (желательно без SHFileOperation - она на моих 9x отказывается работать правильно).
function TThreadFileDelete.fbDoWork: boolean; var i:integer; sLastDir:string; begin Result:=false; try try mlstFiles:=TStringList.Create; mlstDirs:=TStringList.Create; fSetInitCallBack( "Формирование списка удаляемых файлов ..." ,0,100,1,0,true); Synchronize(fInitCallBack); //form list of files for deletion fFindAllFiles(msSourcePath,msMask,fDataFromFindAllFiles); if mbSubDirs then fScanDirs(msSourcePath,msMask, fFindAllFiles,fDataFromFindAllFiles,fDataFromScanDirs); //deletion of files fSetInitCallBack("",0,mlstFiles.Count,1,0,true); Synchronize(fInitCallBack); if mlstFiles.Count=0 then raise EThreadNoMessage.Create("Файлов не найдено"); for i := 0 to mlstFiles.Count-1 do begin fSetProgressCallBack(Format( "Удаление файла <%s> ...",[mlstFiles[i]]),1); Synchronize(fProgressCallBack); if Terminated then raise EThreadNoMessage.Create(""); if not SysUtils.DeleteFile(mlstFiles[i]) then raise EThreadWithMessage.CreateFmt( "Ошибка при удалении файла"+#13+"%s",[mlstFiles[i]]); Sleep(1000); end; //for i //здесь я еще не доделал правильно удаление всех подкаталогов if msMask = "*.*" then begin //remove subDirs sLastDir:=""; for i:=mlstDirs.Count-1 downto 0 do begin if sLastDir <> ExtractFileDir(mlstDirs[i]) then begin sLastDir:=ExtractFileDir(mlstDirs[i]); RemoveDirectory(PChar(sLastDir)); //if error with dir deletion, ignore it end; //if end;//for end; //if remove subdirs Result:=true; fSetInitCallBack("Готово.",1,100,1,100,true); Synchronize(fInitCallBack); except raise; end; finally mlstFiles.Free; mlstDirs.Free; end; end;

← →
Skier (2002-07-25 19:04) [1]

>Dmitry Toropov

> Проблема, как я понял, у меня с удалением файлов с длинным
> fullname и помеченных read only

А в чём собственно проблема ?
(Кстати Sleep(1000); тебе зачем ?)

← →
Dmitry Toropov (2002-07-25 19:12) [2]

>(Кстати Sleep(1000); тебе зачем ?)

;) Пытался определить, на каком именно файле происходит сбой. Уже уходить домой надо (у меня 22:11), и вроде бы только понял, что перед удалением файла нужно его всякие архивные атрибуты снять (вроде бы где-то когда-то об этом читал). Правильно я мыслю или есть какая-нибудь более другая и лучшая функция для удаления, чем DeleteFile?

← →
Skier (2002-07-25 19:18) [3]

>Dmitry Toropov

> нужно его всякие архивные атрибуты снять

Посмотри здесь :

Sets the file attributes of a specified file.

Unit

Sysutils

Category

file management routines

function FileSetAttr(const FileName: string; Attr: Integer): Integer;

← →
Dmitry Toropov (2002-07-25 19:23) [4]

Спасибо, конечно, но чем снять атрибуты - не проблема (хелп на что?) - я интересуюсь, действительно ли перед удалением файла необходимо убрать у него всякие архивные атрибуты?

← →
Skier (2002-07-25 19:29) [5]

>Dmitry Toropov

> действительно ли перед удалением файла необходимо убрать
> у него всякие архивные атрибуты

IMHO, да.

← →
Antonius (2002-07-25 19:42) [6]

Извиняюсь, но это бред. Архивный атрибут - не имеет отношения к удалению. ReadOnly - имеет. System - не уверен - проверить не сложно. В принципе могу выслать процедурку, которая удалят любые файлы.

← →
Anatoly Podgoretsky (2002-07-25 20:33) [7]

Все не удалит, аттрибутов для этого недостаточно, надо что бц еще файл не был открыт

← →
SuMaga (2002-07-25 20:40) [8]

слушай ,Мой тебе совет не ленись Напиши лучше все заново!!!!
и ставь атрибут для всех файлов толькл архивный
и причем файл не должен быть ни в коем слче открыт!!!

← →
VID (2002-07-25 22:27) [9]

to Antonius:
насчёт процедурки по удалению любых файлов... опубликуй здесь, если не трудно, интересно посмотреть...

← →
Dmitry Toropov (2002-07-26 06:57) [10]

Так получается, перед
DeleteFile(sFileName);
делаю:
FileSetAttr(sFileName,faArchive)
и должно заработать? (если, конечно файл кем-то другим в это время не открыт).

← →
Antonius (2002-07-26 10:27) [11]

to VID:
ну под любыми я естественно понимаю с любым атрибутом, но не открытые, не находящиеся на компакт диске, с разрешенными правами на удаление (для текущего пользователя, если NTFS) и тд. :) Вобщем нечто похожее на ответ предыдущего оратора. Просто там добавлены некие маленькие удобства.

← →
Dmitry Toropov (2002-07-26 11:05) [12]

2Antonius

Если она (процедурка с удобствами) небольшая и опубликовать не жалко, то интересно было бы глануть ...

← →
Dmitry Toropov (2002-07-26 11:05) [13]

2Antonius

Если она (процедурка с удобствами) небольшая и опубликовать не жалко, то интересно было бы глянуть ...

← →
Antonius (2002-07-26 11:36) [14]

to Dmitry Toropov
ok. Две процедуры для удаления и переименования:
в функции RaiseLastFileError используется ParseString, ее у меня с собой нет, но заменить ее на что нибудь - не сложно. Она для корректирования стандартного сообщения windows об ошибке. или ее вообще выкинуть.

to TFileDeleteOptions=set of (fdDelReadOnly,fdCheckExists);
//fdDelReadOnly - Удалять файл даже если он ReadOnly или System
//fdCheckExist - Если файл не существует - ошибки не возникает

TFileRenameOptions=set of (frRenameReadOnly,frForceDelete);
//fdRenameReadOnly - переименовывать файл даже если он ReadOnly или System
//fdForceDelete - если Dst file существует - удалять его

procedure RaiseLastFileError(const fileName:string);
var s:string;
begin
try
RaiseLastWin32Error;
except
on E:EWin32Error do
begin
s:=e.message;
ParseString(s,#10,true);
e.message:=s+" ("+fileName+")";
raise;
end;
end;

end;

Procedure DeleteFileOpt(const fn:string; options:TFileDeleteOptions);
var
attr:DWord;
begin
if (fdCheckExists in options) and not FileExists(fn) then exit;
if (fdDelReadOnly in options) then begin
attr:=GetFileAttributes(pchar(fn));
if attr=$FFFFFFFF then RaiseLastFileError(fn);
if attr and (FILE_ATTRIBUTE_READONLY+FILE_ATTRIBUTE_SYSTEM)>0 then begin
attr:=attr and not (FILE_ATTRIBUTE_READONLY+FILE_ATTRIBUTE_SYSTEM);
if not SetFileAttributes(pchar(fn),attr) then RaiseLastFileError(fn);
end;
end;
if not DeleteFile(fn) then RaiseLastFileError(fn);
end;

procedure RenameFileOpt(const Src,Dst:string; options:TFileRenameOptions);
var
Attr,OldAttr:DWord;
DelOpt:TFileDeleteOptions;
ResetAttr:boolean;
begin
if frForceDelete in options then begin
delOpt:=[fdCheckExists];
if frRenameReadOnly in options then
DelOpt:=DelOpt+[fdDelReadOnly];
DeleteFileOpt(Dst,DelOpt);
end;

OldAttr:=0;
ResetAttr:=false;
if (frRenameReadOnly in Options) then begin
OldAttr:=GetFileAttributes(pchar(src));
if OldAttr=$FFFFFFFF then RaiseLastFileError(src);
if OldAttr and (FILE_ATTRIBUTE_READONLY+FILE_ATTRIBUTE_SYSTEM)>0 then begin
attr:=OldAttr and not (FILE_ATTRIBUTE_READONLY+FILE_ATTRIBUTE_SYSTEM);
if not SetFileAttributes(pchar(src),attr) then RaiseLastFileError(src);
ResetAttr:=true;
end;
end;

if not RenameFile(src,dst) then RaiseLastFileError(src);
if ResetAttr and not SetFileAttributes(pchar(dst),OldAttr) then RaiseLastFileError(dst);
end;

И снова удаление файлов :(( Найти похожие ветки