Error de Access denied en aplicación de Descompresión de Archivos en Lazarus

[javiparera]

Hola.. como va? les comento que hace poco hice un programa pequeño con Lazarus para realizar varias tareas en un mismo paso...en definitiva lo que hace el programa es: descomprimir unas carpetas que están en formato ZIP, luego renombra los archivos que contienen las carpetas "descomprimidas" y luego copia los archivos renombrados para ser levantados por otro programa.
Venia funcionando lo mas bien hasta que hace unos dias comenzó a tirarme un cartel con el siguiente error:
"Access denied.
Press OK to ignore and risk data corruption.
Press CANCEL to kill the program"

¿Me podrán dar una idea que puede ser lo que esté ocurriendo?
saludos...

[ecfisa]

Hola javiparera, bienvenido a Club Delphi :)

Como es costumbre con los nuevos miembros, te invitamos a leer nuestra guía de estilo (http://www.clubdelphi.com/foros/guiaestilo.php).

Agrega mas información sobre el problema: Sistema operativo (Lazarus es multiplataforma), momento y situación en que se produce el error, etc. cuantos mas datos aportes sobre el error, mas posibilidades hay de brindarte ayuda.

También es muy útil conocer el lugar del código donde estimas que se provoca. Podes usar breakpoints y Ejecutar paso a paso por instrucciones (F7) para circunscribir e identificar la línea que lo provoca.

Saludos :)

[nlsgarcia]

javiparera,


...lo que hace el programa (Lazarus) es: descomprimir unas carpetas que están en formato ZIP...renombra los archivos que contienen las carpetas "descomprimidas"...copia los archivos renombrados...hace unos días comenzó a tirarme un cartel con el siguiente error : Access denied Press OK to ignore and risk data corruption Press CANCEL to kill the program...¿Me podrán dar una idea que puede ser lo que esté ocurriendo?...
:rolleyes:

Pregunto:

1- ¿Que Sistema Operativo y de cuantos bits (32/64) utiliza tu aplicación?.

2- ¿Si descomprimes los archivos manualmente, se presenta algún mensaje de error?.

3- ¿Si presionas Ok, los archivos son utilizables o están corruptos?.

4- ¿Puedes publicar el código en cuestión?.

Espero sea útil :)

Nelson.

[javiparera]

Hola ecfisa...el programa está hecho con Lazarus, es un programa portable. Está corriendo sobre Windows XP y no se porque motivo dejó de funcionar... el código interno es este:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Paszlib, ShellApi, Process, Windows, Zipper, FileUtil, Forms, Controls,
Graphics, Dialogs, StdCtrls;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure descomprimir(const origen:string; const destino:string);
var
UnZipper: TUnZipper;
begin
UnZipper:=TUnZipper.Create;
try
UnZipper.FileName:=origen;
UnZipper.OutputPath:=destino;
UnZipper.Examine;
UnZipper.UnZipAllFiles;
finally
UnZipper.Free;
end;
end;

procedure crearcarpeta(var dircarpeta:string);
begin
MkDir('C:\carpeta ZIP');
dircarpeta:='C:\carpeta ZIP';
end;

procedure crearfile(var D:string);
var
f:textfile;
begin
D:=D+'\convertir.bat';
Assign(f, D);
rewrite(f);
write(f, 'ren *.dbf *.tmp');
close(f);
end;

procedure copiarfiles(sourceFolder, targetFolder: string);
const
FOF_NORECURSION = $1000;
var
SHFOS: SHFILEOPSTRUCT;
begin
sourceFolder:= IncludeTrailingPathDelimiter(sourceFolder)+'\*.*';
targetFolder := ExcludeTrailingPathDelimiter(targetFolder);
ZeroMemory(@SHFOS, SizeOf(SHFOS));
SHFOS.wFunc:= FO_COPY;
SHFOS.fFlags:= FOF_FILESONLY or FOF_NORECURSION;
SHFOS.hNameMappings:= nil;
SHFOS.pFrom:= PChar(sourceFolder+#0+#0);
SHFOS.pTo:= PChar(targetFolder+#0+#0);
SHFileOperation(SHFOS);
end;

function DelDir(dir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
dirorigen, dirdestino,diror,dirdes,borrardir:string;
begin
dirorigen:='';diror:='';dirdes:='';
dirdestino:='';
dirdestino:=IncludeTrailingPathDelimiter('C:\Windows');
dirorigen:='C:\Windows';
if OpenDialog1.Execute then
begin
dirorigen:=IncludeTrailingPathDelimiter(OpenDialog1.FileName);
delete(dirorigen, length(dirorigen), 1); //borra el último carater de la cadena;
crearcarpeta(dirdestino);
descomprimir(dirorigen,dirdestino); //llama al procedimiento descomprimir;

end;
borrardir:=dirdestino;
dirdestino:=dirdestino+'\tmp';
diror:=dirdestino;
if SetCurrentDir(dirdestino) then
begin
crearfile(dirdestino);
ExecuteProcess(dirdestino,'');
Showmessage('Los archivos se han renombrado exitosamente');
DeleteFile(Pchar(dirdestino));
dirdes:='C:\ASYS\HONORARI\BASES';
Copiarfiles(diror,dirdes);
end;
if DelDir(borrardir) then
showmessage('Los archivos se han añadido correctamente');

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin

end;

end.

[nlsgarcia]

javiparera,


...lo que hace el programa (Lazarus) es: descomprimir unas carpetas que están en formato ZIP...renombra los archivos que contienen las carpetas "descomprimidas"...copia los archivos renombrados...hace unos días comenzó a tirarme un cartel con el siguiente error : Access denied Press OK to ignore and risk data corruption Press CANCEL to kill the program...¿Me podrán dar una idea que puede ser lo que esté ocurriendo?...
:rolleyes:

Revisa este código:

unit Unit1;

{$mode objfpc}{$H+}

{$Optimization off}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Zipper;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1 : TForm1;
DirectorySource : String;
DirectoryTarget : String = 'C:\TempFiles';
FileZip : String = 'C:\TestZipFile.zip';

implementation

{$R *.lfm}

{ TForm1 }

// List of files to compress
function DirectoryList(const DirectorySource: String; var FileList : TStringList) : Boolean;
var
SR: TSearchRec;

begin

try
if FindFirst(DirectorySource + '\*.*', faAnyFile, SR) = 0 then
repeat
if (SR.Attr and faDirectory = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
DirectoryList(IncludeTrailingPathDelimiter(DirectorySource) + SR.Name, FileList);

if (SR.Attr and faArchive = faArchive) then
FileList.Add(Copy(DirectorySource,4,MaxInt) + '\' + SR.Name);
until FindNext(SR) <> 0;

FindClose(SR);

Result := True;
except
Result := False;
end;

end;

// Removes directories
function DeleteFolder(const DirectoryName : String) : Boolean;
begin

try
if DirectoryExists(DirectoryName) then
begin
DeleteDirectory(DirectoryName,True);
RemoveDir(DirectoryName);
Result := True;
end
else
Result := False;
except
Result := False;
end;


end;

// List of files to copy
procedure CopyList(DirSource, Search : String; Recursive : Boolean; var FileList : TStringList);
var
SR : TSearchRec;
FileName, FileExt : String;
SearchName, SearchExt : String;

begin

DirSource := IncludeTrailingPathDelimiter(DirSource);

if (not DirectoryExists(DirSource)) then
Exit;

SearchName := Copy(Search, 1, Pos('.',Search)-1);
SearchExt := Copy(ExtractFileExt(Search),2,MaxInt);

if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
repeat
if ((SR.Attr and fadirectory) = fadirectory) then
begin
if(SR.Name <> '.') and (SR.Name <> '..') and Recursive then
CopyList(DirSource + SR.Name, Search, Recursive, FileList);
end
else
begin
FileName := Copy(ExtractFileName(SR.Name), 1, Pos('.',ExtractFileName(SR.Name))-1);
FileExt := Copy(ExtractFileExt(ExtractFileName(SR.Name)),2,MaxInt);

if (SearchName = '*') and (SearchExt = '*') then
FileList.Add(DirSource + SR.Name);

if (SearchName = '*') and (SearchExt <> '*') then
if LowerCase(FileExt) = LowerCase(SearchExt) then
FileList.Add(DirSource + SR.Name);

if (SearchName <> '*') and (SearchExt = '*') then
if LowerCase(FileName) = LowerCase(SearchName) then
FileList.Add(DirSource + SR.Name);
end;
until FindNext(SR) <> 0;

FindClose(SR);

end;

// Copy files
function CopyFiles(Source, Target : String; Recursive : Boolean) : Boolean;
var
Search : String;
DirSource : String;
FileList : TStringList;
FileName : String;
i : Integer;

begin
try
Search := ExtractFileName(Source);
if Pos('*',Search) = 0 then
begin
CopyFile(Source, Target, [cffOverwriteFile, cffCreateDestDirectory]);
Result := True;
Exit;
end
else
begin
FileList := TStringList.Create;
DirSource := IncludeTrailingPathDelimiter(ExtractFilePath(Source));
CopyList(DirSource, Search, Recursive, FileList);
for i := 0 to FileList.Count -1 do
begin
FileName := StringReplace(FileList.Strings,DirSource,'',[rfIgnoreCase]);
CopyFile(FileList.Strings[i],
IncludeTrailingPathDelimiter(Target) + FileName,
[cffOverwriteFile, cffCreateDestDirectory]);
end;
Result := True;
Exit;
end;
except
Result := False;
end;
end;

// Modo-1 Compress Files
procedure TForm1.Button1Click(Sender: TObject);
var
Zipper : TZipper;
FileList : TStringList;

begin

if SelectDirectory('Select Directory to Compress', 'C:\', DirectorySource) then
begin
SetCurrentDir(ExtractFileDrive(DirectorySource)+'\');
FileList := TStringList.Create;
DirectoryList(DirectorySource, FileList);

Zipper := TZipper.Create;
Zipper.FileName := FileZip;
Zipper.Entries.AddFileEntries(FileList);
Zipper.ZipAllFiles;

Zipper.Free;
FileList.Free;

MessageDlg('Compressed Directory',mtInformation,[mbOk],0);
end
else
MessageDlg('Directory Selection Aborted',mtWarning,[mbOk],0);

end;

// Modo-1 Decompress Files
procedure TForm1.Button2Click(Sender: TObject);
var
openDialog : TOpenDialog;
UnZipper: TUnZipper;

begin

openDialog := TOpenDialog.Create(self);
openDialog.InitialDir := 'C:\';
openDialog.Options := [ofFileMustExist];
openDialog.Filter := 'FileZip to Decompress |*.zip';

if openDialog.Execute then
begin
UnZipper := TUnZipper.Create;
UnZipper.FileName := openDialog.FileName;
UnZipper.OutputPath := DirectoryTarget;
UnZipper.UnZipAllFiles;
MessageDlg('Decompressed Directory',mtInformation,[mbOk],0);
end
else
MessageDlg('FileZip Selection Aborted',mtWarning,[mbOk],0);

openDialog.Free;
UnZipper.Free;

end;

// Modo-2 Compress Files
procedure TForm1.Button3Click(Sender: TObject);
var
Zipper : TZipper;
FileEntries : TZipFileEntries;
FileList : TStringList;
i : Integer;

begin

if SelectDirectory('Select Directory to Compress', 'C:\', DirectorySource) then
begin
FileList := TStringList.Create;
DirectoryList(DirectorySource, FileList);

Zipper := TZipper.Create;
Zipper.FileName := FileZip;

FileEntries := TZipFileEntries.Create(TZipFileEntry);

for i := 0 to FileList.Count - 1 do
FileEntries.AddFileEntry(IncludeTrailingPathDelimiter(ExtractFileDrive(DirectorySource)) + FileList.Strings[i], FileList.Strings[i]);

Zipper.ZipFiles(FileEntries);

Zipper.Free;
FileList.Free;
FileEntries.Free;
MessageDlg('Compressed Directory',mtInformation,[mbOk],0);
end
else
MessageDlg('Directory Selection Aborted',mtWarning,[mbOk],0);

end;

// Modo-2 Decompress Files
procedure TForm1.Button4Click(Sender: TObject);
var
openDialog : TOpenDialog;
UnZipper: TUnZipper;
i : Integer;
FileList : TStringList;

begin

openDialog := TOpenDialog.Create(self);
openDialog.InitialDir := 'C:\';
openDialog.Options := [ofFileMustExist];
openDialog.Filter := 'FileZip to Decompress |*.zip';

FileList := TStringList.Create;

if openDialog.Execute then
begin
UnZipper := TUnZipper.Create;
UnZipper.FileName := openDialog.FileName;
UnZipper.OutputPath := DirectoryTarget;
UnZipper.Examine;

for i := 0 to UnZipper.Entries.Count - 1 do
FileList.Add(UnZipper.Entries.Entries[i].ArchiveFileName);

UnZipper.UnZipFiles(FileList);

MessageDlg('Decompressed Directory',mtInformation,[mbOk],0);
end
else
MessageDlg('FileZip Selection Aborted',mtWarning,[mbOk],0);

openDialog.Free;
UnZipper.Free;
FileList.Free;

end;

// Modo-3 Compress Files
procedure TForm1.Button5Click(Sender: TObject);
var
openDialog : TOpenDialog;
Zipper : TZipper;
FileEntries : TZipFileEntries;
i : Integer;
FileName : String;

begin

openDialog := TOpenDialog.Create(self);
openDialog.InitialDir := 'C:\';
openDialog.Options := [ofFileMustExist, ofAllowMultiSelect];
openDialog.Filter := 'Files to Compress |*.*';

if openDialog.Execute then
begin

Zipper := TZipper.Create;
Zipper.FileName := FileZip;

FileEntries := TZipFileEntries.Create(TZipFileEntry);

for i := 0 to openDialog.Files.Count - 1 do
begin
FileName := Copy(openDialog.Files[i],4,MaxInt);
FileEntries.AddFileEntry(IncludeTrailingPathDelimiter(ExtractFileDrive(openDialog.Files[i])) + FileName, FileName);
end;

Sleep(1000); // Previene mensaje de error de riesgo de corrupción de data según pruebas realizadas

Zipper.ZipFiles(FileEntries);

Zipper.Free;
FileEntries.Free;

MessageDlg('Compressed Files Selected',mtInformation,[mbOk],0);
end
else
MessageDlg('Files Selection Aborted',mtWarning,[mbOk],0);

openDialog.Free;

end;

// Delete directory
procedure TForm1.Button6Click(Sender: TObject);
begin
if DeleteFolder(DirectoryTarget) then
MessageDlg('Directory Removed',mtInformation,[mbok],0)
else
MessageDlg('Directory Not Removed',mtError,[mbok],0);
end;

// Copy files
procedure TForm1.Button7Click(Sender: TObject);
begin

{

Ejemplo de uso de la función CopyFiles :

function CopyFiles(Source, Target : String; Recursive : Boolean) : Boolean;

CopyFiles('C:\TempFiles\*.*', 'C:\ProcessFiles', True);
CopyFiles('C:\TempFiles\*.*', 'C:\ProcessFiles', False);
CopyFiles('C:\TempFiles\*.pdf', 'C:\ProcessFiles', True);
CopyFiles('C:\TempFiles\*.pdf', 'C:\ProcessFiles', False);
CopyFiles('C:\TempFiles\FileText.*', 'C:\ProcessFiles', True);
CopyFiles('C:\TempFiles\FileText.*', 'C:\ProcessFiles', False);
CopyFiles('C:\TempFiles\FileText.txt', 'C:\ProcessFiles\FileText.txt', False);

Nota : El parámetro Recursive permite hacer copias recursivas dentro de un directorio.

}

if CopyFiles('C:\TempFiles\*.*', 'C:\TempProcessFiles', True) then
MessageDlg('Files Copied',mtInformation,[mbok],0)
else
MessageDlg('Files Not Copied',mtError,[mbok],0);

end;

end.

El código anterior en Lazarus 1.4.0 FPC 2.6.4 sobre Windows 7 Professional x32, [I]Implementa varias rutinas de compresión y descompresión de archivos, así como de borrado de directorios y copia de archivos sin la utilización de APIs de Windows, como se muestra en la siguiente imagen:

http://i.imgur.com/CM6sz2p.jpg

El código propuesto esta disponible en : Lazarus ZipFile.rar (http://terawiki.clubdelphi.com/Delphi/Ejemplos/Varios/?download=Lazarus+ZipFile.rar)

Espero sea útil :)

Nelson

[javiparera]

Hola Nelson... Muchas gracias por tu aporte. Voy a probar con este codigo que me pasas y luego les comento..
Saludos.. y muchas gracias :)

[javiparera]

Hola Nelson..como estas? antes que nada...muchas gracias por tu aporte, estuve probando los módulos y funcionan de maravilla.
Quería consultarte una cosa mas... viste que el programa crea un directorio "Carpeta Zip", pero luego cuando quiere remover el directorio, solo elimina los archivos que están dentro. Uno podría poner una condición que si el directorio no existe entonces lo cree, y listo... pero el tema está en lo siguiente:
cuando el programa descomprime, lo hace dentro del directorio "C:\Carpeta Zip" quedando así "C:\Carpeta Zip\tmp" mas los archivos dentro de la carpeta tmp.
Cuando remueve, lo que hace es eliminar solamente los archivos de la carpeta tmp, quedando el directorio "C:\Carpeta Zip\tmp" vacío.
Lo que necesito hacer de alguna manera, es eliminar TODO, osea, la carpeta Zip y todo su contenido...
¿existe alguna forma de hacer eso?
Desde ya muchas gracias :)

[nlsgarcia]

javiparera,


...necesito hacer de alguna manera, es eliminar TODO, osea, la carpeta Zip y todo su contenido...¿existe alguna forma de hacer eso?...

:rolleyes:

La función DeleteFolder del código propuesto en el Msg #5, borra recursivamente todo el contenido de una carpeta y la carpeta en si misma.

Adicionalmente te sugiero probar la función CopyFiles, esta junto a DeleteFolder son implementadas sin la utilización de APIs de Windows lo que facilita la portabilidad del código.

Espero sea útil :)

Nelson.

[javiparera]

Pero estoy utilizando la función "DeleteFolder" que me propusiste pero no me está funcionando...el resto funciona re bien pero esta función en particular borra todo lo que sea archivos, pero las carpetas las deja.

[nlsgarcia]

javiparera,


...estoy utilizando la función "DeleteFolder" que me propusiste pero no me está funcionando...borra todo lo que sea archivos, pero las carpetas las deja...

:rolleyes:

Te comento:

1- La función DeleteFolder, borra recursivamente todo el contenido de una carpeta y la carpeta en si misma.

2- Si la carpeta actual es la carpeta a borrar, DeleteFolder borrara todo su contenido (Archivos y carpetas) recursivamente pero no la carpeta actual en si misma.

Espero sea útil :)

Nelson.

[javiparera]

Entiendo el funcionamiento de la función DeleteFolder...lo que no entiendo es a que te referís con "la carpeta actual". Lo que hago en sí es crear una carpeta auxiliar donde se descompriman los archivos, se renombren y desde ahí se copien a otra carpeta...
Veamoslo de esta forma...
creo una carpeta parcial, realizo todas las operaciones y luego cuando esta todo listo, copio en la carpeta Final... luego quiero que la carpeta pacial, desaparezca...
¿como podría hacerlo?

[nlsgarcia]

javiparera,


...no entiendo es a que te referís con "la carpeta actual"...

:rolleyes:

Te comento:

1- La carpeta actual es la que esta definida por defecto en un programa, ya sea por que : Es la carpeta de ejecución de la aplicación, por la función SetCurrentDir o en este caso particular por que esta abierta en el explorador de Windows.

2- Para verificar el funcionamiento de la función DeleteFolder te sugiero : Crear un programa de prueba en el que se borre una carpeta que no cumpla con ninguna de las condiciones del punto 1.

Revisa esta información pertinente a la función DeleteFolder (Es la base de su funcionamiento):

1- DeleteDirectory (http://lazarus-ccr.sourceforge.net/docs/lcl/fileutil/deletedirectory.html)

2- RemoveDir (http://lazarus-ccr.sourceforge.net/docs/rtl/sysutils/removedir.html)
Espero sea útil :)

Nelson.

[javiparera]

Ok...voy a seguir investigando y haciendo pruebas... en principio lo que hice es dejar la carpeta, ya que no se elimina automáticamente, la dejo... lo que hice fue poner una condición. Si el directorio no existe entonces que lo cree y si existe que opere directamente sobre la carpeta y listo...
Lo probé y funciona ;)
Aún así haré un modulo a parte y probaré las funciones.. luego te digo que resulta. jeje
Abrazo grande y Gracias por tu ayuda capo :)

[nlsgarcia]

javiparera,


...voy a seguir investigando y haciendo pruebas...ya que no se elimina automáticamente...


...lo que hice fue poner una condición. Si el directorio no existe entonces que lo cree...

:rolleyes:

Te comento :

1- En el Msg #5 hay un link para descargar y probar el código propuesto.

2- En el código propuesto : Todos los directorios se crean de forma automática, no es necesario crearlos previamente.

Revisa esta imagen:

http://i.imgur.com/VEsRykM.gif

Espero sea útil :)

Nelson.

[javiparera]

Genio Nelson...jeje por el momento lo resolví haciendo:

if (not DirectoryExists('C:\carpetaZIP')) then
crearcarpeta(dirdestino)
else
dirdestino:='C:\carpetaZIP';

porque el módulo de remover la carpeta no lo puse que se ejecute a través de un botón..sino que lo mando a llamar, que entiendo debe ser lo mismo, entonces me queda de esta manera:

function DeleteFolder(const DirectoryName:String):Boolean;
begin
try
if DirectoryExists(DirectoryName) then
begin
DeleteDirectory(DirectoryName,True);
RemoveDir(DirectoryName);
Result:=True;
end
else
Result:=False;
except
Result:=False;
end;
end;

y lo mando a llamar así:

B:=DeleteFolder(borrardir); // Donde "B" es una variable boolean

saludos.-

[Casimiro Notevi]

Recuerda poner los tags al código fuente, ejemplo:

http://www.clubdelphi.com/images/UtilizarTAGs.png

Gracias :)