PDA

Ver la Versión Completa : borrar archivos de un directorio


kapullok_2006
24-10-2007, 17:19:18
He visto los trucos del clubdelphi y me dan errores al compilarlos.
Uso delphi 6. ¿sabéis alguna idea para encaminarme?


Saludos.

:confused:

paldave
24-10-2007, 17:37:24
Prueba con esto:
function GetSubDirectories(Directory:String):TStrings;
var
r:TSearchRec;
h:Integer;
begin
result:=TStringList.Create;
result.Clear;
if not DirectoryExists(Directory) then
exit;

Directory:=IncludeTrailingBackSlash(Directory);
h:=FindFirst(Directory+'*.*',$10, r);
if h<>0 then
begin
FindClose(r);
exit;
end;
FindNext(r); //Salta el directorios '.' y '..'

repeat
h:=FindNext(r);
if h<>0 then break;
if (r.Attr and $10) =0 then continue;
result.Add(r.Name);
until false;
FindClose(r);
end;

function GetFileNames(Directory:String; Filter:String='*.*'):TStrings;
var
r:TSearchRec;
h:Integer;
begin
if not DirectoryExists(Directory) then
exit;

result:=TStringList.Create;
result.Clear;
Directory:=IncludeTrailingBackSlash(Directory);
h:=FindFirst(Directory+Filter,$10, r);
if h<>0 then
begin
FindClose(r);
exit;
end;

while (r.Name='.') or (r.Name='..') do
h:=FindNext(r); //Salta los directorios '.' y '..'

while h=0 do
begin
if (r.Attr and $10)<>0 then
begin
h:=FindNext(r);
continue;
end;
result.Add(r.Name);
h:=FindNext(r);
end;
FindClose(r);
end;


function Deltree(Directory:String;ConfirmForEachFile:Boolean=False;InformErrors:Boolean=False):Boolean;
var
Directories,Files,ExcludedDirectories:TStrings;
ActualDir:String;
f:Integer;
d:Boolean;
begin
result:=false;
if not DirectoryExists(Directory) then
if InformErrors then
Raise EInOutError.Create(GetErrorString(ERROR_FILE_NOT_FOUND)+' "'+Directory+'".')
else
exit;

ExcludedDirectories:=TStringList.Create;
repeat
ActualDir:=Directory;
Directories:=GetSubDirectories(ActualDir);
f:=0;
while Directories.Count>f do
begin
if ExcludedDirectories.IndexOf(IncludeTrailingBackSlash(ActualDir)+Directories[f])<>-1 then
begin
inc(f);
continue;
end;
ActualDir:=IncludeTrailingBackSlash(ActualDir)+Directories[f];
Directories:=GetSubDirectories(ActualDir);
end;
Files:=GetFileNames(ActualDir);
for f:=0 to Files.Count -1 do
begin
if ConfirmForEachFile then
if MessageBox(Application.Handle,PChar('Delete "'+IncludeTrailingBackSlash(ActualDir)+Files[f]+'?'),'Delete File',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=IDNO then
continue;
d:=DeleteFile(IncludeTrailingBackSlash(ActualDir)+Files[f]);
if InformErrors and (d=False) then
MessageBox(Application.Handle,PChar(GetLastErrorString+' "'+IncludeTrailingBackSlash(ActualDir)+Files[f]+'."'),'Error',MB_ICONEXCLAMATION);
end;

Files:=GetFileNames(ActualDir);
Directories:=GetSubDirectories(ActualDir);
if (files.Count >0) or (Directories.Count >0) then
begin
ExcludedDirectories.Add(ActualDir);
Continue;
end;

if ConfirmForEachFile then
if MessageBox(Application.Handle,PChar('Delete "'+IncludeTrailingBackSlash(ActualDir)+'?'),'Delete Folder',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=IDNO then
begin
ExcludedDirectories.Add(ActualDir);
Continue;
end;

d:=RemoveDirectory(Pchar(ActualDir));
if d=False then
begin
ExcludedDirectories.Add(ActualDir);
if InformErrors then
MessageBox(Application.Handle,PChar(GetLastErrorString+' "'+ActualDir+'."'),'Error',MB_ICONEXCLAMATION);
end;
until ActualDir=Directory;

result:= not DirectoryExists(Directory);
ExcludedDirectories.Free;
end;
Espero te sea útil. Saludos

kapullok_2006
19-11-2007, 20:45:17
¿Habrá que añadir units para que funcione?

te envio archivo para ver los errores.

Saludos,y gracias por tu apoyo.

kapullok_2006
19-11-2007, 20:49:53
me da errores en:
IncludeTrailingBackSlash
GetErrorString
GetLastErrorString

saludos y gracias.

manolop
21-11-2007, 10:54:25
Aqui tienes algo sencillo q a mi me funciona procedure borrar_directorio_actual(dir:string);
var
DirInfo: TSearchRec;
r : Integer;
begin
dir:=dir+'\';
r := FindFirst(dir+'*.*', FaAnyfile, DirInfo);
while r = 0 do begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar(dir + DirInfo.Name))= false then
{Si no puede borrar el fichero}
ShowMessage('No se ha podido eliminar el archivo: '+dir+
DirInfo.Name);
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
if RemoveDirectory(PChar(dir)) = false then
{Si no puedes borrar el directorio}
// ShowMessage('Imposible borrar el directorio : '+dir);
end;