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
Muy bueno, amigo, voy a hacer
Muy bueno, amigo, voy a hacer unas pruebas para ver como trabaja, gracias..
¿Tiene algun statusbar para indicar el estado de compresion del archivo?
No, no tiene ningún
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.