Ver Mensaje Individual
  #8  
Antiguo 15-07-2011
Paulao Paulao is offline
Miembro
 
Registrado: sep 2003
Ubicación: Rua D 31 Casa 1 - Inhoaíba - Rio de Janeiro - RJ - Brasil
Posts: 637
Reputación: 21
Paulao Va por buen camino
Ola de nuevo. No es mover el directorio con los archivos. Es Crear un directorio y mover el archivo para el y despues el otro Directorio crear y mover otro archivo. Si tengo 1.000 archivos, tengo que crear 1.000 directorios y en cada uno tener solamente un archivo. QWue pasa es que no estas movendo. Si paso asi:
MoveFile('D:\NAC\test.tif','D\Destino\test.tif'), funciona, pero si pongo en un Loop For, para ir descargando para cada archivo que el encuentrar, entonces no funciona. Los archivos acá son grandes, y no consigo anejar a este forum, si no los enviaria para q usteds analicen. Pero abajo mis codigos. Este codigo un amigo me lo envio y yo hizo una adaptacion para mover los archivos.

Código Delphi [-]
type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    ProgressBar: TProgressBar;
    SourceDrive: TDriveComboBox;
    SourceDirectory: TDirectoryListBox;
    DestinationFiles: TFileListBox;
    CopiaArquivo: TLabel;
    DestinationDirectory: TDirectoryListBox;
    DestinationDrive: TDriveComboBox;
    SourceFiles: TFileListBox;
    Origem: TLabel;
    Destino: TLabel;
    WriteOpt: TRadioGroup;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    fCopia: TCopiaArquivo;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  FName,SDir,DDir:string;
  CopyBuffer: Pointer; { buffer for copying }
  TimeStamp, BytesCopied: Longint;
  Source, Dest,dir_atual: Integer; { handles }
  i,incre:integer;
  SSepar,DSepar:string;
  label TryAgain,TryAgain2,TryAgain3,TryAgain4; //Did I really use labels ????!!!
  const
    ChunkSize: Longint = 32768;
begin
  if (SourceDrive.Drive = DestinationDrive.Drive) and
    (SourceDirectory.Directory = DestinationDirectory.Directory) then
    ShowMessage('Não é possível copiar para o mesmo diretório!')
  else
  begin
  try
    Screen.Cursor:=crHourGlass;
    SDir := SourceDirectory.Directory;
    DDir := DestinationDirectory.Directory;
    if SDir[length(SDir)] = '\' then
      SSepar := ''
    else
      SSepar := '\';
    if DDir[length(DDir)] = '\' then
      DSepar := ''
    else
      DSepar := '\';
    GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  for i := 0 to SourceFiles.Items.Count-1 do
  begin
    FName:=ExtractFileName(SourceFiles.Items[i]);
    ProgressBar.Position:=trunc(i*100/SourceFiles.Items.Count);
    CopiaArquivo.Caption:='Copiando arquivo: ' + FName;
    CopiaArquivo.Update;
    TimeStamp := FileAge(FName); { get source's time stamp }
    TryAgain:
    Source := FileOpen(SDir+SSepar+FName, fmShareDenyWrite); { open source file }
    if Source < 0 then
    case MessageDlg('Erro de Leitura de Arquivo'#13#10+FName,mtError,
      [mbAbort,mbRetry,mbIgnore],0) of
      mrAbort:Break; //Exit for... loop
      mrRetry:GoTo TryAgain;
      mrIgnore:Continue;//Continue for... loop
    end;
    if WriteOpt.ItemIndex = 1 then //See if there is an old file
      if FileExists(DDir+DSepar+FName) then
        case MessageDlg('O Arquivo '+FName+' já existe.'#13#10'Grava por cima?', mtConfirmation,
          [mbYes,mbNo,mbAll],0) of
          mrYes:begin end;
          mrNo: Continue; //Continue for ... loop
          mrAll:WriteOpt.ItemIndex:=0; //Always overwrite
        end;
    TryAgain2:
   // Dest := FileCreate(DDir+DSepar+FName); { create output file}
    MoveFile(PChar(SDir+DSepar+FName),PChar(DDir+DSepar+FName));//Aqui movo
    if Dest < 0 then
      case MessageDlg('Erro para criar '+FName,mtError, [mbAbort,mbRetry,mbIgnore],0) of
        mrAbort:Break; //Exit for... loop
        mrRetry:GoTo TryAgain2;
        mrIgnore:Continue;//Continue for... loop
      end;
    try
      repeat
        TryAgain3:
        {$I-}
        BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
        {$I+}
      if IOResult <> 0 then
        case MessageDlg('Erro ao ler arquivo'#13#10+FName,mtError,
          [mbAbort,mbRetry,mbIgnore],0) of
          mrAbort:Break; //Exit repeat... loop
          mrRetry:GoTo TryAgain3;
          mrIgnore:Continue;//Continue repeat... loop
        end;
      if BytesCopied > 0 then
      begin{ if we read anything... }
        TryAgain4:
        {$I-}
        //FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
        {$I+}

        if IOResult <> 0 then
          case MessageDlg('Erro ao gravar arquivo'#13#10+FName,mtError,
            [mbAbort,mbRetry,mbIgnore],0) of
            mrAbort:Break; //Exit repeat... loop
            mrRetry:GoTo TryAgain4;
           mrIgnore:Continue;//Continue repeat... loop
          end;
      end;
      until BytesCopied < ChunkSize; { until we run out of chunks }
    finally
      FileSetDate(Dest, TimeStamp);
      FileClose(Dest); { close the destination file }
    end;
  end;
  finally
    ProgressBar.Position := 0;
    CopiaArquivo.Caption := '';
    DestinationFiles.Update;
    FreeMem(CopyBuffer, ChunkSize);
    Screen.Cursor := crDefault;
  end;
  end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
//  fCopia.MoveArquivos(SourceFiles, DestinationFiles);
MoveFile(PChar('D:\Teste_Destino\19900712-35400-NAC-0001-NOT.tif'),PChar('D:\Teste_SGI\19900712-35400-NAC-0001-NOT.tif'))
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  fCopia := TCopiaArquivo.Create;
end;
end.

Última edición por Casimiro Notevi fecha: 15-07-2011 a las 14:14:49.