ADSENSE

ADSENSE

quarta-feira, 22 de fevereiro de 2012

Função pra compactar e descompactar arquivos em delphi

Boa tarde amigos delphianos.
Estou publicando duas procedures que serve pra compactar e descompactar vários arquivos em Delphi usando a lib.  zlib do próprio Delphi.

Só se deve ter o cuidado que o arquivo compactado só se consegue descompactar usando a função de descomprimir que abaixo estou publicando, isso porque a compactação é feita em modo de stream e função própria. Talvez tenha algum programa que consiga descompactar mas não foi testado.
Mas vamos as procedure.

procedure Comprimir(ArquivoCompacto: TFileName; Arquivos: array of TFileName);
var
  FileInName: TFileName;
  FileEntrada, FileSaida: TFileStream;
  Compressor: TCompressionStream;
  NumArq, I, Len, Size: Integer;
  Fim: Byte;
begin
  FileSaida := TFileStream.Create(ArquivoCompacto, fmCreate or fmShareExclusive);
  Compressor := TCompressionStream.Create(clMax, FileSaida);
  NumArq := Length(Arquivos);
  Compressor.Write(NumArq, SizeOf(Integer));
  try
    for I := Low(Arquivos) to High(Arquivos) do begin
      FileEntrada := TFileStream.Create(Arquivos[I], fmOpenRead and fmShareExclusive);
      try
        FileInName := ExtractFileName(Arquivos[I]);
        Len := Length(FileInName);
        Compressor.Write(Len, SizeOf(Integer));
        Compressor.Write(FileInName[1], Len);
        Size := FileEntrada.Size;
        Compressor.Write(Size, SizeOf(Integer));
        Compressor.CopyFrom(FileEntrada, FileEntrada.Size);
        Fim := 0;
        Compressor.Write(Fim, SizeOf(Byte));
      finally
        FileEntrada.Free;
      end;
    end;
  finally
    FreeAndNil(Compressor);
    FreeAndNil(FileSaida);
  end;
end;
procedure Descomprimir(ArquivoZip: TFileName; DiretorioDestino: string);
var
  NomeSaida: string;
  FileEntrada, FileOut: TFileStream;
  Descompressor: TDecompressionStream;
  NumArq, I, Len, Size: Integer;
  Fim: Byte;
begin
  FileEntrada := TFileStream.Create(ArquivoZip, fmOpenRead and fmShareExclusive);
  Descompressor := TDecompressionStream.Create(FileEntrada);
  Descompressor.Read(NumArq, SizeOf(Integer));
  try
    I := 0;
    while I < NumArq do begin
      Descompressor.Read(Len, SizeOf(Integer));
      SetLength(NomeSaida, Len);
      Descompressor.Read(NomeSaida[1], Len);
      Descompressor.Read(Size, SizeOf(Integer));
      FileOut := TFileStream.Create(
        IncludeTrailingBackslash(DiretorioDestino) + NomeSaida, 
        fmCreate or fmShareExclusive);
      try
        FileOut.CopyFrom(Descompressor, Size);
      finally
        FileOut.Free;
      end;
      Descompressor.Read(Fim, SizeOf(Byte));
      Inc(I);
    end;
  finally
    FreeAndNil(Descompressor);
    FreeAndNil(FileEntrada);
  end;
end;

Um exemplo de uso, seria:
var
  //vetor para guardar os nomes dos arquivos a ser compactados
  ListaArquivos: Array of TFileName;
begin
  //define o tamanho do vetor (qtde. de arquivos)
  SetLength(ListaArquivos, 2);
  //preenche a lista com os arquivos
  ListaArquivos[0] := 'C:\Windows\Bruma.bmp';
  ListaArquivos[1] := 'C:\Windows\Cafezinho.bmp';
  //executa a compactação, gerando o arquivo C:\Compactado.xxx
  Comprimir('C:\Compactado.xxx', ListaArquivos);
  //cria um diretório de teste para descompactarmos
  MkDir('C:\Descompactado');
  //executa a descompactação no diretório criado
  Descomprimir('C:\Compactado.xxx', 'C:\Descompactado');
end;

terça-feira, 25 de outubro de 2011

Função pra preencher string

function Preenche(Campo, Letra, Alinhamento: String; Tamanho: Integer): String;
var i00 : Integer;
begin
    // Campo = Passar campo a ser preenchido
    // Letra    = Caracter pra ser prenchido
    // Alinhamento = Preencher a esquerda("E") ou direita ("D")

    Campo := Trim(Campo);

     Result := '';
     for i00:=1 to Tamanho - Length(Campo) do Result := Result + Letra;

     if Alinhamento = 'E' then
        Result := Result + Campo
    else
         Result := Campo + Result;
   end;
end;


EX:  edit1.Text := Preenche(edit1.Text, '0', 'E', 10);

segunda-feira, 3 de outubro de 2011

DATA DE CRIACAO DE UM ARQUIVo

Boa Tarde.
As vezes a gente se depara com alguns problemas como saber a data de criação de um arquivo ou .exe, por isso abaixo vou colocar uma função que faz este processo pra vcs. Claro que esta função é bem simples podendo ser melhorar a gosto pessoal de cada um, mas segue a que uso normalmente em questão simples.


function TForm1.DATADECRIACAO(Arq: string): TDateTime;
var ffd:TWin32FindData;
    dft :DWORD;
    lft :TFileTime;
    h   :THandle;
begin
   h:= Windows.FindFirstFile(PChar(Arq), ffd);
   try
      if (INVALID_HANDLE_VALUE <> h) then begin
         FileTimeToLocalFileTime(ffd.ftCreationTime,lft);
         FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
         Result := FileDateToDateTime(dft);
      end
   finally
      Windows.FindClose(h);
   end;
end;

Exemplo de uso da  função.
procedure TForm1.Button1Click(Sender: TObject);
begin
   edit1.Text := DateToStr(DATADECRIACAO('C:\DATA.txt'));
end;