Fórum Copia Arquivos, Compactação E Deleção Diretorio Backup de arquivos #14159

procedure TfrmBackupClipper.btnCopiaClick(Sender: TObject);
{:Objetivo: Copiar Arquivos ::Author: juan 29/01/2009 10:40:07 ::}
var
  wDestino, wOrigem: string;
begin
  wDestino := Trim(edtDestino.Text);
  wOrigem := Trim(edtOrigem.Text);
  iTipoEmpresa := ComboBox1.ItemIndex;
  iOrigem := Copy(wOrigem, 1, 1);
  iDestino := Copy(wDestino, 1, 1);  
  Application.ProcessMessages;
  { Copia os arquivos Origem->Destino}
  if fncCopiarArquivos(wOrigem, wDestino) then
  begin
    { Zipar os arquivos }
    if fncZipa(wDestino,Copy(wOrigem,1,Pos(wOrigem,'SISTEMA')+10)) then
    begin
      { Exclui arquivos }       
      fncDelFiles(wDestino + '\*.DB?');
      fncDelFiles(wDestino + '\*.MEM');
      fncDelFiles(wDestino + '\*.EXE');
      fncDelFiles(wDestino + '\*.NTX');
      fncDelFiles(wDestino + '\*.LOG');   
      { Exclui Diretorio }
      fncDelDiretorio( Self.Handle,wDestino);
    end;
  end;
end;

function TfrmBackupClipper.fncCopiarArquivos(pOrigem: string; pDestino: string):
  Boolean;
{: Objetivo: Copia do sistema ::Author: juan 2008.09.14 11:04:31:}
var
  // ShellAPI 269
  wFos: TSHFileOpStruct;
  wBuf: array[0..8096] of Char;
  wP: PChar;
  wDest: string;
begin  
  Result := False;
  if DirectoryExists(pDestino) then
  begin
    fncMensagem('O diretório de Destino já existe. [ ' + pDestino + ' ]', 48, -1);
    if edtDestino.CanFocus then
      edtDestino.SetFocus;
    Exit;
  end;
  FillChar(wBuf, SizeOf(wBuf), #0);
  wP := @wBuf;
  case ComboBox1.ItemIndex of
    0:
      begin
        if FileExists(pOrigem + '\EMPRESA.dbf') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.db?')) + 1;
        if FileExists(pOrigem + '\VENDA.MEM') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.mem')) + 1;
        if FileExists(pOrigem + '\*.LOG') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.LOG')) + 1;
        if FileExists(pOrigem + '\CAIXA.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\caixa.exe')) + 1;
        if FileExists(pOrigem + '\ADM.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\adm.exe')) + 1;
        if FileExists(pOrigem + '\BIBLIMPE.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\biblimpe.exe')) + 1;
        if FileExists(pOrigem + '\ACERTO.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\acerto.exe')) + 1;
        if FileExists(pOrigem + '\COMPANY.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\company.exe')) + 1;
        if FileExists(pOrigem + '\TABELAS.EXE') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\tabelas.exe')) + 1;
      end;
    1:
      begin
        wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.db?')) + 1;
        wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.mem')) + 1;
        wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.LOG')) + 1;
        wp := StrECopy(wp, PAnsiChar(pOrigem + '\ELETRICA.exe')) + 1;
      end;
    2:
      begin
        if FileExists(pOrigem + '\EMPRESA.dbf') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.db?')) + 1;
        if FileExists(pOrigem + '\VENDA.MEM') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.mem')) + 1;
        if FileExists(pOrigem + '\*.LOG') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\*.LOG')) + 1;
        if FileExists(pOrigem + '\REST.exe') then
          wp := StrECopy(wp, PAnsiChar(pOrigem + '\REST.exe')) + 1;
      end;
  end;
  if Empty(wBuf) then
  begin
    fncMensagem('Sem dados para copiar. Verifique tente novamente', 48, -1);
    Abort;
  end;
  wDest := pDestino;
 { COPIA-ORIGEM-DESTINO preenche a estrutura }
  FillChar(wFos, SizeOf(wFos), #0);
  with wFos do
  begin
    Wnd := Application.Handle;
    wFunc := FO_COPY; { LongWord }
    pFrom := @wBuf;
    pTo := pChar(wDest);
    fFlags := 0;
  end;
  if ((SHFileOperation(wFos) <> 0) or (wFos.fAnyOperationsAborted <> False)) then
  begin
    fncMensagem('Operação de copia, cancelada', 48, -1);
    CloseHandle(wFos.Wnd); { Libera os Handles }
    Exit;
  end;
  Application.ProcessMessages;
  ShFreeNameMappings(GlobalHandle(wFos.hNameMappings));
  CloseHandle(wFos.Wnd); { Libera os Handles }
  Result := True;
end;

function fncDelFiles(vMasc: string): Boolean;
{$ENDREGION}
{Apaga arquivos usando mascaras tipo: c:\Temp\*.zip, c:\Temp\*.*
 Obs: Requer o Path dos arquivos a serem deletados}
var
  iSearchRec: TSearchRec;
begin
  try
    //FindFirst(vMasc, faArchive, iSearchRec);
    Result := (FindFirst(vMasc, faAnyFile, iSearchRec) = 0);
    repeat
      Result := DeleteFile(ExtractFilePAth(vMasc) + iSearchRec.Name);
    until FindNext(iSearchRec) <> 0;
  finally
    FindClose(iSearchRec);
  end;
end;

procedure fncDelDiretorio(hHandle: THandle; const sPath: string);
{:Objetivo: Deleta Diretorio  ::Author: juan 11/01/2010 06:04:26 ::}
var
  OpStruc: TSHFileOpStruct;
  FromBuffer, ToBuffer: array[0..128] of Char;
begin
  fillChar(OpStruc, Sizeof(OpStruc), 0);
  FillChar(FromBuffer, Sizeof(FromBuffer), 0);
  FillChar(ToBuffer, Sizeof(ToBuffer), 0);
  StrPCopy(FromBuffer, sPath);
  with OpStruc do
  begin
    Wnd := hHandle;
    wFunc := FO_DELETE;
    pFrom := @FromBuffer;
    pTo := @ToBuffer;
    fFlags := FOF_NOCONFIRMATION;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
//lpszProgressTitle:=nil;
  end;
  ShFileOperation(OpStruc);
end;