Comprimir un archivo con RtlCompressBuffer

Enviado por admin el Dom, 04/26/2009 - 22:53

El siguiente código es un ejemplo, sencillo, de como comprimir y descomprimir un archivo usando la función RtlCompressBuffer.

Esta unit contiene las funciones para comprimir/descomprimir un archivo o un stream:

unit Compressor;
 
interface
 
uses Windows, Sysutils, Classes;
 
function CompressStream(InStream, OutStream: TStream): Boolean;
function CompressFile(Src, Dst: String): Boolean;
function DecompressStream(InStream, OutStream: TStream): Boolean;
function DecompressFile(Src, Dst: String): Boolean;
 
implementation
 
type
  NTSTATUS = ULONG;
  USHORT = Word;
 
  TBufferHeader = record
    CompressedBufferSize: ULONG;
  end;
 
const
  ntdll = 'ntdll.dll';
 
  COMPRESSION_FORMAT_LZNT1    = $0002;
  COMPRESSION_ENGINE_STANDARD = $0000;
  COMPRESSION_ENGINE_MAXIMUM  = $0100;
 
  STATUS_SUCCESS          = $00000000;
  STATUS_BUFFER_ALL_ZEROS = $00000117;
  STATUS_BUFFER_TOO_SMALL = $C0000023;
 
 
  BUFFER_SIZE = 32*1024;
  MAX_BUFFER_SIZE = 8*BUFFER_SIZE;
 
function RtlCompressBuffer(CompressionFormatAndEngine: USHORT; UncompressedBuffer: PUCHAR;
  UncompressedBufferSize: ULONG; CompressedBuffer: PUCHAR; CompressedBufferSize: ULONG;
  UncompressedChunkSize: ULONG; FinalCompressedSize: PULONG; WorkSpace: Pointer
  ): NTSTATUS; stdcall; external ntdll;
 
function RtlDecompressBuffer(CompressionFormat: USHORT; UncompressedBuffer: PUCHAR;
  UncompressedBufferSize: ULONG; CompressedBuffer: PUCHAR; CompressedBufferSize: ULONG;
  FinalUncompressedSize: PULONG): NTSTATUS; stdcall; external ntdll;
 
function RtlGetCompressionWorkSpaceSize(CompressionFormatAndEngine: USHORT;
  CompressBufferWorkSpaceSize: PULONG; CompressFragmentWorkSpaceSize: PULONG
): NTSTATUS; stdcall; external ntdll;
 
function CompressStream(InStream, OutStream: TStream): Boolean;
var
  i: ULONG;
  Status: NTSTATUS;
  FormatAndEngine: USHORT;
  UnCompressedBuffer: PUCHAR;
  CompressedBuffer: PUCHAR;
  CompressedBufferSize: ULONG;
  WorkSpace: Pointer;
  WorkSpaceSize,FragmentWorkSpaceSize: ULONG;
  BufferHeader: TBufferHeader;
begin
  Result:= FALSE;
  FormatAndEngine:= COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_STANDARD;
  try
    GetMem(UnCompressedBuffer,BUFFER_SIZE);
    try
      CompressedBufferSize:= BUFFER_SIZE;
      GetMem(CompressedBuffer,CompressedBufferSize);
      try
        RtlGetCompressionWorkSpaceSize(FormatAndEngine,@WorkSpaceSize,
          @FragmentWorkSpaceSize);
        GetMem(WorkSpace,WorkSpaceSize);
        try
          repeat
            i:= InStream.Read(UnCompressedBuffer^,BUFFER_SIZE);
            repeat
              FillChar(BufferHeader,Sizeof(TBufferHeader),#0);
              Status:= RtlCompressBuffer(FormatAndEngine,UnCompressedBuffer,i,
                CompressedBuffer,CompressedBufferSize,4096,@BufferHeader.CompressedBufferSize,
                WorkSpace);
              if Status = STATUS_BUFFER_TOO_SMALL then
              begin
                CompressedBufferSize:= CompressedBufferSize + BUFFER_SIZE;
                ReallocMem(CompressedBuffer,CompressedBufferSize);
              end;
            until (Status <> STATUS_BUFFER_TOO_SMALL) or (CompressedBufferSize > MAX_BUFFER_SIZE);
            if (Status <> STATUS_SUCCESS) and (Status <> STATUS_BUFFER_ALL_ZEROS) then
              Exit;
            OutStream.WriteBuffer(BufferHeader,Sizeof(TBufferHeader));
            OutStream.WriteBuffer(CompressedBuffer^,BufferHeader.CompressedBufferSize);
          until i < BUFFER_SIZE;
          Result:= TRUE;
        finally
          FreeMem(WorkSpace);
        end;
      finally
        FreeMem(CompressedBuffer);
      end;
    finally
      FreeMem(UnCompressedBuffer);
    end;
  except  end;
end;
 
function CompressFile(Src, Dst: String): Boolean;
var
  InStream, OutStream: TFileStream;
begin
  Result:= FALSE;
  try
    InStream:= TFileStream.Create(Src,fmOpenRead or fmShareDenyWrite);
    try
      OutStream:= TFileStream.Create(Dst,fmCreate or fmShareDenyWrite);
      try
        Result:= CompressStream(Instream,OutStream);
      finally
        OutStream.Free;
      end;
    finally
      InStream.Free;
    end;
  except end;
end;
 
function DecompressStream(InStream, OutStream: TStream): Boolean;
var
  i: ULONG;
  Status: NTSTATUS;
  FormatAndEngine: USHORT;
  UnCompressedBuffer: PUCHAR;
  UnCompressedBufferSize: ULONG;
  CompressedBuffer: PUCHAR;
  WorkSpace: Pointer;
  WorkSpaceSize,FragmentWorkSpaceSize: ULONG;
  BufferHeader: TBufferHeader;
begin
  Result:= FALSE;
  FormatAndEngine:= COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_STANDARD;
  try
    UnCompressedBufferSize:= BUFFER_SIZE;
    GetMem(UnCompressedBuffer,UnCompressedBufferSize);
    try
      GetMem(CompressedBuffer,BUFFER_SIZE);
      try
        RtlGetCompressionWorkSpaceSize(FormatAndEngine,@WorkSpaceSize,
          @FragmentWorkSpaceSize);
        GetMem(WorkSpace,WorkSpaceSize);
        try
          while TRUE do
          begin
            i:= InStream.Read(BufferHeader,SizeOf(TBufferHeader));
            if i = SizeOf(TBufferHeader) then
            begin
              if BufferHeader.CompressedBufferSize <= MAX_BUFFER_SIZE then
              begin
                Instream.ReadBuffer(CompressedBuffer^,BufferHeader.CompressedBufferSize);
                repeat
                  Status:= RtlDecompressBuffer(FormatAndEngine,UnCompressedBuffer,UnCompressedBufferSize,
                    CompressedBuffer,BufferHeader.CompressedBufferSize,@i);
                  if Status = STATUS_BUFFER_TOO_SMALL then
                  begin
                    UnCompressedBufferSize:= UnCompressedBufferSize + BUFFER_SIZE;
                    ReallocMem(UnCompressedBuffer,UnCompressedBufferSize);
                  end;
                until (Status <> STATUS_BUFFER_TOO_SMALL) or (UnCompressedBufferSize > MAX_BUFFER_SIZE);
                if (Status <> STATUS_SUCCESS) and (Status <> STATUS_BUFFER_ALL_ZEROS) then
                  Exit;
                OutStream.WriteBuffer(UnCompressedBuffer^,i);
              end else
                Exit;
            end else
            begin
              if i = 0 then
                Result:= TRUE;
              Exit;
            end;
          end;
        finally
          FreeMem(WorkSpace);
        end;
      finally
        FreeMem(CompressedBuffer);
      end;
    finally
      FreeMem(UnCompressedBuffer);
    end;
  except  end;
end;
 
function DecompressFile(Src, Dst: String): Boolean;
var
  InStream, OutStream: TFileStream;
begin
  Result:= FALSE;
  try
    InStream:= TFileStream.Create(Src,fmOpenRead or fmShareDenyWrite);
    try
      OutStream:= TFileStream.Create(Dst,fmCreate or fmShareDenyWrite);
      try
        Result:= DecompressStream(Instream,OutStream);
      finally
        OutStream.Free;
      end;
    finally
      InStream.Free;
    end;
  except end;
end;
 
end.

Un ejemplo de como usar las funciones anteriores:

  if CompressFile('C:\1.txt','C:\1.bin') then
    DecompressFile('c:\1.bin','C:\1.txt');

Los ratios de compresión no son una maravilla, dependiendo del archivo podremos tener archivos comprimidos hasta un 30% mas grandes que los obtenidos con compresores comerciales como Winzip o Winrar, pero lo que perdemos en ratios de compresión lo ganamos en sencillez. En resumen, se trata de una alternativa más, que se puede mejorar de muchas manera pero que puede ser útil en algunos casos puntuales.

Para saber más:
http://msdn.microsoft.com/en-us/library/bb981783.aspx

Comentarios

Enviado por ctrl.attack (no verificado) el Sáb, 05/02/2009 - 14:11

Muy bueno, amigo, voy a hacer unas pruebas para ver como trabaja, gracias..

¿Tiene algun statusbar para indicar el estado de compresion del archivo?

Enviado por admin el Dom, 05/03/2009 - 04:13

No, no tiene ningún statusbar. El ejemplo es intencionadamente sencillo, pero puedes añadirle un statusbar muy fácilmente, solo tienes que obtener el tamaño del archivo al comenzar y dentro del bucle "repeat ... until" ir modificando la posición del statusbar cada vez que comprimas o descomprimas un bloque.