|
; MakeChild(q,c,Pos);MatchLen:=1;
EXIT;
END;
MatchLen:=2;
END;
WHILE true DO BEGIN
IF r>=DICSIZ THEN
BEGIN
j:=MAXMATCH;MatchPos:=r;
END ELSE BEGIN
j:=Level^[r];MatchPos:=Position^[r] AND NOT PERCFLAG;
END;
IF MatchPos>=Pos THEN
DEC(MatchPos,DICSIZ);
t1:=addr(Text^[Pos+MatchLen]);t2:=addr(Text^[MatchPos+MatchLen]);
WHILE MatchLen<j DO BEGIN
IF t1^<>t2^ THEN
BEGIN
Split(r);
EXIT;
END;
INC(MatchLen);INC(t1);INC(t2);
END;
IF MatchLen>=MAXMATCH THEN
BREAK;
Position^[r]:=Pos;q:=r;
r:=Child(q,ORD(t1^));
IF r=NUL THEN
BEGIN
MakeChild(q,ORD(t1^),Pos);
EXIT;
END;
INC(MatchLen);
END;
t:=Prev^[r];Prev^[Pos]:=t;Next^[t]:=Pos;
t:=Next^[r];Next^[Pos]:=t;Prev^[t]:=Pos;
Parent^[Pos]:=q;Parent^[r]:=NUL;Next^[r]:=Pos;
END;
PROCEDURE DeleteNode;
VAR
r,s,t,u:TwoByteInt;
{$IFDEF PERCOLATE}
q:TwoByteInt;
{$ENDIF}
BEGIN
IF Parent^[Pos]=NUL THEN
EXIT;
r:=Prev^[Pos];s:=Next^[Pos];Next^[r]:=s;Prev^[s]:=r;
r:=Parent^[Pos];Parent^[Pos]:=NUL;DEC(ChildCount^[r]);
IF (r>=DICSIZ)OR(ChildCount^[r]>1) THEN
EXIT;
{$IFDEF PERCOLATE}
t:=Position^[r] AND NOT PERCFLAG;
{$ELSE}
t:=Position^[r];
{$ENDIF}
IF t>=Pos THEN
DEC(t,DICSIZ);
{$IFDEF PERCOLATE}
s:=t;q:=Parent^[r];u:=Position^[q];
WHILE (u AND PERCFLAG)<>0 DO BEGIN
u:=u AND NOT PERCFLAG;
IF u>=Pos THEN
DEC(u,DICSIZ);
IF u>s THEN
s:=u;
Position^[q]:=s OR DICSIZ;q:=Parent^[q];u:=Position^[q];
END;
IF q<DICSIZ THEN
BEGIN
IF u>=Pos THEN
DEC(u,DICSIZ);
IF u>s THEN
s:=u;
Position^[q]:=s OR DICSIZ OR PERCFLAG;
END;
{$ENDIF}
s:=Child(r,Text^[t+Level^[r]]);
t:=Prev^[s];u:=Next^[s];Next^[t]:=u;Prev^[u]:=t;
t:=Prev^[r];Next^[t]:=s;Prev^[s]:=t;
t:=Next^[r];Prev^[t]:=s;Next^[s]:=t;
Parent^[s]:=Parent^[r];Parent^[r]:=NUL;
Next^[r]:=Avail;Avail:=r;
END;
PROCEDURE GetNextMatch;
VAR
n:TwoByteInt;
BEGIN
DEC(Remainder);INC(Pos);
IF Pos=2*DICSIZ THEN
BEGIN
move(Text^[DICSIZ],Text^[0],DICSIZ+MAXMATCH);
n:=InFile.Read(Text^[DICSIZ+MAXMATCH],DICSIZ);
INC(Remainder,n);Pos:=DICSIZ;
END;
DeleteNode;InsertNode;
END;
PROCEDURE Encode;
VAR
LastMatchLen,LastMatchPos:TwoByteInt;
BEGIN
{ initialize encoder variables }
GetMem(Text,2*DICSIZ+MAXMATCH);
GetMem(Level,DICSIZ+UCHARMAX+1);
GetMem(ChildCount,DICSIZ+UCHARMAX+1);
{$IFDEF PERCOLATE}
GetMem(Position,(DICSIZ+UCHARMAX+1)*SizeOf(Word));
{$ELSE}
GetMem(Position,(DICSIZ)*SizeOf(Word));
{$ENDIF}
GetMem(Parent,(DICSIZ*2)*SizeOf(Word));
GetMem(Prev,(DICSIZ*2)*SizeOf(Word));
GetMem(Next,(MAXHASHVAL+1)*SizeOf(Word));
Depth:=0;
InitSlide;
GetMem(Buf,WINDOWSIZE);
Buf^[0]:=0;
FillChar(CFreq,sizeof(CFreq),0);
FillChar(PFreq,sizeof(PFreq),0);
OutputPos:=0;OutputMask:=0;InitPutBits;
Remainder:=InFile.Read(Text^[DICSIZ],DICSIZ+MAXMATCH);
MatchLen:=0;Pos:=DICSIZ;InsertNode;
IF MatchLen>Remainder THEN
MatchLen:=Remainder;
WHILE Remainder>0 DO BEGIN
LastMatchLen:=MatchLen;LastMatchPos:=MatchPos;GetNextMatch;
IF MatchLen>Remainder THEN
MatchLen:=Remainder;
IF (MatchLen>LastMatchLen)OR(LastMatchLen<THRESHOLD) THEN
Output(Text^[PRED(Pos)],0)
ELSE
BEGIN
Output(LastMatchLen+(UCHARMAX+1-THRESHOLD),(Pos-LastMatchPos-2)AND PRED(DICSIZ));
DEC(LastMatchLen);
WHILE LastMatchLen>0 DO BEGIN
GetNextMatch;DEC(LastMatchLen);
END;
IF MatchLen>Remainder THEN
MatchLen:=Remainder;
END;
END;
{flush buffers}
SendBlock;PutBits(7,0);
IF BufPtr<>0 THEN
OutFile.Write(Buffer^,BufPtr);
FreeMem(Buf,WINDOWSIZE);
FreeMem(Next,(MAXHASHVAL+1)*SizeOf(Word));
FreeMem(Prev,(DICSIZ*2)*SizeOf(Word));
FreeMem(Parent,(DICSIZ*2)*SizeOf(Word));
{$IFDEF PERCOLATE}
FreeMem(Position,(DICSIZ+UCHARMAX+1)*SizeOf(Word));
{$ELSE}
FreeMem(Position,(DICSIZ)*SizeOf(Word));
{$ENDIF}
FreeMem(ChildCount,DICSIZ+UCHARMAX+1);
FreeMem(Level,DICSIZ+UCHARMAX+1);
FreeMem(Text,2*DICSIZ+MAXMATCH);
END;
{****************************** LH5 as Unit Procedures ************************}
procedure FreeMemory;
begin
if CLen <> nil then Dispose(CLen); CLen := nil;
if CTable <> nil then Dispose(CTable); CTable := nil;
if Right <> nil then Dispose(Right); Right := nil;
if Left <> nil then Dispose(Left); Left := nil;
if Buffer <> nil then Dispose(Buffer); Buffer := nil;
if Heap <> nil then Dispose(Heap); Heap := nil;
end;
procedure InitMemory;
begin
{In should be harmless to call FreeMemory here, since it won''''t free
unallocated memory (i.e., nil pointers).
So let''''s call it in case an exception was thrown at some point and
memory wasn''''t entirely freed.}
FreeMemory;
New(Buffer);
New(Left);
New(Right);
New(CTable);
New(CLen);
FillChar(Buffer^,SizeOf(Buffer^),0);
FillChar(Left^,SizeOf(Left^),0);
FillChar(Right^,SizeOf(Right^),0);
FillChar(CTable^,SizeOf(CTable^),0);
FillChar(CLen^,SizeOf(CLen^),0);
decode_i := 0;
BitBuf := 0;
n := 0;
HeapSize := 0;
SubBitBuf := 0;
BitCount := 0;
BufPtr := 0;
FillChar(PtTable, SizeOf(PtTable),0);
FillChar(PtLen, SizeOf(PtLen),0);
BlockSize := 0;
{ The following variables are used by the compression engine only }
New(Heap);
FillChar(Heap^, SizeOf(Heap^),0);
FillChar(LenCnt, SizeOf(LenCnt),0);
Depth := 0;
FillChar(CFreq, SizeOf(CFreq),0);
FillChar(PFreq, SizeOf(PFreq),0);
FillChar(TFreq, SizeOf(TFreq),0);
FillChar(CCode, SizeOf(CCode),0);
FillChar(PtCode, SizeOf(PtCode),0);
CPos := 0;
OutputPos := 0;
OutputMask := 0;
Pos := 0;
MatchPos := 0;
Avail := 0;
Remainder := 0;
MatchLen := 0;
end;
{******************************** Interface Procedures ************************}
procedure LHACompress(InStr, OutStr: TStream);
begin
InitMemory;
try
InFile := InStr;
OutFile := OutStr;
OrigSize := InFile.Size - InFile.Position;
CompSize := 0;
OutFile.Write(OrigSize,4);
Encode;
finally
FreeMemory;
end;
end;
procedure LHAExpand(InStr, OutStr: TStream); //解码
begin
try
InitMemory;
&nb 上一页 [1] [2] [3] [4] [5] [6] [7] 下一页
[Sql Server]Sql精妙语句--各种求值函数 [网页制作]网页表格之---多个表格纵向排列
[网页制作]JavaScript另类用法--读取和写入cookie [网页制作]号称非常安全的上网工具---360安全浏览器介绍
[办公软件]信息技术教学篇---Word工具栏的显示、隐藏及四种菜… [操作系统]开始菜单---运行命令大总结
[操作系统]网络转载---64位操作系统与32位的区别 [操作系统]ldap:///(没有响应)Windows无法访问指定设备、路径…
[网络技术]安全篇---交换机设置方法介绍 [聊天工具]Real10 & Xpdf installation on Linux Box
|
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
