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.

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,

Empezado por 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?...

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:

Código Delphi [-]
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,

Empezado por 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?...

Revisa este código:

Código Delphi [-]
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[i],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, 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:



El código propuesto esta disponible en : 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,

Empezado por javiparera

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

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,

Empezado por 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...

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,

Empezado por javiparera

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

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

2- RemoveDir

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,

Empezado por javiparera

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

Empezado por javiparera

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

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:



Espero sea útil

Nelson.

[javiparera]

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

Código Delphi [-]
 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:

Código Delphi [-]
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í:

Código Delphi [-]
 B:=DeleteFolder(borrardir); // Donde "B" es una variable boolean

saludos.-

[Casimiro Notevi]

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



Gracias