Ross datakomprimering

Pascal implementering tilpasset fra C kildekode.

Anden bidragyder: MIKE CHAPIN

{
Nå her er det som lovet. Dette er en Pascal havn i Ross
Datakompression. Denne særlige enhed gør ingen buffer
kompression / dekompression, men du kan tilføje det, hvis du ønsker.
C Gennemførelsen jeg gjorde har Buffer til fil kompression
og fil til buffer dekompression.

Dette er en freebie og er availble for SWAG, hvis de
ønsker det.

Fælles datatyper enhed jeg bruger en masse. Ligner Delphi
indarbejdet lignende typer.

}
(*
Fælles datatyper og strukturer.
*)

Enhed Almindelig;
Grænseflade

Type
PByte = ^ Byte;
ByteArray = Array [0..65000] Af Byte;
PByteArray = ^ ByteArray;

PInteger = ^ Integer;
IntArray = Array [0..32000] Of Integer;
PIntArray = ^ IntArray;

PWord = ^ Ord;
WordArray = Array [0..32000] Of Word;
PWordArray = ^ WordArray;

Implementering

END.

(************************************************* **
* RDC Unit *
* *
* Dette er en Pascal havn C-koden fra en artikel *
* I "The C brugere Journal", 1/92 Skrevet af *
* Ed Ross. *
* *
* Denne særlige kode har fungeret godt under, *
* Real, Beskyttet og Windows. *
* *
* Kompressionen er ikke helt så god som PKZIP *
* Men det dekomprimerer omkring 5 gange hurtigere. *
************************************************** *)
Enhed RDCUnit;
Grænseflade
Anvendelser
Almindelig;

Procedure Comp_FileToFile (Var infile, outfile: File);
Procedure Decomp_FileToFile (Var infile, outfile: File);

Implementering
Const
HASH_LEN = 4096; {# hashtabel poster}
HASH_SIZE = HASH_LEN * sizeof (word)
BUFF_LEN = 16384; {Størrelse disk io buffer}

(*
komprimere inbuff_len bytes inbuff i outbuff
hjælp hash_len poster i hash_tbl.

returnere længde outbuff, eller "0 - inbuff_len"
hvis inbuff ikke kunne komprimeres.
*)
Funktion rdc_compress (ibuff: Pointer;
inbuff_len: Word;
obuff: Pointer;
htable: Pointer): Integer;
Var
inbuff: PByte Absolute ibuff;
outbuff: PByte Absolute obuff;
hash_tbl: PWordArray Absolute htable;
in_idx: PByte;
in_idxa: PByteArray absolut in_idx;
inbuff_end: PByte;
anker: PByte;
pat_idx: PByte;
CNT: Word;
gap: Word;
c: Word;
hash: Word;
hashlen: Word;
ctrl_idx: PWord;
ctrl_bits: Word;
ctrl_cnt: Word;
out_idx: PByte;
outbuff_end: PByte;
Begynd
in_idx: = inbuff;
inbuff_end: = Pointer (LongInt (inbuff) + inbuff_len);
ctrl_idx: = Pointer (outbuff);
ctrl_cnt: = 0;

out_idx: = Pointer (longint (outbuff) + sizeof (Word));
outbuff_end: = Pointer (LongInt (outbuff) + (inbuff_len - 48));

{Springe komprimering for en lille buffer}

Hvis inbuff_len <= 18 Derefter
Begynd
Flyt (outbuff, inbuff, inbuff_len);
rdc_compress: = 0 - inbuff_len;
Afslut;
End;

{Justere # hash poster så hash algoritme kan
bruge 'og' i stedet for 'mod'}

hashlen: = HASH_LEN - 1;

{Scan thru inbuff}

Mens LongInt (in_idx) <LongInt (inbuff_end) Gør
Begynd
{Give plads til de styrebits
og kontrollere, om outbuff overløb}

Hvis ctrl_cnt = 16 Derefter
Begynd
ctrl_idx ^: = ctrl_bits;
ctrl_cnt: = 1;
ctrl_idx: = Pointer (out_idx);
Inc (word (out_idx), 2);
Hvis LongInt (out_idx)> LongInt (outbuff_end) Derefter
Begynd
Flyt (outbuff, inbuff, inbuff_len);
rdc_compress: = inbuff_len;
Afslut;
End;
End
Andet
Inc (ctrl_cnt);

{Se efter RLE}

anker: = in_idx;
c: = in_idx ^;
Inc (in_idx);

Mens (LongInt (in_idx) <longint (inbuff_end))
Og (in_idx ^ = c)
Og (LongInt (in_idx) - LongInt (anker) <(HASH_LEN + 18)) Gør
Inc (in_idx);

{Butik kompression kode, hvis karakter er
gentages mere end 2 gange}

CNT: = LongInt (in_idx) - LongInt (anker);
Hvis CNT> 2 Så
Begynd
Hvis CNT <= 18 Derefter {kort RLE}
Begynd
out_idx ^: = CNT - 3;
Inc (out_idx);
out_idx ^: = C;
Inc (out_idx);
End
Else {lang RLE}
Begynd
Dec (CNT, 19);
out_idx ^: = 16 + (CNT og $ 0F);
Inc (out_idx);
out_idx ^: = CNT Shr 4;
Inc (out_idx);
out_idx ^: = C;
Inc (out_idx);
End;

ctrl_bits: = (ctrl_bits Shl 1) eller 1;
Fortsæt;
End;

{Se efter mønster, hvis 2 eller flere bogstaver
forbliver i input buffer}

in_idx: = anker;

Hvis (LongInt (inbuff_end) - LongInt (in_idx))> 2 Så
Begynd
{Lokalisere opvejet af eventuel mønster
i glidende ordbog}

hash: = ((((in_idxa ^ [0] og 15) Shl 8) eller in_idxa ^ [1]) Xor
((In_idxa ^ [0] Shr 4) eller (in_idxa ^ [2] Shl 4)))
Og hashlen;

pat_idx: = in_idx;
Word (pat_idx): = hash_tbl ^ [hash];
hash_tbl ^ [hash]: = Word (in_idx);

{Sammenligne karakterer, hvis vi er inden 4098 bytes}

gap: = LongInt (in_idx) - LongInt (pat_idx);
Hvis (gap <= HASH_LEN + 2) Derefter
Begynd
Mens (LongInt (in_idx) <LongInt (inbuff_end))
Og (LongInt (pat_idx) <LongInt (anker))
Og (pat_idx ^ = in_idx ^)
Og (LongInt (in_idx) - LongInt (anker) <271) Gør
Begynd
Inc (in_idx);
Inc (pat_idx);
End;

{Butik mønster, hvis det er mere end 2 tegn}

CNT: = LongInt (in_idx) - LongInt (anker);
Hvis CNT> 2 Så
Begynd
December (hul, 3);

Hvis CNT <= 15 Derefter {kort mønster}
Begynd
out_idx ^: = (CNT Shl 4) + (mellemrum og $ 0F);
Inc (out_idx);
out_idx ^: = hul Shr 4;
Inc (out_idx);
End
Else {lang mønster}
Begynd
out_idx ^: = 32 + (hul og $ 0F);
Inc (out_idx);
out_idx ^: = hul Shr 4;
Inc (out_idx);
out_idx ^: = CNT - 16;
Inc (out_idx);
End;

ctrl_bits: = (ctrl_bits Shl 1) eller 1;
Fortsæt;
End;
End;
End;

{Kan ikke komprimere denne karakter
så kopiere den til outbuff}

out_idx ^: = C;
Inc (out_idx);
Inc (anker);

in_idx: = anker;
ctrl_bits: = ctrl_bits Shl 1;
End;

{Spare sidste belastning af styrebits}

ctrl_bits: = ctrl_bits Shl (16 - ctrl_cnt);
ctrl_idx ^: = ctrl_bits;

{Og returnere størrelse af komprimeret buffer}

rdc_compress: = LongInt (out_idx) - LongInt (outbuff);
End;

(*
dekomprimere inbuff_len bytes inbuff i outbuff.

returnere længde outbuff.
*)
Funktion RDC_Decompress (inbuff: PByte;
inbuff_len: Word;
outbuff: PByte): Integer;
Var
ctrl_bits: Word;
ctrl_mask: Word;
inbuff_idx: PByte;
outbuff_idx: PByte;
inbuff_end: PByte;
cmd, CNT: Word;
OFS len,: Word;
outbuff_src: PByte;
Begynd
ctrl_mask: = 0;
inbuff_idx: = inbuff;
outbuff_idx: = outbuff;
inbuff_end: = Pointer (LongInt (inbuff) + inbuff_len);

{Behandle hvert element i inbuff}
Mens LongInt (inbuff_idx) <LongInt (inbuff_end) Gør
Begynd
{Få ny belastning af styrebits hvis nødvendigt}
ctrl_mask: = ctrl_mask Shr 1;
Hvis ctrl_mask = 0 Derefter
Begynd
ctrl_bits: = PWord (inbuff_idx) ^;
Inc (inbuff_idx, 2);
ctrl_mask: = $ 8000;
End;

{Bare kopiere denne char, hvis kontrol bit er nul}
Hvis (ctrl_bits Og ctrl_mask) = 0, så
Begynd
outbuff_idx ^: = inbuff_idx ^;
Inc (outbuff_idx);
Inc (inbuff_idx);
Fortsæt;
End;

{Fortryde kompression kode}
cmd: = (inbuff_idx ^ Shr 4) og $ 0F;
CNT: = inbuff_idx ^ og $ 0F;
Inc (inbuff_idx);

Case cmd Of
0: {kort RLE}
Begynd
Inc (CNT, 3);
FillChar (outbuff_idx ^, CNT, inbuff_idx ^);
Inc (inbuff_idx);
Inc (outbuff_idx, CNT);
End;

1: {lang RLE}
Begynd
Inc (CNT, inbuff_idx ^ Shl 4);
Inc (inbuff_idx);
Inc (CNT, 19);
FillChar (outbuff_idx ^, CNT, inbuff_idx ^);
Inc (inbuff_idx);
Inc (outbuff_idx, CNT);
End;

2: {lang mønster}
Begynd
OFS: = cnt + 3;
Inc (OFS, inbuff_idx ^ Shl 4);
Inc (inbuff_idx);
CNT: = inbuff_idx ^;
Inc (inbuff_idx);
Inc (CNT, 16);
outbuff_src: = Pointer (LongInt (outbuff_idx) - OFS);
Flyt (outbuff_src "javascript: if (bekræfte (" http://atlas.csd.net/~cgadd/knowbase/^, \ n \ nDenne fil blev ikke hentet af Teleport Pro, fordi serveren rapporterer, at denne fil ikke kan findes . \ n \ nVil du åbne den fra serveren ")) window.location = 'http:? //atlas.csd.net/~cgadd/knowbase/^," tppabs = "http: // atlas. csd.net/~cgadd/knowbase/^, "outbuff_idx ^, CNT);
Inc (outbuff_idx, CNT);
End;

Else {kort mønster}
Begynd
OFS: = cnt + 3;
Inc (OFS, inbuff_idx ^ Shl 4);
Inc (inbuff_idx);
outbuff_src: = Pointer (LongInt (outbuff_idx) - OFS);
Flyt (outbuff_src "javascript: if (bekræfte (" http://atlas.csd.net/~cgadd/knowbase/^, \ n \ nDenne fil blev ikke hentet af Teleport Pro, fordi serveren rapporterer, at denne fil ikke kan findes . \ n \ nVil du åbne den fra serveren ")) window.location = 'http:? //atlas.csd.net/~cgadd/knowbase/^," tppabs = "http: // atlas. csd.net/~cgadd/knowbase/^, "outbuff_idx ^, cmd);
Inc (outbuff_idx, cmd);
End;
End;
End;

{Return længde dekomprimeret buffer}
RDC_Decompress: = LongInt (outbuff_idx) - LongInt (outbuff);
End;

Procedure Comp_FileToFile (Var infile, outfile: File);
Var
kode: Integer;
bytes_read: Integer;
compress_len: Integer;
HashPtr: PWordArray;
inputbuffer,
outputbuffer: PByteArray;
Begynd
Getmem (HashPtr, HASH_SIZE);
Fillchar (hashPtr ^, HASH_SIZE, # 0);
Getmem (inputbuffer, BUFF_LEN);
Getmem (outputbuffer, BUFF_LEN);

{Læse infile BUFF_LEN bytes ad gangen}

bytes_read: = BUFF_LEN;
Mens bytes_read = BUFF_LEN Do
Begynd
Blockread (infile, inputbuffer ^, BUFF_LEN, bytes_read);

{Komprimere denne belastning af bytes}
compress_len: = RDC_Compress (PByte (inputbuffer), bytes_read,
PByte (outputbuffer) HashPtr);

{Write længde af komprimeret buffer}
Blockwrite (outfile, compress_len, 2, kode);

{Kontrollere for negative længde angiver bufferen ikke kunne komprimeres}
Hvis compress_len <0 Derefter
compress_len: = 0 - compress_len;

{Skrive buffer}
Blockwrite (outfile, outputbuffer ^, compress_len, kode);
{Vi er færdige, hvis mindre end fuld buffer blev læst}
End;

{Tilføje trailer for at angive slutningen af ​​filen}
compress_len: = 0;
Blockwrite (outfile, compress_len, 2, kode);
{
Hvis (kode <2>), derefter
err_exit ("Fejl ved skrivning trailer. '+ # 13 + # 10);
}
Freemem (HashPtr, HASH_SIZE);
Freemem (inputbuffer, BUFF_LEN);
Freemem (outputbuffer, BUFF_LEN);
End;

Procedure Decomp_FileToFile (Var infile, outfile: File);
Var
kode: Integer;
block_len: Integer;
decomp_len: Integer;
HashPtr: PWordArray;
inputbuffer,
outputbuffer: PByteArray;
Begynd
Getmem (inputbuffer, BUFF_LEN);
Getmem (outputbuffer, BUFF_LEN);
{Læse infile BUFF_LEN bytes ad gangen}
block_len: = 1;
Mens block_len <> 0 gør
Begynd
Blockread (infile, block_len, 2, kode);
{
Hvis (kode <2>), derefter
err_exit ('kan' 't læse bloklængde.' + # 13 + # 10);
}
{Tjek for End-of-file flag}
Hvis block_len <> 0 Derefter
Begynd
Hvis (block_len <0) Derefter {kopiere ukomprimerede chars}
Begynd
decomp_len: = 0 - block_len;
Blockread (infile, outputbuffer ^, decomp_len, kode);
{
Hvis kode <> decomp_len), så
err_exit ('kan' 't læse ukomprimeret blok.' + # 13 + # 10);
}
End
Else {dekomprimere denne buffer}
Begynd
Blockread (infile, inputbuffer ^, block_len, kode);
{
Hvis (kode <> block_len), så
err_exit ('kan' 't læse komprimeret blok.' + # 13 + # 10);
}
decomp_len: = RDC_Decompress (PByte (inputbuffer), block_len,
PByte (outputbuffer));
End;
{Og skrive denne buffer outfile}
Blockwrite (outfile, outputbuffer ^, decomp_len, kode);
{
hvis (kode <> decomp_len), så
err_exit ("Fejl ved skrivning ukomprimerede data. '+ # 13 + # 10);
}
End;
End;

Freemem (inputbuffer, BUFF_LEN);
Freemem (outputbuffer, BUFF_LEN);
End;

END.

<------------------- CUT ------------------------->

Her er testprogrammet jeg brugte til at teste dette. Du vil
nødt til at ændre det til at afspejle andre filnavne, men det
vil give dig en idé om, hvordan du bruger enheden.

<------------------- CUT ------------------------->
Program RDCTest;
Anvendelser
RDCUnit;

Var
fin, fout: Fil;
a: Array [0..50] Af Byte;

BEGIN
{
Tildel (fin, »ASMINTRO.TXT ');
Reset (fin, 1);

Tildel (fout, »ASMINTRO.RDC ');
Omskriv (fout, 1);

Comp_FileToFile (fin, fout);
}
Tildel (fin, »ASMINTRO.RDC ');
Reset (fin, 1);

Tildel (fout, »ASMINTRO.2 ');
Omskriv (fout, 1);

Decomp_FileToFile (fin, fout);

Luk (fin);
Luk (fout);
END.