david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
355 lines
9.5 KiB
ObjectPascal
355 lines
9.5 KiB
ObjectPascal
unit uROCompression;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
{$IFDEF FPC}
|
|
{$IFDEF MSWINDOWS}
|
|
{$DEFINE FPCMSWIN}
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
{$DEFINE FPCLINUX}
|
|
{$ENDIF}
|
|
{$UNDEF MSWINDOWS}
|
|
{$DEFINE LINUX}
|
|
{$ENDIF FPC}
|
|
|
|
interface
|
|
|
|
uses {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
|
|
Classes;
|
|
|
|
|
|
{$IFDEF LINUX}
|
|
procedure ZCompressStream(anInputStream, aCompressedStream : TStream);
|
|
procedure ZDecompressStream(aCompressedStream, anOutputStream : TStream);
|
|
{$ENDIF LINUX}
|
|
function CompressStr(const aString : String) : String;
|
|
function DecompressStr(const aString : String) : String;
|
|
function CompressAndEncode(const aString: string): string;
|
|
function DecodeAndUnCompress(const aString: string): string;
|
|
procedure EncodeStream(anInputStream, anOutputStream: TStream);
|
|
procedure DecodeStream(anInputStream, anOutputStream: TStream);
|
|
|
|
implementation
|
|
|
|
uses
|
|
uROZLib, SysUtils;
|
|
|
|
const
|
|
EncodeTable: array[0..63] of Char =
|
|
'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
|
|
'abcdefghijklmnopqrstuvwxyz' +
|
|
'0123456789+/';
|
|
|
|
DecodeTable: array[#0..#127] of Integer = (
|
|
Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
|
|
64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
|
|
64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63,
|
|
52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64,
|
|
64, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
|
|
15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64,
|
|
64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
|
|
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);
|
|
|
|
type
|
|
PPacket = ^TPacket;
|
|
TPacket = packed record
|
|
case Integer of
|
|
0: (b0, b1, b2, b3: Byte);
|
|
1: (i: Integer);
|
|
2: (a: array[0..3] of Byte);
|
|
3: (c: array[0..3] of Char);
|
|
end;
|
|
|
|
procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);
|
|
begin
|
|
OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];
|
|
OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
|
|
if NumChars < 2 then
|
|
OutBuf[2] := '='
|
|
else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
|
|
if NumChars < 3 then
|
|
OutBuf[3] := '='
|
|
else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
|
|
end;
|
|
|
|
function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket;
|
|
begin
|
|
Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or
|
|
(DecodeTable[InBuf[1]] shr 4);
|
|
NChars := 1;
|
|
if InBuf[2] <> '=' then
|
|
begin
|
|
Inc(NChars);
|
|
Result.a[1] := (DecodeTable[InBuf[1]] shl 4) or
|
|
(DecodeTable[InBuf[2]] shr 2);
|
|
end;
|
|
if InBuf[3] <> '=' then
|
|
begin
|
|
Inc(NChars);
|
|
Result.a[2] := (DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]];
|
|
end;
|
|
end;
|
|
|
|
procedure EncodeStream(anInputStream, anOutputStream: TStream);
|
|
type
|
|
PInteger = ^Integer;
|
|
var
|
|
InBuf: array[0..509] of Byte;
|
|
OutBuf: array[0..1023] of Char;
|
|
BufPtr: PChar;
|
|
I, J, K, BytesRead: Integer;
|
|
Packet: TPacket;
|
|
begin
|
|
K := 0;
|
|
repeat
|
|
BytesRead := anInputStream.Read(InBuf, SizeOf(InBuf));
|
|
I := 0;
|
|
BufPtr := OutBuf;
|
|
while I < BytesRead do
|
|
begin
|
|
if BytesRead - I < 3 then
|
|
J := BytesRead - I
|
|
else J := 3;
|
|
Packet.i := 0;
|
|
Packet.b0 := InBuf[I];
|
|
if J > 1 then
|
|
Packet.b1 := InBuf[I + 1];
|
|
if J > 2 then
|
|
Packet.b2 := InBuf[I + 2];
|
|
EncodePacket(Packet, J, BufPtr);
|
|
Inc(I, 3);
|
|
Inc(BufPtr, 4);
|
|
Inc(K, 4);
|
|
if K > 75 then
|
|
begin
|
|
BufPtr[0] := #$0D;
|
|
BufPtr[1] := #$0A;
|
|
Inc(BufPtr, 2);
|
|
K := 0;
|
|
end;
|
|
end;
|
|
anOutputStream.Write(Outbuf, BufPtr - PChar(@OutBuf));
|
|
until BytesRead = 0;
|
|
end;
|
|
|
|
procedure DecodeStream(anInputStream, anOutputStream: TStream);
|
|
var
|
|
InBuf: array[0..75] of Char;
|
|
OutBuf: array[0..49] of Byte;
|
|
InBufPtr, OutBufPtr: PChar;
|
|
I, J, K, BytesRead: Integer;
|
|
Packet: TPacket;
|
|
|
|
procedure SkipWhite;
|
|
var
|
|
C: Char;
|
|
NumRead: Integer;
|
|
begin
|
|
while True do
|
|
begin
|
|
NumRead := anInputStream.Read(C, 1);
|
|
if NumRead = 1 then
|
|
begin
|
|
if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] then
|
|
begin
|
|
anInputStream.Position := anInputStream.Position - 1;
|
|
Break;
|
|
end;
|
|
end else Break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
repeat
|
|
SkipWhite;
|
|
BytesRead := anInputStream.Read(InBuf, SizeOf(InBuf));
|
|
InBufPtr := InBuf;
|
|
OutBufPtr := @OutBuf;
|
|
I := 0;
|
|
while I < BytesRead do
|
|
begin
|
|
Packet := DecodePacket(InBufPtr, J);
|
|
K := 0;
|
|
while J > 0 do
|
|
begin
|
|
OutBufPtr^ := Char(Packet.a[K]);
|
|
Inc(OutBufPtr);
|
|
Dec(J);
|
|
Inc(K);
|
|
end;
|
|
Inc(InBufPtr, 4);
|
|
Inc(I, 4);
|
|
end;
|
|
anOutputStream.Write(OutBuf, OutBufPtr - PChar(@OutBuf));
|
|
until BytesRead = 0;
|
|
end;
|
|
|
|
function CompressStr(const aString : String) : String;
|
|
{$IFDEF LINUX}
|
|
var
|
|
Buffer : Pointer;
|
|
Size : Integer;
|
|
begin
|
|
try
|
|
try
|
|
CompressBuf(PChar(aString), Length(aString), Buffer, Size);
|
|
SetLength(Result, Size);
|
|
Move(Buffer^, Result[1], Size);
|
|
except
|
|
Buffer := nil;
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
begin
|
|
Result := aString;
|
|
ZFastCompressString(Result, clMax);
|
|
end;
|
|
{$ENDIF LINUX}
|
|
|
|
function DecompressStr(const aString : String) : String;
|
|
{$IFDEF LINUX}
|
|
var
|
|
Buffer : Pointer;
|
|
Size : Integer;
|
|
begin
|
|
try
|
|
try
|
|
DecompressBuf(PChar(aString), Length(aString), 0, Buffer, Size);
|
|
SetLength(Result, Size);
|
|
Move(Buffer^, Result[1], Size);
|
|
except
|
|
Buffer := nil;
|
|
end;
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
begin
|
|
Result := aString;
|
|
ZFastDecompressString(Result);
|
|
end;
|
|
{$ENDIF LINUX}
|
|
|
|
{$IFDEF LINUX}
|
|
procedure ZCompressStream(anInputStream, aCompressedStream : TStream);
|
|
var
|
|
zstream : TCompressionStream;
|
|
begin
|
|
try
|
|
zstream := TCompressionStream.Create(clMax, aCompressedStream);
|
|
zstream.CopyFrom(anInputStream, 0);
|
|
finally
|
|
FreeAndNIL(zstream);
|
|
end;
|
|
end;
|
|
|
|
procedure ZDecompressStream(aCompressedStream, anOutputStream : TStream);
|
|
var
|
|
zstream : TDecompressionStream;
|
|
buffer : array of byte;
|
|
bufflen : integer;
|
|
lBufferSize: integer;
|
|
begin
|
|
lBufferSize := 10*1024;
|
|
|
|
SetLength(buffer,lBufferSize);
|
|
zstream := TDecompressionStream.Create(aCompressedStream);
|
|
try
|
|
|
|
bufflen := zstream.Read(buffer[0], lBufferSize);
|
|
while (bufflen>0) do begin
|
|
anOutputStream.Write(buffer[0], bufflen);
|
|
bufflen := zstream.Read(buffer[0], lBufferSize);
|
|
end;
|
|
|
|
finally
|
|
FreeAndNIL(zstream);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function CompressAndEncode(const aString: string): string;
|
|
var
|
|
fCompressedStream: TMemoryStream;
|
|
fStreamCompressor: TCompressionStream;
|
|
fStringStream: TStringStream;
|
|
begin
|
|
fCompressedStream := TMemoryStream.Create;
|
|
try
|
|
fStreamCompressor := TCompressionStream.Create(clMax, (fCompressedStream));
|
|
try
|
|
fStreamCompressor.Write(aString[1], length(aString));
|
|
finally
|
|
FreeAndNil(fStreamCompressor);
|
|
end;
|
|
fStringStream := TStringStream.create('');
|
|
try
|
|
fCompressedStream.Position := 0;
|
|
EncodeStream(fCompressedStream, fStringStream);
|
|
Result := fStringStream.datastring;
|
|
finally
|
|
FreeAndNil(fStringStream);
|
|
end;
|
|
finally
|
|
FreeAndNil(fCompressedStream);
|
|
end;
|
|
end;
|
|
|
|
function DecodeAndUnCompress(const aString: string): string;
|
|
var
|
|
fWorkStream: TMemoryStream;
|
|
fEncodedStream: TMemoryStream;
|
|
fStreamDeCompressor: TDecompressionStream;
|
|
fBufLen: integer;
|
|
fBuffer: array[0..16383] of byte;
|
|
begin
|
|
fWorkStream := TMemoryStream.create;
|
|
try
|
|
fWorkStream.size := length(aString);
|
|
move(aString[1], fWorkStream.memory^, fWorkStream.size);
|
|
fWorkStream.position := 0;
|
|
fEncodedStream := TMemoryStream.create;
|
|
try
|
|
DecodeStream(fWorkStream, fEncodedStream);
|
|
fWorkStream.size := 0;
|
|
fEncodedStream.position := 0;
|
|
fStreamDeCompressor := TDecompressionStream.Create(fEncodedStream);
|
|
try
|
|
fBufLen := fStreamDeCompressor.Read(fBuffer, SizeOf(fBuffer));
|
|
while fBufLen > 0 do
|
|
begin
|
|
fWorkStream.Write(fBuffer, fBufLen);
|
|
fBufLen := fStreamDeCompressor.Read(fBuffer, SizeOf(fBuffer));
|
|
end;
|
|
finally
|
|
FreeAndNil(fStreamDeCompressor);
|
|
end;
|
|
finally
|
|
FreeAndnil(fEncodedStream);
|
|
end;
|
|
fWorkStream.position := 0;
|
|
SetLength(Result, fWorkStream.size);
|
|
move(fWorkStream.memory^, Result[1], fWorkStream.size);
|
|
finally
|
|
FreeAndNil(fWorkStream);
|
|
end;
|
|
end;
|
|
|
|
end.
|