[Resolvido] Copiar arquivos

[Renanbg 1]

Bom dia amigos,

Na torry's achei essa dica de como copiar arquivos e mostrar o andamento.

 

 

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 do
  begin
    Min := 0;
    Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');
end;

Gostaria de fazer 2 alterações ali.

 

Uma delas seria trocar a progressbar por um gauge que alem de mais bonito mostra a porcentagem. Tentei, mas o gauge não entende esse comando NumRead.

A outra seria adaptar isso a minha aplicação, então eu precisaria copiar todo conteudo de uma pasta que esta no servidor para uma pasta no disco local.

 

Alguem sabe como fazer isso?

[Waldinho 0]

Olá, Renanbg.

CopyFileEx pode fazer isso que você quer.

CopyFileEx(const FileName, DestName: string; OverwriteReadOnly, ShellDialog: Boolean; ProgressControl: TControl);

Parâmetros:

FileName = Nome do arquivo origem que você quer copiar (Inclusive o caminho) - String;

DestName = Nome do arquivo destino para onde você quer copiar o arquivo origem (Inclusive o caminho) - String;

OverWriteReadOnly = Indica se deve sobrescrever ou não caso o arquivo já exista no diretório destinho - Boolean (True ou False);

ShellDialog = Indica se deve mostrar ou não uma janela de progressão (em caso positivo, não precisará de Gauge nem ProgressBar na sua aplicação) - Boolean (True ou False);

ProgressControl = Controle que mostrará o progresso da cópia (Gauge ou ProgressBar).

 

Ex:

CopyFileEx('C:\Windows\Welcome.exe', 'C:\Temp\Welcome.exe', False, True, Gauge1)

[Renanbg 1]

Olá Waldinho,

Não consigo copiar varios arquivos de um lugar para outro.

EX: Gostaria de copiar todo conteudo da pasta \\servidor\c\sistema\tabelas para c:\backup

 

Um amigo me ajudou a trocar o progressbar por gauge.

ficou assim:

 

procedure TForm1.CopyFiles(Source, Destination: string);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Gauge1 do
  begin
    MinValue := 0;
    MaxValue := FileLength;
    Progress := 0;

    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      AddProgress(NumRead);
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

E no botão

 

procedure TForm1.btn1Click(Sender: TObject);
var
  Rec:    TSearchRec;
  ArqOri: String;
  ArqDst: String;
  Res:    Integer;

begin
  Res := FindFirst('\\servidor\c\tabelas\*.*', faAnyFile, Rec);

  while Res = 0 do begin
    if Rec.Attr = faArchive then begin
       ArqOri := '\\servidor\c\tabelas\' + Rec.Name;
       ArqDst := 'C:\backup\' + Rec.Name;

       CopyFiles(ArqOri, ArqDst);
    end;

    Res := FindNext(Rec);
  end;

  FindClose(Rec);
end;

Funciona bem, porem o gauge se atualiza a cada arquivo copiado. Como mudar isso?

[Geovane Velmer 0]

Funciona bem, porem o gauge se atualiza a cada arquivo copiado. Como mudar isso?

 

Olá Renan.. bom eu alterei sua função e agora nela você deve definir a basta onde estão os arquivos

e a pasta para onde vão os arquivos.. define também um gauge e um label para mostrar o arquivo corrente...

 

function TForm1.CopyFiles(Source, Destination: string; Gauge:TGauge; sLabel:TLabel):Boolean;
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  LengthArq:Longint;
  iLength  :Longint;
  Rec:    TSearchRec;
  Res:    Integer;
  sFile: file of byte;
  ArqOri:String;
  ArqDst:String;
begin
Res := FindFirst(Source+'\*.*', faAnyFile, Rec);

//--Rotina que pega o tamanho dos arquivos ----
//---------------------------------------------
iLength:= 0;
while Res = 0 do
begin
Application.ProcessMessages;
if Rec.Attr = faArchive then
   begin
   ArqOri := Source+'\' + Rec.Name;
   AssignFile(sFile,ArqOri);
   Reset(sFile);
   iLength:= iLength + FileSize(sFile);
   CloseFile(sFile);
   end;
Res := FindNext(Rec);
end;
FindClose(Rec);
//---------------------------------------------

Gauge.MinValue:= 0;
Gauge.MaxValue:= iLength;

Res := FindFirst(Source+'\*.*', faAnyFile, Rec);
while Res = 0 do
begin
Application.ProcessMessages;
if Rec.Attr = faArchive then
   begin
   ArqOri := Source+'\' + Rec.Name;
   ArqDst := Destination+'\' + Rec.Name;
   sLabel.Caption:= 'Copiando... '+Rec.Name;

   AssignFile(FromF, ArqOri);
   reset(FromF);
   AssignFile(ToF, ArqDst);
   rewrite(ToF);
   LengthArq:= FileSize(FromF);
   while LengthArq > 0 do
   begin
    Application.ProcessMessages;
    BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
    LengthArq := LengthArq - NumRead;
    BlockWrite(ToF, Buffer[0], NumRead);
    Gauge.AddProgress( NumRead );
   end;
   CloseFile(FromF);
   CloseFile(ToF);
   end;
Res := FindNext(Rec);
end;

sLabel.Caption:= '';
Gauge.Progress:= 0;
FindClose(Rec);
end;

Ela vai servir até pra mim por que eu quero fazer um instalador pra o meu programa..

Espero que ajude!

 

Abraços e boa sorte!

[Renanbg 1]

Boa tarde Geovane,

 

Antes de mais nada, grato pela ajuda. Eu não consegui compilar o projeto na linha abaixo que vai na programação do botão.

 

CopyFiles(ArqOri, ArqDst);

Por esse erro.

 

[DCC Error] Unit1.pas(115): E2035 Not enough actual parameters

Alguma sugestão?

[Geovane Velmer 0]

Boa tarde Geovane,

 

Antes de mais nada, grato pela ajuda. Eu não consegui compilar o projeto na linha abaixo que vai na programação do botão.

 

CopyFiles(ArqOri, ArqDst);

Por esse erro.

 

[DCC Error] Unit1.pas(115): E2035 Not enough actual parameters

Alguma sugestão?

 

O Que acontece é que agora você deve adicionar mais parametros a função

o modo de usar é

 

procedure TF_MAIN.BitBtn1Click(Sender: TObject);
begin
  CopyFiles('C:\Sistema','C:\Backup',Gauge1,Label1);
end;

Na função eu adicionei o parametro para você informar qual gauge ira usar e tambem um label

para mostrar o arquivo que a função esta copiando no momento.

[Renanbg 1]

Hum, entendi.

Agora deu certo, alias ficou excelente.

 

Sem querer abusar, sabe me dizer se é possível alterar essa mesma função para que ela copie também as pastas que estão dentro do caminho especificado?

 

abraços

[Geovane Velmer 0]

Hum, entendi.

Agora deu certo, alias ficou excelente.

 

Sem querer abusar, sabe me dizer se é possível alterar essa mesma função para que ela copie também as pastas que estão dentro do caminho especificado?

 

abraços

 

Cara isso já é um pouco mais complicado.. mas como eu também vou precisar de uma função assim,

então vou tentar fazer e se conceguir posto aqui pra você ver... Mas vai tentando você ai também.

 

Att..

[Renanbg 1]

Tenho essa função que faz exatamente isso Geovane. Ela copia o diretório inteirinho, com arquivos e pastas.

 

Function CopyDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_COPY;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if cCopyDir('C:\download', 'D:\') = True then
    ShowMessage('Diretório copiado.');
end;

O que não sei, é adaptar ela para trabalhar com o gauge.

 

Agora a função que achei em um sistema meu. Essa copia tudo que está dentro da pasta especificada usando asteriscos.

 

Diferente da outra que copia a pasta especificada inteira, essa copia só que o esta dentro. Confesso que acho essa melhor.

 

Function CopiaTudo(Origen,Destino : String) : LongInt;
var
Mensagem : String;
F : TShFileOpStruct;
sOrigen, sDestino : String;
begin
Result := 0;
sOrigen := Origen + #0;
sDestino := Destino + #0;
With F do
begin
Wnd := Application.Handle;
wFunc := FO_COPY;
pFrom := @sOrigen[1];
pTo := @sDestino[1];
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION
end;
Result := ShFileOperation(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CopiaTudo('D:\importante\*.*','C:\backup');
end;

Estudei, mas não imagino como adaptar ao gauge.

[Renanbg 1]

Revivendo o topico.

 

mudei recentemente de paradox para firebird e a rotina do post 4 funciona bem se colocada num novo projeto.

 

agora se eu tentar usar ela no projeto em firebird da erro dizendo que não acha o arquivo .FDB no servidor.

 

isso pode ser pelo fato do sistema ter as conexoes abertas?

 

como posso fazer uma copia de segurança desse arquivo .FDB?