Pascal lzh

Pascal lzh

Pascal lzh : Plusieurs milliers de conseils pour vous faciliter la vie.

Une extremement rapide LZH compresseur

l'auteur: KURT HAENEN

{$R-} { PAS de verification de plage !! }

{
& & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & -
Cet affichage comprend les sources pour le Turbo Pascal
version de la LZRW1/KH algorithme de compression.
& & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & -
le Fichier #1 : La LZRW1KH unite
& & & & & & & & & & & & &
}
{ ################################################################### }
{ ## ## }
{ ## ## ##### ##### ## ## ## ## ## ## ## ## ## }
{ ## ## ### ## ## ## # ## ### ## ## ## ## ## ## }
{ ## ## ### ##### ####### ## ## #### ###### ## }
{ ## ## ### ## ## ### ### ## ## ## ## ## ## ## }
{ ## ##### ##### ## ## ## ## #### ## ## ## ## ## ## }
{ ## ## }
{ ## EXTREMEMENT RAPIDE ET FACILE A COMPRENDRE COMPRESSION ALGORITHME ## }
{ ## ## }
{ ################################################################### }
{ ## ## }
{ ## Cette unite met en œuvre la mise a jour LZRW1/KH algorithme qui ## }
{ ## met egalement en œuvre certaines RLE codage, ce qui est utile lorsque l' ## }
{ ## compresser des fichiers contenant beaucoup d'octets consecutifs ## }
{ ## ayant la meme valeur. L'algorithme n'est pas aussi bon que ## }
{ ## LZH, mais ne peut rivaliser avec Lempel-Ziff. Il & #39 s le jeun ## }
{ #I & #39 ve rencontre jusqu'a maintenant. ## }
{ ## ## }
{ ## ## }
{ ## ## }
{ ## Kurt HAENEN ## }
{ ## ## }
{ ################################################################### }

UNITE LZRW1KH

INTERFACE

utilise SysUtils

{$IFDEF WIN32}
type Int16 = SmallInt
{$ELSE}
type Int16 = Integer
{$ENDIF}

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

TYPE
BufferIndex = 0..BufferMax 15
BufferSize = 0..BufferMaxSize
{ octets supplementaires necessaires ici si la compression ne parvient pas *dh *}
BufferArray = ARRAY [BufferIndex] DE BYTE
BufferPtr = ^BufferArray

ELzrw1KHCompressor = Classe(Exception)

la FONCTION de Compression ( Source,Dest : BufferPtr
SourceSize : BufferSize ) : BufferSize

la FONCTION de Decompression ( Source,Dest : BufferPtr
SourceSize : BufferSize ) : BufferSize

la mise en ŒUVRE

type
table de hachage = ARRAY [0..4095] DE Int16
HashTabPtr = ^Hashtable

VAR
Hash : HashTabPtr

{ verifier si cette chaîne a deja ete vu }
{ dans le courant de 4 KO fenetre }
FONCTION de GetMatch ( Source : BufferPtr
X : BufferIndex
SourceSize : BufferSize
Hash : HashTabPtr
VAR Taille : MOT
VAR Pos : BufferIndex ) : BOOLEAN
VAR
HashValue : MOT
TmpHash : Int16
BEGIN
HashValue := (40543*(((( Source^[X] SHL 4) XOR Source^[X 1]) SHL 4) XOR
Source^[X 2]) SHR 4) ET $0FFF
Result := FALSE
TmpHash := Hash^[HashValue]
IF (TmpHash <> -1) et (X - TmpHash < 4096), PUIS COMMENCER
Pos := TmpHash
Taille := 0
WHILE ((Taille < 18) ET (Source^[X Size] Source = ^[Pos Taille])
ET (X Taille < SourceSize)) DO begin
INC(Taille)
fin
Result := (Taille >= 3)
FIN
Hash^[HashValue] := X
FIN
{ compresser un tampon de max. 32 KO }
FONCTION de Compression(Source, Dest : BufferPtr
SourceSize : BufferSize) :BufferSize
VAR
Bit,Commande,Taille : MOT
Cle : Mot
X,Y,Z,Pos : BufferIndex
BEGIN
FillChar(Hash^,SizeOf(table de hachage), $FF)
Dest^[0] := FLAG_Compress
X := 0
Y := 3
Z := 1
Bit := 0
Commande := 0
WHILE (X < SourceSize) ET (Y <= SourceSize) DO BEGIN
SI (Peu > 15), PUIS COMMENCER
Dest^[Z] := HI(Commande)
Dest^[Z 1] := LO(Commande)
Z := Y
Bit := 0
INC(O,2)
FIN
Taille := 1
WHILE ((Source^[X] = Source^[X Taille]) ET (Taille < $FFF)
ET (X Taille < SourceSize)) DO begin
INC(Taille)
fin
IF (Taille >= 16), PUIS COMMENCER
Dest^[Y] := 0
Dest^[Y 1] := HI(Taille 16)
Dest^[Y 2] := LO(Taille 16)
Dest^[O 3] : Source = ^[X]
INC(Y,4)
INC(X,Taille)
Commande := (Commande SHL 1) 1
FIN
ELSE begin { pas de taille >= 16 }
IF (GetMatch(Source,X,SourceSize,Hachage,de la Taille,Pos)), PUIS COMMENCER
- Cles := ((X-Pos) SHL 4) (Taille 3)
Dest^[Y] := HI(Cle)
Dest^[Y 1] := LO(Cle)
INC(O,2)
INC(X,Taille)
Commande := (Commande SHL 1) 1
FIN
ELSE BEGIN
Dest^[Y] := Source^[X]
INC(Y)
INC(X)
Commande := Commande SHL 1
FIN
end { taille <= 16 }
INC(Bits)
END { while x < sourcesize ... }
Commande := Commande de SHL (16 Bits)
Dest^[Z] := HI(Commande)
Dest^[Z 1] := LO(Commande)
IF (Y > SourceSize) ENSUITE, COMMENCEZ
MOVE(Source^[0],Dest^[1],SourceSize)
Dest^[0] := FLAG_Copied
Y := SUCC(SourceSize)
FIN
Result := Y
FIN

{ decompresser un tampon de max 32 KB }
FONCTION de Decompression(Source,Dest : BufferPtr
SourceSize : BufferSize) : BufferSize
VAR
X,Y,Pos : BufferIndex
la Commande,la Taille,K : MOT
Bit : OCTET
SaveY : BufferIndex { * dh * dangereux pour la boucle la variable Y }

BEGIN
IF (Source^[0] = FLAG_Copied), PUIS commencer
Y := 1 A PRED(SourceSize) DO begin
Dest^[PRED(Y)] : Source = ^[Y]
SaveY := Y
fin
Y := SaveY
fin
ELSE BEGIN
Y := 0
X := 3
Commande := (Source^[1] SHL 8) Source^[2]
Bit := 16
WHILE (X < SourceSize) DO BEGIN
IF (Bit = 0) then BEGIN
Commande := (Source^[X] SHL 8) Source^[X 1]
Bit := 16
INC(X,2)
FIN
IF ((ET la Commande $8000) = 0), PUIS COMMENCER
Dest^[Y] :Source = ^[X]
INC(X)
INC(Y)
FIN
ELSE BEGIN { commande et 8000$}
Pos := ((Source^[X] SHL 4)
(Source^[X 1] SHR 4))
IF (Pos = 0) then BEGIN
Taille := (Source^[X 1] SHL 8) Source^[X 2] 15
POUR K := 0 A la Taille DO begin
Dest^[Y K] := Source^[X 3]
fin
INC(X,4)
INC(Y,Taille 1)
FIN
ELSE BEGIN { pos = 0 }
Taille := (Source^[X 1] ET $0F) 2
POUR K := 0 A la Taille
Dest^[Y K] := Dest^[Y-Pos K]
INC(X,2)
INC(Y,Taille 1)
END { pos = 0 }
END { commande et 8000$}
Commande := Commande de SHL 1
DEC(Bit)
END { while x < sourcesize }
FIN
Result := Y
END { decompression }

{
Unite de 'Finalisation' comme Delphi 2.0 aurait-il
}

var
ExitSave : Pointeur

la Procedure de Nettoyage de loin
begin
ExitProc := ExitSave
if (Hachage <> Nil) then
Freemem(Hachage, Sizeof(HashTable))
fin

Initialisation

Hash := Nil

Getmem(Hachage,Sizeof(Hashtable))
sauf
Augmenter ELzrw1KHCompressor.Creer( & #39 LZRW1KH : pas de memoire pour table de HACHAGE & #39 )
fin
ExitSave := ExitProc
ExitProc := @de Nettoyage
a la FIN.