API para copiar archivos

[Arnol125]

Hola de nuevo

estoy tratando de copiar unas imágenes de una carpeta compartida en red a una carpeta en disco local y uso este código pero me sale el mensaje "Acceso Denegado"
los componentes son:

Button1 - Iniciar
Button2 - Cancelar
ProgressBar1 - componente
funcion ProgressRoutine

Código Delphi [-]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, ExtCtrls, Buttons, ComCtrls;

type
  TImageForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public

 { Public declarations }
  end;

var
  ImageForm: TImageForm;
  Cancel: boolean;

implementation
 

{$R *.dfm}


function ProgressRoutine(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, 
dwCallbackReason: DWORD; hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall;


begin
   Application.ProcessMessages();
   if(dwCallbackReason = CALLBACK_CHUNK_FINISHED) then
      ImageForm.ProgressBar1.Position:= (int64(TotalBytesTransferred) * 100) div int64(TotalFileSize);

   Result:= PROGRESS_CONTINUE;
end;


procedure TImageForm.Button1Click(Sender: TObject);
begin
 Cancel:= false;
  CopyFileEx('\\Sistemas\e\Usuario\Escritorio\catalogo','C:\catalogo1', @ProgressRoutine, nil, @Cancel, 0);
  ShowMessage(SysErrorMessage(GetLastError()));
end;

 procedure TImageForm.Button2Click(Sender: TObject);
begin
Cancel:= true;
end;

end.

[[duilioisola]]

El acceso puede ser denegado para leer los archivos en origen o para escribirlos en destino.
¿Puesdes copiarlos a mano?
¿Funciona utilizando un comando desde DOS (copy \\Sistemas\e\Usuario\Escritorio\catalogo C:\catalogo1)?
¿El texto del error, dice algo más o solo "Acceso denegado"?

[Arnol125]

Por DOS se puede copiar con comandos "xcopy \\Sistemas\e\Usuario\Escritorio\catalogo\*.* C:\catalogo"
Ademas por por copiar y pegar con windows tambien funciona
Adjunto proyecto

[[escafandra]]

CopyFileEx necesita como parámetros un nombre completo de archivo fuente y oro completo destino, la ruta destino debe existir. No admite comodines y sólo copia un archivo. Prueba de esta forma.

Saludos.

[[nlsgarcia]]

Arnol125,

Empezado por Arnol125

...estoy tratando de copiar (Delphi y CopyFileEx) unas imágenes de una carpeta compartida en red a una carpeta en disco local...me sale el mensaje "Acceso Denegado"...Por DOS se puede copiar con comandos "xcopy \\Sistemas\e\Usuario\Escritorio\catalogo\*.* C:\catalogo"...

Empezado por escafandra

...CopyFileEx...No admite comodines y sólo copia un archivo...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  COPY_FILE_NO_BUFFERING = $1000;
  MsgApp = 'Presione Copy para iniciar copia Simple o Múltiple de Archivos';

var
  Form1: TForm1;
  Cancel : Boolean;

implementation

{$R *.dfm}

// Rutina de Callback de CopyFileEx
function CopyProgressRoutine(TotalFileSize : Int64;
                             TotalBytesTransferred : Int64;
                             StreamSize : Int64;
                             StreamBytesTransferred : Int64;
                             dwStreamNumber : Dword;
                             dwCallbackReason : Dword;
                             hSourceFile : THandle;
                             hDestinationFile : THandle;
                             lpData : Pointer) : DWORD; StdCall;
var
   Percent : Integer;

begin

   if dwCallbackReason = CALLBACK_CHUNK_FINISHED then
   begin
      Percent := Round(TotalBytesTransferred / TotalFileSize * 100);
      Form1.ProgressBar1.Position := Percent;
      Application.ProcessMessages;
   end;

   Result := PROGRESS_CONTINUE;

end;

// Inicializa Aplicación
procedure TForm1.FormCreate(Sender: TObject);
begin
   Label1.Caption := MsgApp;
end;

// Copia Simple ó Múltiple de Archivo(s)
procedure TForm1.Button1Click(Sender: TObject);
var
   FromFileName, ToFileName : String;
   openDialog : TOpenDialog;
   TargetDirectory : String;
   i : Integer;
   MsgUser : String;

begin

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

   if openDialog.Execute and SelectDirectory('Target Directory', 'C:\', TargetDirectory) then
   begin

      for i:= 0 to openDialog.Files.Count - 1 do
      begin

         FromFileName := openDialog.Files.Strings[i];
         ToFileName := TargetDirectory + '\' + ExtractFileName(openDialog.Files.Strings[i]);

         ProgressBar1.Position := 0;
         ProgressBar1.Min := 0;
         ProgressBar1.Max := 100;

         Cancel := False;

         Label1.Caption := Format('Copiando (%d/%d) %s a %s ',
                                  [i+1,openDialog.Files.Count,FromFileName,TargetDirectory]);

         CopyFileEx(PChar(FromFileName),
                    PChar(ToFileName),
                    @CopyProgressRoutine,
                    nil,
                    @Cancel,
                    COPY_FILE_RESTARTABLE or COPY_FILE_NO_BUFFERING);

         ProgressBar1.Position := 0;

         if Cancel then
         begin
            MsgUser := 'Copia Cancelada por el Usuario';
            MessageDlg(MsgUser,mtInformation,[mbOK],0);
            Exit;
         end;

      end;

      MsgUser := 'Copia de Archivos Realizada Satisfactoriamente';
      MessageDlg(MsgUser,mtInformation,[mbOK],0);

   end
   else
   begin
      MsgUser := 'No se Realizo Copia de Archivos por Falta de Parámetros';
      MessageDlg(MsgUser,mtError,[mbOK],0);
   end;

   openDialog.Free;

   Label1.Caption := MsgApp;

end;

// Cancela copia de Archivo(s)
procedure TForm1.Button2Click(Sender: TObject);
begin
   Cancel := True;
   ProgressBar1.Position := 0;
end;

end.

El código anterior en Delphi 7 bajo Windows 7 Professional x32, permite copiar Uno o Múltiples Archivos por medio de la función CopyFileEx y visualizar el progreso de la copia, como se muestra en la siguiente imagen:



El código del ejemplo esta disponible en : CopyFileEx.rar

Espero sea útil

Nelson.

[[escafandra]]

Por supuesto, si queremos copiar más de un archivo deberemos llamar tantas veces a CopyFileEx. En el caso de una carpeta, con un bucle (FindFirstFile FindNextFile) lo solucionamos. En el caso de parte de una carpeta, el ejemplo de nlsgarcia es exelente.

Saludos.

[Arnol125]

He probado en codigo de nlsgarcia y me sale este error

[Error] Unit1.pas(77): Undeclared identifier: 'SelectDirectory'
[Error] Unit1.pas(77): Operator not applicable to this operand type
[Error] Unit1.pas(90): Undeclared identifier: 'Cancel'
[Error] Unit1.pas(132): Undeclared identifier: 'Cancel'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

[[nlsgarcia]]

Arnol125,

...He probado el código de nlsgarcia y me sale este error...

Te comento:

1- El código del Msg #5 esta disponible en CopyFileEx.rar

2- ¿Que versión de Windows utilizas?, ¿Es de 32 o 64 Bits?.

3- ¿Que versión de Delphi utilizas?.

4- ¿Probastes el código del Msg #5 en una aplicación VCL o FMX?.

Te sugiero descargar el ejemplo y sin ninguna modificación probarlo, a ver si se mantiene el comportamiento descrito en el Msg #7.

Espero sea útil

Nelson.