unit URleAlternate;
interface
uses
Classes;
procedure RLEAlternateCompress(Source, Destination: TMemoryStream);
procedure RLEAlternateDecompress(Source, Destination: TMemoryStream);
implementation
type
T8Bit = Byte;
T16Bit = Word;
T24Bit = packed array[0..2] of Byte;
T32Bit = Longint;
const
CodeFlag: T8Bit = $FF; // binär: 1111 1111
NoCode: T8Bit = $00; // binär: 0000 0000 aus T8Bit\[1..MaxCount]
MaxCount: T8Bit = $3F; // bin: 00 111111
Type8: Byte = $00; // bin: 00 000000
Type16: Byte = $40; // bin: 01 000000
Type24: Byte = $80; // bin: 10 000000
Type32: Byte = $C0; // bin: 11 000000
TypeMask: T8Bit = $C0; // bin: 11 000000
CountMask: T8Bit = $3F; // bin: 00 111111
procedure RLEAlternateCompress(Source, Destination: TMemoryStream);
function Try8BitCompress: Boolean;
var
Counting: Boolean;
Count: T8Bit;
CodeCount: T8Bit;
Try8Bit: packed array[0..3] of T8Bit; // vier 8Bit-Zeichen
Next8Bit: T8Bit;
begin
Result := FALSE;
// Existenz von vier 8Bit-Zeichen
if (Source.Size - Source.Position < SizeOf(Try8Bit)) then Exit;
// Vergleich der vier 8Bit-Zeichen
Source.ReadBuffer(Try8Bit, SizeOf(Try8Bit));
Source.Position := Source.Position - SizeOf(Try8Bit);
if (Try8Bit[0] <> Try8Bit[1]) then Exit;
if (Try8Bit[1] <> Try8Bit[2]) then Exit;
if (Try8Bit[2] <> Try8Bit[3]) then Exit;
// Neuer Rückgabewert: Komprimierversuch gelingt!
Result := TRUE;
Source.Position := Source.Position + SizeOf(Try8Bit);
Count := High(Try8Bit) - Low(Try8Bit) + 1; // Länge der Prüfsequenz
if (Source.Size - Source.Position >= SizeOf(Next8Bit)) then
repeat
Source.ReadBuffer(Next8Bit, SizeOf(Next8Bit));
Counting := (Try8Bit[0] = Next8Bit);
if Counting then Inc(Count, 1)
else Source.Position := Source.Position - SizeOf(T8Bit);
until (not Counting) or (Count >= MaxCount) or
(Source.Size - Source.Position < SizeOf(T8Bit));
CodeCount := Type8 or Count;
Destination.WriteBuffer(CodeFlag, SizeOf(CodeFlag));
Destination.WriteBuffer(CodeCount, SizeOf(CodeCount));
Destination.WriteBuffer(Try8Bit[0], SizeOf(Try8Bit[0]));
end;
function Try16BitCompress: Boolean;
var
Counting: Boolean;
Count: T8Bit;
CodeCount: T8Bit;
Try16Bit: packed array[0..2] of T16Bit; // drei 16Bit-Zeichen
Next16Bit: T16Bit;
begin
Result := FALSE;
// Existenz von drei 16Bit-Zeichen
if (Source.Size - Source.Position < SizeOf(Try16Bit)) then Exit;
// Vergleich der drei 16Bit-Zeichen
Source.ReadBuffer(Try16Bit, SizeOf(Try16Bit));
Source.Position := Source.Position - SizeOf(Try16Bit);
if (Try16Bit[0] <> Try16Bit[1]) then Exit;
if (Try16Bit[1] <> Try16Bit[2]) then Exit;
// Neuer Rückgabewert: Komprimierversuch gelingt!
Result := TRUE;
Source.Position := Source.Position + SizeOf(Try16Bit);
Count := High(Try16Bit) - Low(Try16Bit) + 1; // Länge der Prüfsequenz
if (Source.Size - Source.Position >= SizeOf(Next16Bit)) then
repeat
Source.ReadBuffer(Next16Bit, SizeOf(Next16Bit));
Counting := (Try16Bit[0] = Next16Bit);
if Counting then Inc(Count, 1)
else Source.Position := Source.Position - SizeOf(T16Bit);
until (not Counting) or (Count >= MaxCount) or
(Source.Size - Source.Position < SizeOf(T16Bit));
CodeCount := Type16 or Count;
Destination.WriteBuffer(CodeFlag, SizeOf(CodeFlag));
Destination.WriteBuffer(CodeCount, SizeOf(CodeCount));
Destination.WriteBuffer(Try16Bit[0], SizeOf(Try16Bit[0]));
end;
function Try24BitCompress: Boolean;
var
Counting: Boolean;
Count: T8Bit;
CodeCount: T8Bit;
Try24Bit: packed array[0..1] of T24Bit; // zwei 24Bit-Zeichen
Next24Bit: T24Bit;
begin
Result := FALSE;
// Existenz von zwei 24Bit-Zeichen
if (Source.Size - Source.Position < SizeOf(Try24Bit)) then Exit;
// Vergleich der zwei 24Bit-Zeichen
Source.ReadBuffer(Try24Bit, SizeOf(Try24Bit));
Source.Position := Source.Position - SizeOf(Try24Bit);
if (Try24Bit[0][0] <> Try24Bit[1][0]) then Exit;
if (Try24Bit[0][1] <> Try24Bit[1][1]) then Exit;
if (Try24Bit[0][2] <> Try24Bit[1][2]) then Exit;
// Neuer Rückgabewert: Komprimierversuch gelingt!
Result := TRUE;
Source.Position := Source.Position + SizeOf(Try24Bit);
Count := High(Try24Bit) - Low(Try24Bit) + 1; // Länge der Prüfsequenz
if (Source.Size - Source.Position >= SizeOf(Next24Bit)) then
repeat
Source.ReadBuffer(Next24Bit, SizeOf(Next24Bit));
Counting := (Try24Bit[0][0] = Next24Bit[0]) and
(Try24Bit[0][1] = Next24Bit[1]) and
(Try24Bit[0][2] = Next24Bit[2]);
if Counting then Inc(Count, 1)
else Source.Position := Source.Position - SizeOf(T24Bit);
until (not Counting) or (Count >= MaxCount) or
(Source.Size - Source.Position < SizeOf(T24Bit));
CodeCount := Type24 or Count;
Destination.WriteBuffer(CodeFlag, SizeOf(CodeFlag));
Destination.WriteBuffer(CodeCount, SizeOf(CodeCount));
Destination.WriteBuffer(Try24Bit[0], SizeOf(Try24Bit[0]));
end;
function Try32BitCompress: Boolean;
var
Counting: Boolean;
Count: T8Bit;
CodeCount: T8Bit;
Try32Bit: packed array[0..1] of T32Bit; // zwei 32Bit-Zeichen
Next32Bit: T32Bit;
begin
Result := FALSE;
// Existenz von zwei 32Bit-Zeichen
if (Source.Size - Source.Position < SizeOf(Try32Bit)) then Exit;
// Vergleich der zwei 32Bit-Zeichen
Source.ReadBuffer(Try32Bit, SizeOf(Try32Bit));
Source.Position := Source.Position - SizeOf(Try32Bit);
if (Try32Bit[0] <> Try32Bit[1]) then Exit;
// Neuer Rückgabewert: Komprimierversuch gelingt!
Result := TRUE;
Source.Position := Source.Position + SizeOf(Try32Bit);
Count := High(Try32Bit) - Low(Try32Bit) + 1; // Länge der Prüfsequenz
if (Source.Size - Source.Position >= SizeOf(Next32Bit)) then
repeat
Source.ReadBuffer(Next32Bit, SizeOf(Next32Bit));
Counting := (Try32Bit[0] = Next32Bit);
if Counting then Inc(Count, 1)
else Source.Position := Source.Position - SizeOf(T32Bit);
until (not Counting) or (Count >= MaxCount) or
(Source.Size - Source.Position < SizeOf(T32Bit));
CodeCount := Type32 or Count;
Destination.WriteBuffer(CodeFlag, SizeOf(CodeFlag));
Destination.WriteBuffer(CodeCount, SizeOf(CodeCount));
Destination.WriteBuffer(Try32Bit[0], SizeOf(Try32Bit[0]));
end;
procedure NoCompress;
var
Next: T8Bit;
begin
if (Source.Size - Source.Position < SizeOf(T8Bit)) then Exit;
Source.ReadBuffer(Next, SizeOf(Next));
Destination.WriteBuffer(Next, SizeOf(Next));
if (Next = CodeFlag) then Destination.WriteBuffer(NoCode, SizeOf(NoCode));
end;
begin
Source.Position := 0;
Destination.Clear;
while (Source.Size - Source.Position >= SizeOf(T8Bit)) do
if not Try8BitCompress then
if not Try16BitCompress then
if not Try24BitCompress then
if not Try32BitCompress then NoCompress;
Source.Position := 0;
Destination.Position := 0;
end;
procedure RLEAlternateDecompress(Source, Destination: TMemoryStream);
var
CodeCount: T8Bit;
Next: T8Bit;
Count: T8Bit;
Bits: T8Bit;
procedure Decode8(Count: T8Bit);
var
i: T8Bit;
MultiNext: T8Bit;
begin
Source.ReadBuffer(MultiNext, SizeOf(MultiNext));
for i := Count downto 1 do
Destination.WriteBuffer(MultiNext, SizeOf(MultiNext));
end;
procedure Decode16(Count: T8Bit);
var
i: T8Bit;
MultiNext: T16Bit;
begin
Source.ReadBuffer(MultiNext, SizeOf(MultiNext));
for i := Count downto 1 do
Destination.WriteBuffer(MultiNext, SizeOf(MultiNext));
end;
procedure Decode24(Count: T8Bit);
var
i: T8Bit;
MultiNext: T24Bit;
begin
Source.ReadBuffer(MultiNext, SizeOf(MultiNext));
for i := Count downto 1 do
Destination.WriteBuffer(MultiNext, SizeOf(MultiNext));
end;
procedure Decode32(Count: T8Bit);
var
i: T8Bit;
MultiNext: T32Bit;
begin
Source.ReadBuffer(MultiNext, SizeOf(MultiNext));
for i := Count downto 1 do
Destination.WriteBuffer(MultiNext, SizeOf(MultiNext));
end;
begin
Source.Position := 0;
Destination.Clear;
while (Source.Size - Source.Position >= SizeOf(T8Bit)) do
begin
Source.ReadBuffer(Next, SizeOf(Next));
if (Next = CodeFlag) then
begin
Source.ReadBuffer(CodeCount, SizeOf(CodeCount));
Count := CodeCount and CountMask;
if (Count > 0) then
begin
Bits := CodeCount and TypeMask;
if Bits = Type8 then Decode8(Count)
else if Bits = Type16 then Decode16(Count)
else if Bits = Type24 then Decode24(Count)
else Decode32(Count);
end
else Destination.WriteBuffer(Next, SizeOf(Next));
end
else Destination.WriteBuffer(Next, SizeOf(Next));
end;
Source.Position := 0;
Destination.Position := 0;
end;
end. |
