Фундаментальные алгоритмы и структуры данных в Delphi

Листинг 11.26. Методы скользящего окна, используемые во время сжатия

procedure TtdLZSlidingWindow.Advance(aCount : integer);

var

ByteCount : integer;

begin

{при необходимости сместить начало скользящего окна}

if ((FCurrent - FStart) >= tdcLZSlidingWindowSize) then begin

inc(FStart, aCount);

inc(FStartOffset, aCount);

end;

{сместить текущий указатель}

inc(FCurrent, aCount);

{проверить смещение в зону переполнения}

if (FStart >= FMidPoint) then begin

{переместить текущие данные обратно в начало буфера}

ByteCount := FLookAheadEnd - FStart;

Move(FStart^, FBuffer^, ByteCount);

{сбросить различные указатели}

ByteCount := FStart - FBuffer;

FStart := FBuffer;

dec(FCurrent, ByteCount);

dec(FLookAheadEnd, ByteCount);

{выполнить считывание дополнительных данных из потока}

swReadFromStream;

end;

end;

function TtdLZSlidingWindow.Compare(aOffset : longint;

var aDistance : integer): integer;

var

MatchStr : PAnsiChar;

CurrentCh : PAnsiChar;

begin

{Примечание: когда эта подпрограмма вызывается, она предполагает, что между переданной и текущей позицией будет найдено по меньшей мере три совпадающих символа}

{вычислить позицию в скользящем окне, соответствующую переданному смещению и ее расстоянию от текущей позиции}

MatchStr := FStart + (aOffset - FStartOffset);

aDistance := FCurrent - MatchStr;

inc(MatchStr, 3);

{вычислить длину строки совпадающих символов между данной и текущей позицией. Эта длина не должна превышать максимальной длины. Для конца входного потока определен специальный случай}

Result := 3;

CurrentCh := FCurrent + 3;

if (CurrentCh <> FLookAheadEnd) then begin

while (Result < tdcLZMaxMatchLength) and (MatchStr^ = CurrentCh^ ) do

begin

inc(Result);

inc(MatchStr);

inc(CurrentCh);

if (CurrentCh = FLookAheadEnd) then

Break;

end;

end;

end;

procedure TtdLZSlidingWindow.GetNextSignature(var aMS : TtdLZSignature;

var aOffset : longint);

var

P : PAnsiChar;

i : integer;

begin

{вычислить длину совпадающей строки; обычно она равна 3, но в конце входного потока она может быть равна 2 или менее.}

if ((FLookAheadEnd - FCurrent) < 3) then

aMS.AsString[0] := AnsiChar (FLookAheadEnd - FCurrent) else

aMS.AsString[0] := #3;

P := FCurrent;

for i := 1 to length (aMS.AsString) do

begin

aMS.AsString[i] := P^;

inc(P);

end;

aOffset := FStartOffset + (FCurrent - FStart);

end;

procedure TtdLZSlidingWindow.swReadFromStream;

var

BytesRead : longint;

BytesToRead : longint;

begin

{выполнить считывание дополнительных данных в зону упреждающего просмотра}

BytesToRead := FBufferEnd - FLookAheadEnd;

BytesRead := FStream.Read(FLookAheadEnd^, BytesToRead);

inc(FLookAheadEnd, BytesRead);

end;

Теперь, когда наш арсенал пополнился этими классами, можно создать подпрограмму сжатия, показанную в листинге 11.27. Она слегка осложняется необходимостью накапливать коды сжатия по восемь. Это делается для того, чтобы можно было вычислить байт флага для всех восьми байтов, а затем записать байт флага, за которым следуют восемь кодов. Именно этой цели служит массив Encodings. Однако, поскольку мы рассмотрели достаточно много вспомогательных подпрограмм, сама эта подпрограмма не слишком сложна для понимания.

Листинг 11.27. Подпрограмма ZL77

type

PEnumExtraData = ^TEnumExtraData; {запись дополнительных данных для }

TEnumExtraData = packed record { метода FindAll хеш-таблицы}

edSW : TtdLZSlidingWindow; {..объект скользящего окна}

edMaxLen : integer;{..максимальная длина совпадающих }

{строк на данный момент}

edDistMaxMatch: integer;

end;

type

TEncoding = packed record

AsDistLen : cardinal;

AsChar : AnsiChar;

IsChar : boolean;

{ $IFNDEF Delphi1}

Filler : word;

{$ENDIF}

end;

TEncodingArray = packed record

eaData : array [0..7] of TEncoding;

eaCount: integer;

end;

procedure MatchLongest(aExtraData : pointer;

const aSignature : TtdLZSignature;

aOffset : longint);

far;

var

Len : integer;

Dist : integer;

begin

with PEnumExtraData(aExtraData)^ do

begin

Len :=edSW.Compare(aOffset, Dist);

if (Len > edMaxLen) then begin

edMaxLen := Len;

edDistMaxMatch := Distend;

end;

end;

procedure WriteEncodings(aStream : TSTream;

var aEncodings : TEncodingArray);

var

i : integer;

FlagByte : byte;

Mask : byte;

begin

{построить байт флага и записать его в поток}

FlagByte := 0;

Mask :=1;

for i := 0 to pred(aEncodings.eaCount) do

begin

if not aEncodings.eaData[i].IsChar then

FlagByte := FlagByte or Mask;

Mask := Mask shl 1;

end;

aStream.WriteBuffer(FlagByte, sizeof(FlagByte));

{записать коды}

for i := 0 to pred(aEncodings.eaCount) do

begin

if aEncodings.eaData[i].IsChar then

aStream.WriteBuffer(aEncodings.eaData[i].AsChar, 1) else

aStream.WriteBuffer(aEncodings.eaData[i].AsDistLen, 2);

end;

aEncodings.eaCount := 0;

end;

procedure AddCharToEncodings(aStream : TStream;

aCh : AnsiChar;

var aEncodings : TEncodingArray);

begin

with aEncodings do

begin

eaData[eaCount].AsChar := aCh;

eaData[eaCount].IsChar := true;

inc(eaCount);

if (eaCount = 8) then

WriteEncodings(aStream, aEncodings);

end;

end;

procedure AddCodeToEncodings(aStream : TStream;

aDistance : integer;

aLength : integer;

var aEncodings : TEncodingArray);

begin

with aEncodings do

begin

eaData[eaCount].AsDistLen :=

(pred(aDistance) shl tdcLZDistanceShift) + (aLength - 3);

eaData[eaCount].IsChar := false;

inc(eaCount);