Pascal lzh

Pascal lzh

Pascal lzh : Multi-millones de consejos para hacer su vida mas facil.

muy rapido LZH compresor

Colaborador: KURT HAENEN

{$I-} { SIN comprobacion de rango !! }

{
& & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & -
Esta publicacion incluye las fuentes para el Turbo Pascal
version del LZRW1/KH compresion algoritm.
& & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & -
Archivo #1 : El LZRW1KH unidad
& & & & & & & & & & & & &
}
{ ################################################################### }
{ ## ## }
{ ## ## ##### ##### ## ## ## ## ## ## ## ## ## }
{ ## ## ### ## ## ## # ## ### ## ## ## ## ## ## }
{ ## ## ### ##### ####### ## ## #### ###### ## }
{ ## ## ### ## ## ### ### ## ## ## ## ## ## ## }
{ ## ##### ##### ## ## ## ## #### ## ## ## ## ## ## }
{ ## ## }
{ ## EXTREMADAMENTE RAPIDO Y FACIL DE ENTENDER COMPRESION ALGORITM ## }
{ ## ## }
{ ################################################################### }
{ ## ## }
{ ## Esta unidad se implementa la actualizacion de la LZRW1/KH algoritm que ## }
{ ## tambien se pone en practica algunas de codificacion RLE que es util cuando ## }
{ ## comprimir los archivos que contiene una gran cantidad de bytes consecutivos ## }
{ ## tener el mismo valor. El algoritm no es tan buena como la de ## }
{ ## LZH, pero puede competir con Lempel-Ziff. & #39 s ayunas ## }
{ ## uno I & #39 cinco encontrado hasta ahora. ## }
{ ## ## }
{ ## ## }
{ ## ## }
{ ## Kurt HAENEN ## }
{ ## ## }
{ ################################################################### }

la UNIDAD de LZRW1KH

INTERFAZ

utiliza SysUtils

{$IFDEF WIN32}
tipo de Int16 = SmallInt
{$ELSE}
tipo de Int16 = Integer
{$ENDIF}

CONST
BufferMaxSize = 32768
BufferMax = BufferMaxSize-1
FLAG_Copied = $80
FLAG_Compress = $40

TIPO
BufferIndex = 0..BufferMax 15
BufferSize = 0..BufferMaxSize
{ bytes adicionales necesarios aqui si la compresion de falla *dh *}
BufferArray = ARRAY [BufferIndex] DE BYTES
BufferPtr = ^BufferArray

ELzrw1KHCompressor = Clase(Excepcion)

la FUNCION de Compresion ( Origen,Destino : BufferPtr
SourceSize : BufferSize ) : BufferSize

la FUNCION de Descompresion ( Origen,Destino : BufferPtr
SourceSize : BufferSize ) : BufferSize

APLICACION

tipo
tabla de Hash = ARRAY [0..4095] DE Int16
HashTabPtr = ^Hashtable

VAR
Hash : HashTabPtr

{ comprobar si esta cadena ya ha sido visto }
{ en la corriente de 4 KB ventana }
FUNCION GetMatch ( Fuente : BufferPtr
X : BufferIndex
SourceSize : BufferSize
Hash : HashTabPtr
VAR Tamaño : WORD
VAR Pos : BufferIndex ) : BOOLEAN
VAR
HashValue : WORD
TmpHash : Int16
BEGIN
HashValue := (40543*(((( Fuente^[X] SHL 4) XOR Fuente^[X 1]) SHL 4) XOR
Fuente^[X 2]) SHR 4) Y $0FFF
Resultado := FALSE
TmpHash := Hash^[HashValue]
SI (TmpHash <> -1) y (X - TmpHash < 4096), a CONTINUACION, EMPEZAR
Pos := TmpHash
Tamaño := 0
MIENTRAS ((< 18) Y (Fuente^[X Size] = Fuente^[Pos Tamaño])
Y (X Tamaño < SourceSize)) DO begin
INC(Tamaño)
fin
Resultado := (Tamaño >= 3)
FIN
Hash^[HashValue] := X
FIN
{ comprimir un bufer de max. 32 KB }
la FUNCION de Compresion(Origen, Destino : BufferPtr
SourceSize : BufferSize) :BufferSize
VAR
Bit,Comando,Tamaño : WORD
Clave : Palabra
X,Y,Z,Pos : BufferIndex
BEGIN
FillChar(Hash^,SizeOf(Hashtable), $FF)
Dest^[0] := FLAG_Compress
X := 0
Y := 3
Z := 1
Bit := 0
Comando := 0
WHILE (X < SourceSize) y (Y <= SourceSize) DO BEGIN
SI (Bit > 15), a CONTINUACION, EMPEZAR
Dest^[Z] := HI(Comando)
Dest^[Z 1] := LO(Comando)
Z := Y
Bit := 0
INC(Y,2)
FIN
Tamaño := 1
MIENTRAS ((Fuente^[X] = Fuente^[X Tamaño]) Y (Tamaño < $FFF)
Y (X Tamaño < SourceSize)) DO begin
INC(Tamaño)
fin
SI (Tamaño >= 16), a CONTINUACION, EMPEZAR
Dest^[Y] := 0
Dest^[S 1] := HI(Tamaño 16)
Dest^[Y 2] := LO(Tamaño-16)
Dest^[3] := Fuente^[X]
INC(Y,4)
INC(X,Tamaño)
Comando := (Comando SHL 1) 1
FIN
ELSE begin { no tamaño >= 16 }
SI (GetMatch(Fuente,X,SourceSize,Hash,Tamaño,Pos)), a CONTINUACION, EMPEZAR
Clave := ((X-Pos) SHL 4) (Tamaño-3)
Dest^[Y] := HI(Clave)
Dest^[S 1] := LO(Llave)
INC(Y,2)
INC(X,Tamaño)
Comando := (Comando SHL 1) 1
FIN
ELSE BEGIN
Dest^[Y] := Fuente^[X]
INC(Y)
INC(X)
Comando := Comando SHL 1
FIN
end { size <= 16 }
INC(Bits)
END { while x < sourcesize ... }
Comando := Comando SHL (16 Bits)
Dest^[Z] := HI(Comando)
Dest^[Z 1] := LO(Comando)
IF (Y > SourceSize) A CONTINUACION, EMPEZAR
MOVER(Fuente^[0],Dest^[1],SourceSize)
Dest^[0] := FLAG_Copied
Y := SUCC(SourceSize)
FIN
Resultado := Y
FIN

{ descomprimir un bufer de maximo 32 KB }
la FUNCION de Descompresion(Origen,Destino : BufferPtr
SourceSize : BufferSize) : BufferSize
VAR
X,Y,Pos : BufferIndex
Comando,Tamaño,K : WORD
Bit : BYTE
SaveY : BufferIndex { * dh * inseguras para la variable de bucle Y }

BEGIN
SI (Fuente^[0] = FLAG_Copied), a CONTINUACION, empezar
Y := 1 A PRED(SourceSize) Empiezan
Dest^[PRED(Y)] := Fuente^[Y]
SaveY := Y
fin
Y := SaveY
fin
ELSE BEGIN
Y := 0
X := 3
Comando := (Fuente^[1] SHL 8) Fuente^[2]
Bit := 16
WHILE (X < SourceSize) DO BEGIN
SI (Bit = 0) THEN BEGIN
Comando := (Fuente^[X] SHL 8) Fuente^[X 1]
Bit := 16
INC(X,2)
FIN
SI ((Comando Y $8000) = 0), a CONTINUACION, EMPEZAR
Dest^[Y] := Fuente^[X]
INC(X)
INC(Y)
FIN
ELSE BEGIN { comando y $8000 }
Pos := ((Fuente^[X] SHL 4)
(Fuente^[X 1] SHR 4))
IF (Pos = 0) THEN BEGIN
Tamaño := (Fuente^[X 1] SHL 8) Fuente^[X 2] 15
PARA K := 0 A Tamaño empiezan
Dest^[S K] := Fuente^[X 3]
fin
INC(X,4)
INC(Y,de Tamaño 1)
FIN
ELSE BEGIN { pos = 0 }
Tamaño := (Fuente^[X 1] Y $0F) 2
PARA K := 0 A Tamaño
Dest^[S K] := Dest^[Y-Pos K]
INC(X,2)
INC(Y,de Tamaño 1)
END { pos = 0 }
END { comando y $8000 }
Comando := Comando SHL 1
DEC(Bits)
END { while x < sourcesize }
FIN
Resultado := Y
END { descompresion }

{
Unidad de 'Finalizacion' de Delphi 2.0 tendria
}

var
ExitSave : Puntero

Procedimiento de Limpieza de lejos
begin
ExitProc := ExitSave
si (Hash <> Nil) then
Freemem(Hash, Sizeof(HashTable))
fin

Inicializacion

Hash := Nil
prueba
Getmem(Hash,Sizeof(Hashtable))
excepto
Aumentar ELzrw1KHCompressor.Crear( & #39 LZRW1KH : no hay memoria para la tabla HASH & #39 )
fin
ExitSave := ExitProc
ExitProc := @de Limpieza
FINAL.