10-17-2011، 11:11 PM
کد:
unit retCompress;
{
RetCompress unit
=============================================================
author: retnyg @ krazz.net/retnyg
=============================================================
License: use this code whereever you want, but keep credits
=============================================================
uses a undocumented API of ntdll to compress data.
compression rate is similar to ZIP, but a lot faster.
disadvantage: needs winNT, API may be changed or abandoned
in the future.
i added also the routines Inflate/Deflate, which just
packs sequential #0's, which is quite effective when
packing small exe's.
take also a look at the function HardCodedString, it's
commented out, because it needs the command inttostr,
which is in sysutils. It can be used to Hardcode a binary
string into a delphi app, such as to generate an exe by code.
example application can be found here:
http://www.delphipraxis.net/topic54428_batch+dateien.html
( batch2exe, also written by me )
Information about the used Api Commands can be found here:
http://undocumented.ntinternals.net/
}
interface
uses windows
// , retasmtools
// , sysutils
;
type
PVOID = pointer;
ULONG = cardinal;
NTSTATUS = cardinal;
const
// RtlCompressBuffer constants
COMPRESSION_FORMAT_NONE = $00000000; // [result:STATUS_INVALID_PARAMETER]
COMPRESSION_FORMAT_DEFAULT = $00000001; // [result:STATUS_INVALID_PARAMETER]
COMPRESSION_FORMAT_LZNT1 = $00000002;
COMPRESSION_FORMAT_NS3 = $00000003; // STATUS_NOT_SUPPORTED
COMPRESSION_FORMAT_NS15 = $0000000F; // STATUS_NOT_SUPPORTED
COMPRESSION_FORMAT_SPARSE = $00004000; // ??? [result:STATUS_INVALID_PARAMETER]
COMPRESSION_ENGINE_STANDARD = $00000000; // Standart compression
COMPRESSION_ENGINE_MAXIMUM = $00000100; // Maximum (slowest but better)
COMPRESSION_ENGINE_HIBER = $00000200; // STATUS_NOT_SUPPORTED
function RtlGetCompressionWorkSpaceSize(CompressionFormatAndEngine: ULONG; CompressBufferWorkSpaceSize, CompressFragmentWorkSpaceSize : PULONG): NTSTATUS; stdcall;
function RtlCompressBuffer(CompressionFormatAndEngine:ULONG; SourceBuffer: PVOID; SourceBufferLength: ULONG; DestinationBuffer: PVOID; DestinationBufferLength: ULONG; SourceChunkSize: ULONG; pDestinationSize: PULONG; WorkspaceBuffer: PVOID):NTSTATUS; stdcall;
function RtlDeCompressBuffer(CompressionFormatAndEngine:ULONG; DestinationBuffer: PVOID; DestinationBufferLength: ULONG; SourceBuffer: PVOID; SourceBufferLength: ULONG; pDestinationSize: PULONG):NTSTATUS; stdcall;
function Compress(s:string):string; stdcall;
function DeCompress(s:string):string; stdcall;
function InFlate(s:string): string; stdcall;
function DeFlate(s:string): string; stdcall;
//function HardCodedString(s:string):string; stdcall;
implementation
const
ntdll = 'ntdll.dll';
function RtlGetCompressionWorkSpaceSize; external ntdll name 'RtlGetCompressionWorkSpaceSize';
function RtlCompressBuffer; external ntdll name 'RtlCompressBuffer';
function RtlDeCompressBuffer; external ntdll name 'RtlDecompressBuffer';
function fastlength(s:string):dword;
asm
test eax, eax
jz @ende
sub eax, 4
mov eax, [eax]
@ende:
end;
function Compress(s:string):string; stdcall;
var wsbuf: pointer;
destLen, destSize, wsSize, wsFragsize: cardinal;
l: cardinal;
p:pdword;
compressionType: cardinal;
begin
l:=fastlength(s);
if l > 0 then begin
// maximum compression can get really slow on bigger files, so we do fast if
// file bigger than a half mb:
if l > $80000 then
compressionType := COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_STANDARD
else
compressionType := COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_MAXIMUM;
rtlGetCompressionWorkspaceSize( compressionType, @wssize, @wsfragsize);
getmem(wsbuf, wssize);
destLen := l + 8;
setlength(result, destLen);
destsize := 0;
rtlCompressBuffer(compressionType, @s[1], l, @result[5], destlen, $1000, @destSize, wsBuf);
freemem(wsbuf);
setlength(result, destSize + 4);
p:=@result[1];
p^:=l;
end else result := '';
end;
function DeCompress(s:string):string; stdcall;
var l, destSize: cardinal;
p:pdword;
compressionType: cardinal;
begin
l := fastlength(s);
if l > 4 then begin
p := @s[1];
setlength(result,p^);
if p^ > $80000 then
compressionType := COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_STANDARD
else
compressionType := COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_MAXIMUM;
rtlDeCompressBuffer( compressionType, @result[1],p^,@s[5],l-4,@DestSize );
setlength(result, DestSize);
end else result := '';
end;
function InFlate(s:string): string; stdcall;
var i: cardinal;
c, ordc: byte;
l: dword;
begin
result := '';
l:=fastlength(s);
i := 1;
while i <= l do begin
ordc := byte(s[i]);
if ordc = 0 then begin
c:=0;
while (byte(s[i])=0) and (c<255) and (i <= l) do begin
inc(c);
inc(i);
end;
result := result + #0 +char(c);
end
else begin
result := result + s[i];
inc(i);
end;
end;
end;
function DeFlate(s:string): string; stdcall;
var i: cardinal;
c, ordc: byte;
l,l2: dword;
begin
result := '';
l:=fastlength(s);
i := 1;
while i <= l do begin
ordc := byte(s[i]);
if ordc = 0 then begin
c:=byte(s[i+1]);
l2:=fastlength(result);
setlength(result, l2 + c);
fillchar(pointer(@result[l2+1])^,c,0);
inc(i);
end
else begin
result := result + s[i];
end;
inc(i);
end;
end;
{
//commented because inttostr needed which is either in sysutils or in a custom unit
function HardCodedString(s:string):string; stdcall;
function isText(b:byte):boolean;
begin
result := false;
if (b >= 32) and (b <= 175) and (b<>168) then result := true;
end;
var i : cardinal;
stract, DoLF: boolean;
ordc: byte;
begin
stract := false;
DoLF:=falsE;
for i := 1 to fastlength(s) do begin
ordc := byte(s[i]);
if ((stract) and (not istext(ordc))) OR
((not stract) and (istext(ordc))) then begin
stract := not stract;
result := result + '''';
end;
if stract then result := result + s[i]
else result := result + '#' + inttostr(ordc);
if i mod 30 = 0 then DoLF := true;
if (not stract) and (DoLF) then begin
result := result + ' + '#13#10;
DoLF := falsE;
end;
end;
if stract then result := result + '''';
result := result + ';';
end;
}
end.کد:
unit rtlcompression;
interface
const
COMPRESSION_ENGINE_STANDARD = $00000000;
COMPRESSION_ENGINE_MAXIMUM = $00000100;
function Compress(const Source: Pointer; var Dest: Pointer; Count: Cardinal;
Compression: Cardinal = COMPRESSION_ENGINE_STANDARD): Cardinal; overload;
function Compress(const Value: String; Compression: Cardinal = COMPRESSION_ENGINE_STANDARD): String; overload;
function Decompress(const Source: Pointer; var Dest: Pointer; Count: Cardinal): Cardinal; overload;
function Decompress(const Value: String): String; overload;
implementation
const
ntdll = 'ntdll.dll';
COMPRESSION_FORMAT_LZNT1 = $00000002;
DECOMPRESSION_MULTIPLICATOR = 150;
type
PULONG = ^ULONG;
ULONG = Cardinal;
function RtlGetCompressionWorkSpaceSize(CompressionFormatAndEngine: ULONG;
CompressBufferWorkSpaceSize, CompressFragmentWorkSpaceSize: PULONG): Cardinal;
stdcall; external ntdll name 'RtlGetCompressionWorkSpaceSize';
function RtlCompressBuffer(CompressionFormatAndEngine: ULONG; UncompressedBuffer: Pointer;
UncompressedBufferSize: ULONG; CompressedBuffer: Pointer; CompressedBufferSize: ULONG;
UncompressedChunkSize: ULONG; FinalCompressedSize: PULONG; WorkSpace: Pointer): Cardinal;
stdcall; external ntdll name 'RtlCompressBuffer';
function RtlDecompressFragment(CompressionFormat:ULONG; UncompressedFragment: Pointer;
UncompressedFragmentSize: ULONG; CompressedBuffer: Pointer; CompressedBufferSize: ULONG;
FragmentOffset: ULONG; FinalUncompressedSize: PULONG; WorkSpace: Pointer): Cardinal;
stdcall; external ntdll name 'RtlDecompressFragment';
function Compress(const Source: Pointer; var Dest: Pointer; Count: Cardinal;
Compression: Cardinal = COMPRESSION_ENGINE_STANDARD): Cardinal;
var
WorkSpace: Pointer;
WorkSpaceSize, ChunkSize: Cardinal;
begin
Result := 0;
Compression := COMPRESSION_FORMAT_LZNT1 or Compression;
RtlGetCompressionWorkSpaceSize(Compression, @WorkSpaceSize, @ChunkSize);
GetMem(Dest, Count);
GetMem(WorkSpace, WorkSpaceSize);
RtlCompressBuffer(Compression, Source, Count, Dest, Count, ChunkSize, @Result, WorkSpace);
FreeMem(WorkSpace);
if Result = 0 then
begin
Move(Source^, Dest^, Count);
Result := Count;
end
else
ReallocMem(Dest, Result);
end;
function Compress(const Value: String; Compression: Cardinal = COMPRESSION_ENGINE_STANDARD): String;
var
Buffer: PChar;
Size: Cardinal;
begin
Size := Compress(@Value[1], Pointer(Buffer), Length(Value), Compression);
SetString(Result, Buffer, Size);
FreeMem(Buffer);
end;
function Decompress(const Source: Pointer; var Dest: Pointer; Count: Cardinal): Cardinal;
var
WorkSpace: Pointer;
WorkSpaceSize, ChunkSize, BytesDecompressed: Cardinal;
begin
Result := 0;
BytesDecompressed := 0;
RtlGetCompressionWorkSpaceSize(COMPRESSION_FORMAT_LZNT1, @WorkSpaceSize, @ChunkSize);
GetMem(WorkSpace, WorkSpaceSize);
ChunkSize := Count * DECOMPRESSION_MULTIPLICATOR div 100;
New(Dest);
repeat
ReallocMem(Dest, Result + ChunkSize);
RtlDecompressFragment(COMPRESSION_FORMAT_LZNT1, Pointer(Cardinal(Dest) + Result), ChunkSize,
Source, Count, Result, @BytesDecompressed, WorkSpace);
if BytesDecompressed <= ChunkSize then
Inc(Result, BytesDecompressed);
until BytesDecompressed <> ChunkSize;
FreeMem(WorkSpace);
if Result = 0 then
begin
Move(Source^, Dest^, Count);
Result := Count;
end
else
ReallocMem(Dest, Result);
end;
function Decompress(const Value: String): String;
var
Buffer: PChar;
Size: Cardinal;
begin
Size := Decompress(@Value[1], Pointer(Buffer), Length(Value));
SetString(Result, Buffer, Size);
FreeMem(Buffer);
end;
end.