Função para Copiar Multiplos Arquivos

Autor: Anderson Souza www.souza.orgfree.com
Data: 26/07/2006

O Delphi possui comandos para copiar um arquivo, mas as vezes precisamos copiar vários arquivos, ou melhor dizendo todo o conteúdo de um diretório. Abaixo temos uma função que copia todo o conteúdo de um diretório e seus devidos sub-diretórios, desde que obedeçam a mascará informada (*.txt, *.*).

A função tem a opção de sobreescrever arquivos caso já existam. Também retorna False se tiver erros ao tentar copiar.

A opção “TipoMensagem” define se ao copiar e tiver erros como esse erro deve ser retornado, 0 (zero) não informa erro durante a cópia apenas False será retornado pela Função. Valor 1 (um), retorna uma mensagem de erro para cada arquivo que tiver problemas ao ser copiado informando o arquivo origem e local destino, 2 (dois) semelhante ao 1 (um), mas não informa o arquivo origem e destino.



Function CopiarArquivos(Origem, Destino, Mascara : String; SubDiretorio, Sobrescrever : Boolean; TipoMensagem : Integer) : Boolean;

var
  ListaDir : TSearchRec;
 I : Integer;
 VOrigem,
 VDestino : String;
 Retorno : Boolean;
begin
  Retorno := True;
  I := FindFirst((Origem + Mascara), faAnyFile, ListaDir);
  While I = 0 do
  Begin
    If (ListaDir.Name[1] <> '.') and (Trim(ListaDir.Name) <> '') Then
    Begin
      VOrigem := (Origem + ListaDir.Name);
      VDestino := (Destino + ListaDir.Name);
      {$I-}
      If not CopyFile(PChar(VOrigem), PChar(VDestino), Sobrescrever) Then
      Begin
        If FileExists(VOrigem) Then
        Begin
          If IOResult <> 0 Then
          Begin
            Retorno := False;
            If TipoMensagem = 1 Then
              MessageDLG(('Ocorreu um erro durante a cópia do arquivo: '+#13+VOrigem+#13+' para '+#13+VDestino+'.'), mtError,[mbOK],0){if}
            Else
              If TipoMensagem = 2 Then
                MessageDLG('ERRO: Ocorreu um erro na cópia de arquivos!', mtError,[mbOK],0);{if/if}
          End;{if}
        End;{if}
        If (SubDiretorio) and (not FileExists(VOrigem)) Then
        Begin
          If not DirectoryExists(VDestino) Then
            MKDir(VDestino);{if}
          If CopiarArquivos((VOrigem+'\'),(VDestino+'\'), Mascara, True, Sobrescrever, TipoMensagem) = False Then
            Retorno := False;{if}
        End;{if}
      End;{if}
      {$I+}
    End;{if}
    I := FindNext(ListaDir);
  End;{do}
  Result := Retorno;
End;{function}