Copiar o conteudo de uma pasta
Como copiar todo o conteúdo de uma pasta para outra? Tem como dar um while em um diretótio? Como colocar uma ProgressBar ou Gauge?
Paulo
Curtidas 0
Respostas
Alves
17/08/2004
Esse código é um exemplo completo de como copiar arquivos de uma pasta para outra.
Código:
Código:
unit copy;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
SourceDrive: TDriveComboBox;
DestinationDrive: TDriveComboBox;
SourceDirectory: TDirectoryListBox;
DestinationDirectory: TDirectoryListBox;
SourceFiles: TFileListBox;
DestinationFiles: TFileListBox;
ProgressBar: TProgressBar;
CopiaArquivo: TLabel;
WriteOpt: TRadioGroup;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var FName,SDir,DDir:string;
CopyBuffer: Pointer; { buffer for copying }
TimeStamp, BytesCopied: Longint;
Source, Dest: Integer; { handles }
i: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:=´Copiar: ´+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´#1310+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.´#1310´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}
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´#1310+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´1310+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;
end.
GOSTEI 0