Lzw compresor

Lzw compresor

Lzw compresor : Multi-millones de consejos para hacer su vida mas facil.

Una unidad para comprimir LZW archivos

Colaborador: IAN HUNTER

(*
De: IAN HUNTER
Subj: Compresion LZW Unidad
*)

la Unidad de IHLZW
{- Unidad para manejar la compresion de datos }
Interfaz
Const
StackOverFlow = 1
DeniedWrite = 2
Tipo
GetCharFunc = Function (Var Ch : Char) : Boolean
PutCharProc = Procedimiento (Ch : Char)
LZW = Objeto
GetChar : GetCharFunc
PutChar : PutCharProc
LastError : Word
Constructor Init
Funcion Get_Hash_Code (PrevC, FollC : Integer) : Integer
Procedimiento Make_Table_Entry (PrevC, FollC: Integer)
Procedimiento Initialize_String_Table
Procedimiento Inicializar
Funcion Lookup_String (PrevC, FollC : Integer) : Integer
Procedimiento Get_Char (Var C : Integer)
Procedimiento Put_Char (C : Integer)
Procedimiento Comprimir
Procedimiento Descomprimir
Fin

Aplicacion
Const
MaxTab = 4095
No_Prev = $7FFF
EOF_Char = -2
End_List = -1
Vacio = -3

Tipo
AnyStr = String
String_Table_Entry = Record
Utilizado : Boolean
PrevChar : Integer
FollChar : Integer
a continuacion : Integer
Fin

Var
String_Table : Array [0..MaxTab] De String_Table_Entry
Table_Used : Integer
Output_Code : Integer
Input_Code : Integer
If_Compressing : Boolean

Constructor LZW.Init
Begin
LastError := 0
Fin

la Funcion de compresion LZW.Get_Hash_Code (PrevC, FollC : Integer) : Integer
Var
Index : Integer
Index2 : Integer
Begin
Index := ((PrevC SHL 5) XOR FollC) Y MaxTab
Si (No String_Table [Indice].Se utiliza)

Get_Hash_Code := Indice
Else
Begin
Mientras (String_Table[Indice].Siguiente <> End_List)
Index := String_Table[Indice].Siguiente
Index2 := (Indice 101) Y MaxTab
Mientras (String_Table[Index2].Se utiliza)
Index2 := Succ (Index2) Y MaxTab
String_Table[Indice].Siguiente := Index2
Get_Hash_Code := Index2
Fin
Fin

el Procedimiento de compresion LZW.Make_Table_Entry (PrevC, FollC: Integer)
Begin
Si (Table_Used <= MaxTab )

Begin
Con String_Table [Get_Hash_Code (PrevC , FollC)]
Begin
Utilizado := True
a continuacion := End_List
PrevChar := PrevC
FollChar := FollC
Fin
Inc (Table_Used)
(*
SI ( Table_Used > ( MaxTab 1 ) ) ENTONCES
BEGIN
WRITELN( & #39 tabla Hash completo. & #39 )
FIN
*)
Fin
Fin

el Procedimiento de compresion LZW.Initialize_String_Table
Var
I : Integer
Begin
Table_Used := 0
For I := 0 a MaxTab Hacer
Con String_Table[I] ¿
Begin
PrevChar := No_Prev
FollChar := No_Prev
a continuacion := -1
Utilizado := False
Fin
For I := 0 a 255
Make_Table_Entry (No_Prev, I)
Fin

el Procedimiento de compresion LZW.Inicializar
Begin
Output_Code := Vacio
Input_Code := Vacio
Initialize_String_Table
Fin

la Funcion de compresion LZW.Lookup_String (PrevC, FollC: Integer) : Integer
Var
Index : Integer
Index2 : Integer
Encontrado : Boolean
Begin
Index := ((PrevC Shl 5) Xor FollC) Y MaxTab
Lookup_String := End_List
Repetir
Encontrado := (String_Table[Indice].PrevChar = PrevC) Y
(String_Table[Indice].FollChar = FollC)
Si (No se Encuentra)

Index := String_Table [Indice].Siguiente
Hasta que se Encontro O (Indice = End_List)
Si se Encuentra

Lookup_String := Indice
Fin

el Procedimiento de compresion LZW.Get_Char (Var C : Integer)
Var
Ch : Char
Begin
Si No GetChar (Ch)

C := EOF_Char
Else
C := Ord (Ch)
Fin

el Procedimiento de compresion LZW.Put_Char (C : Integer)
Var
Ch : Char
Begin
Ch := Chr (C)
PutChar (Ch)
Fin

el Procedimiento de compresion LZW.Comprimir
Procedimiento Put_Code (Hash_Code : Integer)
Begin
Si (Output_Code = Vacio)

Begin
Put_Char ((Hash_Code Shr 4) Y $FF)
Output_Code := Hash_Code Y $0F
Fin
Else
Begin
Put_Char (((Output_Code Shl 4) Y $FF0)
((Hash_Code Shr 8) Y $00F))
Put_Char (Hash_Code Y $FF)
Output_Code := Vacio
Fin
Fin

Procedimiento Do_Compression
Var
C : Integer
WC : Integer
W : Integer
Begin
Get_Char (C)
W := Lookup_String (No_Prev, C)
Get_Char (C)
Mientras (C <> EOF_Char)
Begin
WC := Lookup_String (W, C)
Si (WC = End_List)

Begin
Make_Table_Entry (W, C )
Put_Code (W)
W := Lookup_String (No_Prev, C)
Fin
Else
W := WC
Get_Char( C )
Fin
Put_Code (W)
Fin

Begin
If_Compressing := True
Inicializar
Do_Compression
Fin

el Procedimiento de compresion LZW.Descomprimir
Const
MaxStack = 4096
Var
Pila : Array [1..MaxStack] Of Integer
Stack_Pointer : Integer

el Procedimiento de Empuje (C : Integer)
Begin
Inc (Stack_Pointer)
Pila [Stack_Pointer] := C
Si (Stack_Pointer >= MaxStack)

Begin
LastError := 1
Salir
Fin
Fin

Procedimiento Pop (Var C : Integer)
Begin
Si (Stack_Pointer > 0)

Begin
C := Pila [Stack_Pointer]
Dec (Stack_Pointer)
Fin
Else
C := Vacio
Fin

Procedimiento Get_Code (Var Hash_Code : Integer)
Var
Local_Buf : Integer
Begin
Si (Input_Code = Vacio)

Begin
Get_Char (Local_Buf)
Si (Local_Buf = EOF_Char)

Begin
Hash_Code := EOF_Char
Salir
Fin
Get_Char (Input_Code)
Si (Input_Code = EOF_Char)

Begin
Hash_Code := EOF_Char
Salir
Fin
Hash_Code := ((Local_Buf Shl 4) Y $FF0)
((Input_Code Shr 4) Y $00F)
Input_Code := Input_Code Y $0F
Fin
Else
Begin
Get_Char (Local_Buf)
Si (Local_Buf = EOF_Char)

Begin
Hash_Code := EOF_Char
Salir
Fin
Hash_Code := Local_Buf ((Input_Code Shl 8) Y $F00)
Input_Code := Vacio
Fin
Fin

Procedimiento Do_Decompression
Var
C : Integer
Codigo : Integer
Old_Code : Integer
Fin_Char : Integer
In_Code : Integer
Last_Char : Integer
Desconocido : Boolean
Temp_C : Integer
Begin
Stack_Pointer := 0
Desconocido := False
Get_Code (Old_Code)
Codigo := Old_Code
C := String_Table[Codigo].FollChar
Put_Char (C)
Fin_Char := C
Get_Code (In_Code)
Mientras (In_Code <> EOF_Char)
Begin
Codigo := In_Code
Si (No String_Table [Codigo].Se utiliza)

Begin
Last_Char := Fin_Char
Codigo := Old_Code
Desconocido := TRUE
Fin
Mientras (String_Table [Codigo].PrevChar <> No_Prev)
Con String_Table[Code]
Begin
Push (FollChar)
Si (LastError <> 0)

Salir
Codigo := PrevChar
Fin
Fin_Char := String_Table [Codigo].FollChar
Put_Char (Fin_Char)
Pop (Temp_C)
Mientras (Temp_C <> Vacio)
Begin
Put_Char (Temp_C)
Pop (Temp_C)
Fin
Si no

Begin
Fin_Char := Last_Char
Put_Char (Fin_Char)
Desconocido := FALSE
Fin
Make_Table_Entry (Old_Code, Fin_Char)
Old_Code := In_Code
Get_Code( In_Code )
Fin
Fin

Begin
If_Compressing := False
Inicializar
Do_Decompression
Fin

.

(* ***************************** PROGRAMA de PRUEBA ****************** *)

el Programa de LZWTest
{ programa de demostracion/prueba de la compresion LZW objeto }
Usos
IHLZW { Solo necesita este }
Var
C : LZW { La Estrella del Show de la Compresion Objeto }

{$F } Function GetTheChar (Var Ch : Char) : Boolean {$F-}
{ Hacer su GetChar rutina & #39 s declaracion se ven exactamente como esta }

Begin
Si No Eof (Entrada) { Final de la Entrada? }

Begin
Leer (Entrada, Ch) { Luego de leer un caracter en Ch ... }
GetTheChar := True { ... Return True }
Fin
Else
GetTheChar := False { en caso Contrario, devuelve False }
Fin

{$F } Procedimiento PutTheChar (Ch : Char) {$F-}
{ Hacer su PutChar rutina & #39 s declaracion se ven exactamente como esta }

Begin
Escribir de Salida (Ch) { Escribir Ch a un archivo de Salida }
Fin

Begin
{ Abrir archivos de datos }
Asignar (de Entrada, & #39 & #39 ) { Entrada Estandar requiere una reorientacion de ser utiles }
Asignar (de Salida, & #39 & #39 ) { Salida Estandar requiere una reorientacion de ser utiles }
Reset (Entrada)
Reescribir (Salida)
{& #39 t fallar sin embargo-tal vez un descendiente podria, aunque... }
Si no C. Init

Halt
{ Asignar rutinas de e/S }
C. GetChar := GetTheChar { Set LZW & #39 s GetChar a la rutina de GetTheChar }
C. PutChar := PutTheChar { Set LZW & #39 s PutChar a la rutina de PutTheChar }
{ estamos de comprimir o descomprimir? }
Si (ParamCount = 0)

C. Comprimir { comprimir }
Else
C. Descomprimir { descomprimir }
{ Hace Todo! }
Final.