Copiar o conteudo de uma pasta

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.