sp; to the end of InStr, placing the compressed output in OutStr starting at OutStr''''s current position. If you need the entirety of InStr compressed you''''ll need to set InStr.Position := 0 before calling. *) procedure LHAExpand(InStr, OutStr: TStream); (* LHAExpand starts expanding at InStr''''s current position and continues to the end of InStr, placing the expanded output in OutStr starting at OutStr''''s current position. If you need the entirety of InStr expanded you''''ll need to set InStr.Position := 0 before calling. *)
implementation
TYPE {$IFDEF WIN32} TwoByteInt = SmallInt; {$ELSE} TwoByteInt = Integer; {$ENDIF} PWord=^TWord; TWord=ARRAY[0..32759]OF TwoByteInt; PByte=^TByte; TByte=ARRAY[0..65519]OF Byte;
CONST (* NOTE : The following constants are set to the values used by LHArc. You can change three of them as follows :
DICBIT : Lempel-Ziv dictionnary size. Lowering this constant can lower the compression efficiency a lot ! But increasing it (on a 32 bit platform only, i.e. Delphi 2) will not yield noticeably better results. If you set DICBIT to 15 or more, set PBIT to 5; and if you set DICBIT to 19 or more, set NPT to NP, too.
WINBIT : Sliding window size. The compression ratio depends a lot of this value. You can increase it to 15 to get better results on large files. I recommend doing this if you have enough memory, except if you want that your compressed data remain compatible with LHArc. On a 32 bit platform, you can increase it to 16. Using a larger value will only waste time and memory.
BUFBIT : I/O Buffer size. You can lower it to save memory, or increase it to reduce disk access. *)
BITBUFSIZ=16; UCHARMAX=255;
DICBIT=13; DICSIZ=1 SHL DICBIT;
MATCHBIT=8; MAXMATCH=1 SHL MATCHBIT; THRESHOLD=3; PERCFLAG=$8000;
NC=(UCHARMAX+MAXMATCH+2-THRESHOLD); CBIT=9; CODEBIT=16;
NP=DICBIT+1; NT=CODEBIT+3; PBIT=4; {Log2(NP)} TBIT=5; {Log2(NT)} NPT=NT; {Greater from NP and NT}
NUL=0; MAXHASHVAL=(3*DICSIZ+(DICSIZ SHR 9+1)*UCHARMAX);
WINBIT=14; WINDOWSIZE=1 SHL WINBIT;
BUFBIT=13; BUFSIZE=1 SHL BUFBIT;
TYPE BufferArray = ARRAY[0..PRED(BUFSIZE)]OF Byte; LeftRightArray = ARRAY[0..2*(NC-1)]OF Word; CTableArray = ARRAY[0..4095]OF Word; CLenArray = ARRAY[0..PRED(NC)]OF Byte; HeapArray = ARRAY[0..NC]OF Word;
VAR OrigSize,CompSize:Longint; InFile,OutFile:TStream;
BitBuf:Word; n,HeapSize:TwoByteInt; SubBitBuf,BitCount:Word;
Buffer:^BufferArray; BufPtr:Word;
Left,Right:^LeftRightArray;
PtTable:ARRAY[0..255]OF Word; PtLen:ARRAY[0..PRED(NPT)]OF Byte; CTable:^CTableArray; CLen:^CLenArray;
BlockSize:Word;
{ The following variables are used by the compression engine only }
Heap:^HeapArray; LenCnt:ARRAY[0..16]OF Word;
Freq,SortPtr:PWord; Len:PByte; Depth:Word;
Buf:PByte;
CFreq:ARRAY[0..2*(NC-1)]OF Word; PFreq:ARRAY[0..2*(NP-1)]OF Word; TFreq:ARRAY[0..2*(NT-1)]OF Word;
CCode:ARRAY[0..PRED(NC)]OF Word; PtCode:ARRAY[0..PRED(NPT)]OF Word;
CPos,OutputPos,OutputMask:Word; Text,ChildCount:PByte;
Pos,MatchPos,Avail:Word; Position,Parent,Prev,Next:PWord;
Remainder,MatchLen:TwoByteInt; Level:PByte;
{********************************** File I/O **********************************}
FUNCTION GetC:Byte; BEGIN IF BufPtr=0 THEN InFile.Read(Buffer^,BUFSIZE); GetC:=Buffer^[BufPtr];BufPtr:=SUCC(BufPtr)AND PRED(BUFSIZE); END;
PROCEDURE PutC(c:Byte); BEGIN IF BufPtr=BUFSIZE THEN BEGIN OutFile.Write(Buffer^,BUFSIZE);BufPtr:=0; END; Buffer^[BufPtr]:=C;INC(BufPtr); END;
FUNCTION BRead(p:POINTER;n:TwoByteInt):TwoByteInt; BEGIN BRead := InFile.Read(p^,n); END;
PROCEDURE BWrite(p:POINTER;n:TwoByteInt); BEGIN OutFile.Write(p^,n); END;
{**************************** Bit handling routines ***************************}
PROCEDURE FillBuf(n:TwoByteInt); BEGIN BitBuf:=(BitBuf SHL n); WHILE n>BitCount DO BEGIN DEC(n,BitCount); BitBuf:=BitBuf OR (SubBitBuf SHL n); IF (CompSize<>0) THEN BEGIN DEC(CompSize);SubBitBuf:=GetC; END ELSE SubBitBuf:=0; BitCount:=8; END; DEC(BitCount,n); BitBuf:=BitBuf OR (SubBitBuf SHR BitCount); END;
FUNCTION GetBits(n:TwoByteInt):Word; BEGIN GetBits:=BitBuf SHR (BITBUFSIZ-n); FillBuf(n); END;
PROCEDURE PutBits(n:TwoByteInt;x:Word); BEGIN IF n<BitCount THEN BEGIN DEC(BitCount,n); SubBitBuf:=SubBitBuf OR (x SHL BitCount); END ELSE BEGIN DEC(n,BitCount); PutC(SubBitBuf OR (x SHR n));INC(CompSize); IF n<8 THEN BEGIN BitCount:=8-n;SubBitBuf:=x SHL BitCount; END ELSE BEGIN PutC(x SHR (n-8));INC(CompSize); BitCount:=16-n;SubBitBuf:=x SHL BitCount; END; END; END;
PROCEDURE InitGetBits; BEGIN BitBuf:=0;SubBitBuf:=0;BitCount:=0;FillBuf(BITBUFSIZ); END;
PROCEDURE InitPutBits; BEGIN BitCount:=8;SubBitBuf:=0; END;
{******************************** Decompression *******************************}
PROCEDURE MakeTable(nchar:TwoByteInt;BitLen:PByte;TableBits:TwoByteInt;Table:PWord); VAR count,weight:ARRAY[1..16]OF Word; start:ARRAY[1..17]OF Word; p:PWord; i,k,Len,ch,jutbits,Avail,nextCode,mask:TwoByteInt; BEGIN FOR i:=1 TO 16 DO count[i]:=0; FOR i:=0 TO PRED(nchar) DO INC(count[BitLen^[i]]); start[1]:=0; FOR i:=1 TO 16 DO start[SUCC(i)]:=start[i]+(count[i] SHL (16-i)); IF start[17]<>0 THEN HALT(1); jutbits:=16-TableBits; FOR i:=1 TO TableBits DO BEGIN start[i]:=start[i] SHR jutbits;weight[i]:=1 SHL (TableBits-i); END; i:=SUCC(TableBits); WHILE (i<=16) DO BEGIN weight[i]:=1 SHL (16-i);INC(i); END; i:=start[SUCC(TableBits)] SHR jutbits; IF i<>0 THEN BEGIN k:=1 SHL TableBits; WHILE i<>k DO BEGIN Table^[i]:=0;INC(i); END; END; Avail:=nchar;mask:=1 SHL (15-TableBits); FOR ch:=0 TO PRED(nchar) DO BEGIN Len:=BitLen^[ch]; IF Len=0 THEN   上一页 [1] [2] [3] [4] [5] [6] [7] 下一页 [Sql Server]Sql精妙语句--各种求值函数 [网页制作]网页表格之---多个表格纵向排列 [网页制作]JavaScript另类用法--读取和写入cookie [网页制作]号称非常安全的上网工具---360安全浏览器介绍 [办公软件]信息技术教学篇---Word工具栏的显示、隐藏及四种菜… [操作系统]开始菜单---运行命令大总结 [操作系统]网络转载---64位操作系统与32位的区别 [操作系统]ldap:///(没有响应)Windows无法访问指定设备、路径… [网络技术]安全篇---交换机设置方法介绍 [聊天工具]Real10 & Xpdf installation on Linux Box
|