Problemas con copia de archivos a la RED

[[duilioisola]]

He hecho este pequeño programita ejemplo, para ver si puedes buscar el error.
Tiene un panel alineado alTop con un boton y un Memo para guardar un Log de todos los pasos.
En el evento del botón se llama al procedimiento que copia.
Si alguna función devuelve un error, te lo muestra en el memo.
Yo he probado con

• IP que no existe
• Nombre de usuario y contraseña incorrectos
• Carpeta que no existe dentro de la ip

Todos estos me dan algún tipo de error.

Ya nos contarás...

Código Delphi [-]
unit UFMMainCopia;

interface

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

type
  TFMMainCopia = class(TForm)
    PNLMain: TPanel;  {Panel alineado alTop}
    BCopiar: TButton;
    MLog: TMemo;      {Memo alineado alClient}
    procedure BCopiarClick(Sender: TObject);
  private
    procedure prcCopiARed(vOrigen, vDestino, vUser, vPassword :string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMMainCopia: TFMMainCopia;

implementation

{$R *.dfm}

procedure TFMMainCopia.prcCopiARed(vOrigen, vDestino, vUser, vPassword :string);
var
   NetResource: TNetResource;
   vRuta : PChar;
   ErrCode : integer;
   ErrCode2 : LongBool;
begin
   MLog.Clear;
   {*****************************************}
   { IMPORTANTE: vRuta NO debe terminar en \ }
   {*****************************************}
   vRuta := PChar('\\192.168.152.127\Compartida');
   MLog.Lines.Add('vRuta := PChar(''\\192.168.152.127\Compartida'')');

   NetResource.dwType := RESOURCETYPE_DISK;
   MLog.Lines.Add('NetResource.dwType := RESOURCETYPE_DISK');

   //Letra con la cual sera mapeado el recurso
   NetResource.lpLocalName := 'X:';
   MLog.Lines.Add('NetResource.lpLocalName := ''X:''');

   //Nombre del recurso
   NetResource.lpRemoteName := vRuta;
   MLog.Lines.Add('NetResource.lpRemoteName := vRuta');

   NetResource.lpProvider := '';
   MLog.Lines.Add('NetResource.lpProvider := ''''');

   if (vUser = '') then
   begin
      ErrCode := WNetAddConnection2(NetResource, nil, nil, CONNECT_UPDATE_PROFILE);
      MLog.Lines.Add('WNetAddConnection2(NetResource, nil, nil, CONNECT_UPDATE_PROFILE)');
   end
   else
   begin
      ErrCode := WNetAddConnection2(NetResource, PChar(vPassword), PChar(vUser), CONNECT_UPDATE_PROFILE);
      MLog.Lines.Add('WNetAddConnection2(NetResource, PChar(' + vPassword + '), PChar(' + vUser + '), CONNECT_UPDATE_PROFILE)');
   end;

   MLog.Lines.Add('ErrCode: '+IntToStr(ErrCode));
   if (ErrCode = ERROR_ACCESS_DENIED             ) then MLog.Lines.Add('ERROR_ACCESS_DENIED') else
   if (ErrCode = ERROR_ALREADY_ASSIGNED           ) then MLog.Lines.Add('ERROR_ALREADY_ASSIGNED') else
   if (ErrCode = ERROR_BAD_DEV_TYPE              ) then MLog.Lines.Add('ERROR_BAD_DEV_TYPE') else
   if (ErrCode = ERROR_BAD_DEVICE           ) then MLog.Lines.Add('ERROR_BAD_DEVICE') else
   if (ErrCode = ERROR_BAD_NET_NAME           ) then MLog.Lines.Add('ERROR_BAD_NET_NAME') else
   if (ErrCode = ERROR_BAD_PROFILE           ) then MLog.Lines.Add('ERROR_BAD_PROFILE') else
   if (ErrCode = ERROR_BAD_PROVIDER           ) then MLog.Lines.Add('ERROR_BAD_PROVIDER') else
   if (ErrCode = ERROR_BUSY                   ) then MLog.Lines.Add('ERROR_BUSY') else
   if (ErrCode = ERROR_CANCELLED           ) then MLog.Lines.Add('ERROR_CANCELLED') else
   if (ErrCode = ERROR_CANNOT_OPEN_PROFILE       ) then MLog.Lines.Add('ERROR_CANNOT_OPEN_PROFILE') else
   if (ErrCode = ERROR_DEVICE_ALREADY_REMEMBERED ) then MLog.Lines.Add('ERROR_DEVICE_ALREADY_REMEMBERED') else
   if (ErrCode = ERROR_EXTENDED_ERROR            ) then MLog.Lines.Add('ERROR_EXTENDED_ERROR') else
   if (ErrCode = ERROR_INVALID_PASSWORD          ) then MLog.Lines.Add('ERROR_INVALID_PASSWORD') else
   if (ErrCode = ERROR_NO_NET_OR_BAD_PATH        ) then MLog.Lines.Add('ERROR_NO_NET_OR_BAD_PATH') else
   if (ErrCode = ERROR_NO_NETWORK           ) then MLog.Lines.Add('ERROR_NO_NETWORK') else
   MLog.Lines.Add('DESCONOCIDO');

   ErrCode2 := CopyFile(PChar(vOrigen), PChar('X:\destino.txt'), True);
   MLog.Lines.Add('CopyFile(PChar(' + vOrigen + '), PChar(' + vDestino + '), True)');
   if (ErrCode2) then
      MLog.Lines.Add('ErrCode: True')
   else
      MLog.Lines.Add('ErrCode: False');

   ErrCode := WNetCancelConnection2('X:', CONNECT_UPDATE_PROFILE, True);
   MLog.Lines.Add('WNetCancelConnection2(''X:'', CONNECT_UPDATE_PROFILE, True)''');
   MLog.Lines.Add('ErrCode: '+IntToStr(ErrCode));
end;

procedure TFMMainCopia.BCopiarClick(Sender: TObject);
begin
   prcCopiARed('C:\Origen.txt', 'X:\Destino.txt', 'Usuario', 'password');
end;

end.

[edgwin]

Gracias nuevamente por responder.

Este es el resultado que me genera:

vRuta := PChar('\\132.147.160.51\RIS')
NetResource.dwType := RESOURCETYPE_DISK
NetResource.lpLocalName := 'X:'
NetResource.lpRemoteName := vRuta
NetResource.lpProvider := ''
WNetAddConnection2(NetResource, PChar(Radiologia1), PChar(UPC), CONNECT_UPDATE_PROFILE)
ErrCode: 0
DESCONOCIDO
CopyFile(PChar(C:\Origen.txt), PChar(X:\Destino.txt), True)
ErrCode: False
WNetCancelConnection2('X:', CONNECT_UPDATE_PROFILE, True)'
ErrCode: 0

Adjunto, archivo zip con imagen del explorador de Windows

...

Saludos!

[[duilioisola]]

WNetAddConnection2(NetResource, PChar(Radiologia1), PChar(UPC), CONNECT_UPDATE_PROFILE)
ErrCode: 0

Esto asegura que X: se puede crear.

CopyFile(PChar(C:\Origen.txt), PChar(X:\Destino.txt), True)
ErrCode: False

El resultado de la copia es False. Por lo tanto no ha podido copiar...
Puede ser que X:\Destino.txt ya exista... aunque lo dudo mucho.
Si cambias el parámetro final de CopyFile a False, también falla?

La última prueba que se me ocurre es que pongas un breakpoint en la linea de CopyFile y copies a mano C:\Origen.txt a Xestino.txt para ver si Windows te da algún error.

[edgwin]

Gracias nuevamente por responder.

Hice lo que me sugeriste, pero si me dejo copiar el archivo a la unidad "X".

Me parece que delphi tiene un bug en este sentido.

Gracias por tu apoyo amigo.
Saludos!!

[[duilioisola]]

Parece ser que si... No veo ningún otro error.
Si lo que quieres copiar es un archivo XML, lo que te sugiero que hagas es lo siguente:
Creas un TStrings y utilizas los métodos LoadFromFile SaveToFile

Código Delphi [-]
var
  ts : TStrings;
[...]
   {CopyFile(PChar(vFile),PChar('X:\archivo.XML'),False);}
   ts := TStrings.Create;
   try
      ts.LoadFromFile(vFile);
      ts.SaveToFile('X:\archivo.XML');
   finally
      ts.Free;
   end;
[...]

[[duilioisola]]

Otra opción es usar Streams. TFileStream en este caso...

Ejemplo de Delphi 6:

Código Delphi [-]
procedure TForm1.Save1Click(Sender: TObject);

var
  NewFileName: string;
  Msg: string;
  NewFile: TFileStream;
  OldFile: TFileStream;
begin
  NewFileName := ExtractFilePath(Application.ExeName) + ExtractFileName(Edit1.Text);
  Msg := Format('Copy %s to %s?', [Edit1.Text, NewFileName]);
  if MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) = mrOK then
  begin
    OldFile := TFileStream.Create(Edit1.Text, fmOpenRead or fmShareDenyWrite);
    try
      NewFile := TFileStream.Create(NewFileName, fmCreate or fmShareDenyRead);

      try
        NewFile.CopyFrom(OldFile, OldFile.Size);
      finally
        FreeAndNil(NewFile);
      end;
    finally
      FreeAndNil(OldFile);
    end;
  end;
end;

[[duilioisola]]

Otra opcion BlockRead - BlockWrite

Ejemplo de Delphi 6:

Código Delphi [-]
var
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buf: array[1..2048] of Char;
begin
  if OpenDialog1.Execute then     { Display Open dialog box }
  begin
    AssignFile(FromF, OpenDialog1.FileName);
    Reset(FromF, 1);  { Record size = 1 }
    if SaveDialog1.Execute then      { Display Save dialog box}
    begin
      AssignFile(ToF, SaveDialog1.FileName);  { Open output file }

      Rewrite(ToF, 1);  { Record size = 1 }
      Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))
        + ' bytes...');
      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
      CloseFile(FromF);
      CloseFile(ToF);
    end;
  end;
end;