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
fCopia: TCopiaArquivo;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
FName,SDir,DDir:string;
CopyBuffer: Pointer;
TimeStamp, BytesCopied: Longint;
Source, Dest,dir_atual: Integer;
i,incre:integer;
SSepar,DSepar:string;
label TryAgain,TryAgain2,TryAgain3,TryAgain4; 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);
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);
TryAgain:
Source := FileOpen(SDir+SSepar+FName, fmShareDenyWrite);
if Source < 0 then
case MessageDlg('Erro de Leitura de Arquivo'#13#10+FName,mtError,
[mbAbort,mbRetry,mbIgnore],0) of
mrAbort:Break; mrRetry:GoTo TryAgain;
mrIgnore:Continue; end;
if WriteOpt.ItemIndex = 1 then 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; mrAll:WriteOpt.ItemIndex:=0; end;
TryAgain2:
MoveFile(PChar(SDir+DSepar+FName),PChar(DDir+DSepar+FName)); if Dest < 0 then
case MessageDlg('Erro para criar '+FName,mtError, [mbAbort,mbRetry,mbIgnore],0) of
mrAbort:Break; mrRetry:GoTo TryAgain2;
mrIgnore:Continue; end;
try
repeat
TryAgain3:
{$I-}
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);
{$I+}
if IOResult <> 0 then
case MessageDlg('Erro ao ler arquivo'#13#10+FName,mtError,
[mbAbort,mbRetry,mbIgnore],0) of
mrAbort:Break; mrRetry:GoTo TryAgain3;
mrIgnore:Continue; end;
if BytesCopied > 0 then
begin
TryAgain4:
{$I-}
{$I+}
if IOResult <> 0 then
case MessageDlg('Erro ao gravar arquivo'#13#10+FName,mtError,
[mbAbort,mbRetry,mbIgnore],0) of
mrAbort:Break; mrRetry:GoTo TryAgain4;
mrIgnore:Continue; end;
end;
until BytesCopied < ChunkSize;
finally
FileSetDate(Dest, TimeStamp);
FileClose(Dest);
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
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.