Lzw compresseur

Lzw compresseur

Lzw compresseur : Plusieurs milliers de conseils pour vous faciliter la vie.

Une unite de compresser LZW fichiers

l'auteur: IAN HUNTER

(*
De: IAN HUNTER
Objet: Compression LZW Unite
*)

Unite IHLZW
{Unite pour gerer la compression de donnees }
Interface
Const
StackOverFlow = 1
DeniedWrite = 2
Type
GetCharFunc = Function (Var Ch : Char) : Boolean
PutCharProc = Procedure (Ch : Char)
LZW = Objet
GetChar : GetCharFunc
PutChar : PutCharProc
LastError Mot
Constructeur Init
Fonction de Get_Hash_Code (PrevC, FollC : Integer) : Integer
Procedure Make_Table_Entry (PrevC, FollC: Entier)
Procedure Initialize_String_Table
Procedure Initialiser
Fonction de Lookup_String (PrevC, FollC : Integer) : Integer
Procedure Get_Char (Var C : Entier)
Procedure Put_Char (C : Entier)
Procedure de Compresser
Procedure de Decompresser
Fin

Application
Const
MaxTab = 4095
No_Prev = $7FFF
EOF_Char = -2
End_List = -1
Vide = -3

Type
AnyStr = Chaîne de caracteres
String_Table_Entry = Enregistrement
Utilise : Boolean
PrevChar : Integer
FollChar : Integer
Suivant : Integer
Fin

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

Constructeur LZW.Init
Begin
LastError= 0
Fin

la Fonction LZW.Get_Hash_Code (PrevC, FollC : Integer) : Integer
Var
Index : Integer
Index2 : Integer
Begin
Indice := ((PrevC SHL 5) XOR FollC) ET MaxTab
Si (Pas String_Table [Index].Utilise)

Get_Hash_Code := Index
Else
Begin
While (String_Table[Index].<> End_List) Ne
Indice := String_Table[Index].Suivant
Index2 : = Index (101) Et MaxTab
While (String_Table[Index2].Utilises) Ne
Index2 := Succ (Index2) ET MaxTab
String_Table[Index].Prochaine := Index2
Get_Hash_Code := Index2
Fin
Fin

Procedure LZW.Make_Table_Entry (PrevC, FollC: Entier)
Begin
If (Table_Used <= MaxTab )

Begin
Avec String_Table [Get_Hash_Code (PrevC , FollC)]
Begin
Utilise := True
Suivant := End_List
PrevChar := PrevC
FollChar := FollC
Fin
Inc (Table_Used)
(*
IF ( Table_Used > ( MaxTab 1 ) ) THEN
BEGIN
WRITELN( & #39 table de Hachage complet. & #39 )
FIN
*)
Fin
Fin

Procedure LZW.Initialize_String_Table
Var
I : Integer
Begin
Table_Used := 0
For I := 0 to MaxTab Ne
Avec String_Table[I]
Begin
PrevChar := No_Prev
FollChar := No_Prev
Suivant := -1
Utilise := False
Fin
For I := 0 a 255 Ne
Make_Table_Entry (No_Prev, I)
Fin

Procedure LZW.Initialiser
Begin
Output_Code := Vide
Input_Code := Vide
Initialize_String_Table
Fin

la Fonction LZW.Lookup_String (PrevC, FollC: Integer) : Integer
Var
Index : Integer
Index2 : Integer
Trouve : Booleen
Begin
Indice := ((PrevC Shl 5) Xor FollC) Et MaxTab
Lookup_String := End_List
Repeat
Trouve := (String_Table[Index].PrevChar = PrevC) Et
(String_Table[Index].FollChar = FollC)
Si (Pas Trouve)

Indice := String_Table [Index].Suivant
Jusqu'a Trouve Ou (Index = End_List)
Si

Lookup_String := Index
Fin

Procedure LZW.Get_Char (Var C : Entier)
Var
Ch : Char
Begin
Si Non GetChar (Ch)

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

Procedure LZW.Put_Char (C : Entier)
Var
Ch : Char
Begin
Ch := Chr (C)
PutChar (Ch)
Fin

Procedure LZW.Compresser
Procedure Put_Code (Hash_Code : Entier)
Begin
If (Output_Code = Vide)

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

Procedure Do_Compression
Var
C : Integer
WC : Integer
W : Integer
Begin
Get_Char (C)
W := Lookup_String (No_Prev, C)
Get_Char (C)
While (C <> EOF_Char) Ne
Begin
WC := Lookup_String (W, C)
If (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
Initialiser
Do_Compression
Fin

Procedure LZW.Decompresser
Const
MaxStack = 4096
Var
Pile : Tableau [1..MaxStack] Of Integer
Stack_Pointer : Integer

Procedure Push (C : Entier)
Begin
Inc (Stack_Pointer)
Pile [Stack_Pointer] := C
If (Stack_Pointer >= MaxStack)

Begin
LastError= 1
Sortie
Fin
Fin

Procedure Pop (Var C : Entier)
Begin
If (Stack_Pointer > 0)

Begin
C := Pile [Stack_Pointer]
Dec (Stack_Pointer)
Fin
Else
C := Vide
Fin

Procedure Get_Code (Var Hash_Code : Entier)
Var
Local_Buf : Integer
Begin
If (Input_Code = Vide)

Begin
Get_Char (Local_Buf)
If (Local_Buf = EOF_Char)

Begin
Hash_Code := EOF_Char
Sortie
Fin
Get_Char (Input_Code)
If (Input_Code = EOF_Char)

Begin
Hash_Code := EOF_Char
Sortie
Fin
Hash_Code := ((Local_Buf Shl 4) Et $FF0)
((Input_Code Shr 4) Et $00F)
Input_Code := Input_Code Et $0F
Fin
Else
Begin
Get_Char (Local_Buf)
If (Local_Buf = EOF_Char)

Begin
Hash_Code := EOF_Char
Sortie
Fin
Hash_Code := Local_Buf ((Input_Code Shl 8) Et $F00)
Input_Code := Vide
Fin
Fin

Procedure Do_Decompression
Var
C : Integer
Code : Integer
Old_Code : Integer
Fin_Char : Integer
In_Code : Integer
Last_Char : Integer
Inconnu : Boolean
Temp_C : Entier
Begin
Stack_Pointer := 0
Inconnu := False
Get_Code (Old_Code)
Code := Old_Code
C := String_Table[Code].FollChar
Put_Char (C)
Fin_Char := C
Get_Code (In_Code)
While (In_Code <> EOF_Char) Ne
Begin
Code := In_Code
Si (Pas String_Table [Code].Utilise)

Begin
Last_Char := Fin_Char
Code := Old_Code
Inconnu := TRUE
Fin
While (String_Table [Code].PrevChar <> No_Prev) Ne
Avec String_Table[Code]
Begin
Push (FollChar)
If (LastError <> 0)

Sortie
Code := PrevChar
Fin
Fin_Char := String_Table [Code].FollChar
Put_Char (Fin_Char)
Pop (Temp_C)
While (Temp_C <> Vide) Ne
Begin
Put_Char (Temp_C)
Pop (Temp_C)
Fin
Si Inconnu

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

Begin
If_Compressing := False
Initialiser
Do_Decompression
Fin

a la Fin.

(* ***************************** PROGRAMME de TEST ****************** *)

le Programme de LZWTest
{ programme de demo/test de l'algorithme LZW objet }

IHLZW { Uniquement besoin de cette }
Var
C : LZW { La Star du Spectacle la Compression de l'Objet }

{$F } Function GetTheChar (Var Ch : Char) : Boolean {$F-}
{ Faire de votre GetChar routine & #39 s declaration ressembler exactement ce }

Begin
Si Non Eof (Input) { Fin de l'Entree? }

Begin
Read (Entree, Ch) { Puis lire un caractere dans Ch ... }
GetTheChar := True { ... Return True }
Fin
Else
GetTheChar := False { Sinon retourne False }
Fin

{$F } Procedure PutTheChar (Ch : Char) {$F-}
{ Faire de votre PutChar routine & #39 s declaration ressembler exactement ce }

Begin
Write (Sortie, Ch) { Ecrire Ch dans un fichier de Sortie }
Fin

Begin
{ Ouvrir les fichiers de donnees }
Assign (Entree, & #39 & #39 ) { Entree Standard necessite de redirection pour etre utile }
Assign (Sortie, & #39 & #39 ) { Sortie Standard necessite de redirection pour etre utile }
Reset (Entree)
Reecriture (Sortie)
{ Peut & #39 t fail encore, peut-etre un descendant pu, et bien... }
Si non C. Init

Halte
{ Affecter I/O routines }
C. GetChar := GetTheChar { Set LZW & #39 s GetChar a la routine GetTheChar }
C. PutChar := PutTheChar { Set LZW & #39 s PutChar a la routine PutTheChar }
{ nous sommes la compression ou la decompression? }
If (ParamCount = 0)

C. Compresser { compresser }
Else
C. Decompresser { decompresser }
{ Tout Fait! }
a la Fin.