Pascal implementering tilpasset fra C kildekoden
bidragsyter. MIKE CHAPIN product: {Vel her er det som lovet. Dette er en Pascal-porten Ross datakomprimering. Denne spesielle enheten gjør ingen buffer kompresjon /dekompresjon, men du kan legge det hvis du vil. C implementeringen jeg gjorde har Buffer til fil komprimering og fil til buffer dekompresjon.
Dette er en freebie og er plasser for SWAG hvis de ønsker det.
Felles datatyper enheten jeg bruker mye. Ser ut som Delphi inkorporert lignende typer
} (* Felles datatyper og strukturer *.)
Unit Common.; Grensesnitt
Type PByte = ^ Byte; ByteArray = Array [0..65000] Of Byte; PByteArray = ^ ByteArray;
PInteger = ^ Integer; IntArray = Array [0..32000] Of Integer; PIntArray = ^ IntArray;
PWord = ^ Word; WordArray = Array [0..32000] Of Ord; PWordArray = ^ WordArray;
Implementering
END
(********************************. ******************* * RDC Unit * * * * Dette er en Pascal port av C-kode fra en artikkel * * I " The C Brukere Journal ", 1 /92 Skrevet av * * Ed Ross. * * * * Denne spesielle koden har fungert godt under, * * Real, Beskyttet og Windows. * * * * Kompresjonen er ikke fullt så bra som PKZIP * * men det dekomprimeres ca 5 ganger raskere . * ************************************************ ***) Unit RDCUnit; Interface bruker vanlige;
Prosedyre Comp_FileToFile (Var infile, outfile: File); Prosedyre Decomp_FileToFile (Var infile, outfile: File);
Implementering Const HASH_LEN = 4096; {# Hash tabellen oppføringer} HASH_SIZE = HASH_LEN * sizeof (word); BUFF_LEN = 16384; {Størrelsen på disk io buffer} plakater (* komprimere inbuff_len byte av inbuff inn outbuff hjelp hash_len oppføringer i hash_tbl
returnere lengden outbuff, eller ". 0 - inbuff_len ". Hvis inbuff ikke kunne komprimeres *) Funksjon 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 absolutt in_idx; inbuff_end: PByte; forankre: 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; Begynn 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)); product: {hoppe komprimering for en liten buffer}
Hvis inbuff_len < = 18 Da Begynn Move (outbuff, inbuff, inbuff_len); rdc_compress: = 0 - inbuff_len; Exit; Enden, product: {justere # hash oppføringer så hash-algoritmen kan bruke 'og' i stedet for 'mod'}
hashlen: = HASH_LEN - 1; product: {skanne gjennom inbuff}
Mens LongInt (in_idx) < LongInt (inbuff_end) Har Begynn {gi plass til styrebiter og se etter outbuff overløp}
Hvis ctrl_cnt = 16 Deretter Begynn ctrl_idx ^: = ctrl_bits; ctrl_cnt: = 1; ctrl_idx: = Pointer (out_idx); Inc (word (out_idx), 2); Hvis LongInt (out_idx) > LongInt (outbuff_end) Deretter Begynn Move (outbuff, inbuff, inbuff_len); rdc_compress: = inbuff_len; Exit; Ende; Slutt Else Inc (ctrl_cnt); product: {lete etter 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)) Gjør Inc ( in_idx); product: {butikken komprimering kode hvis karakter gjentas mer enn 2 ganger}
cnt: = LongInt (in_idx) - LongInt (anker); Hvis cnt > 2 Deretter begynner Hvis cnt < = 18 Da {kort rle} Begynn out_idx ^: = cnt - 3; Inc (out_idx); out_idx ^: = c; Inc (out_idx); Avslutt Else {lang rle} Begynn 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); Enden,
ctrl_bits: = (ctrl_bits Shl 1) Eller en; Fortsett; Enden, product: {lete etter mønster hvis 2 eller flere tegn forbli i bufferen}
in_idx: = anker;
Hvis (LongInt (inbuff_end) - LongInt (in_idx)) > 2 da begynne {lokalisere oppveid av mulige mønster i skyve ordboken}
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 ^ [hasj]; hash_tbl ^ [hasj]: = Word (in_idx); product: {sammenligne karakterer hvis vi er innenfor 4098 bytes}
gap: = LongInt (in_idx) - LongInt (pat_idx); If (gap < = HASH_LEN + 2), og start 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) Har Begynn Inc (in_idx); Inc (pat_idx); Enden, product: {butikken mønster hvis det er mer enn 2 tegn}
cnt: = LongInt (in_idx) - LongInt (anker); Hvis cnt > 2 Deretter Begynn DEC (gap, 3);
Hvis cnt < = 15 Deretter {kort mønster} Begynn out_idx ^: = (cnt Shl 4) + (gap Og $ 0F); Inc (out_idx); out_idx ^: = gap SHR ​​4; Inc (out_idx); Avslutt Else {lang mønster} Begynn out_idx ^: = 32 + (gap Og $ 0F); Inc (out_idx); out_idx ^: = gap SHR ​​4; Inc (out_idx); out_idx ^: = cnt - 16; Inc (out_idx); Enden,
ctrl_bits: = (ctrl_bits Shl 1) Eller en; Fortsett; Ende; Ende; End; product: {kan ikke komprimere denne karakteren så kopiere den til outbuff}
out_idx ^: = c; Inc (out_idx); Inc (anker); in_idx: = anker; ctrl_bits: = ctrl_bits Shl 1; Enden, product: {spare siste lass av kontrollbiter}
ctrl_bits: = ctrl_bits Shl (16 - ctrl_cnt); ctrl_idx ^: = ctrl_bits; product: {og returnere størrelsen på komprimerte buffer}
rdc_compress: = LongInt (out_idx) - LongInt (outbuff); Enden, plakater (* dekomprimere inbuff_len byte av inbuff inn outbuff
returnere lengden outbuff *..) Funksjon 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; Begynn ctrl_mask: = 0; inbuff_idx: = inbuff; outbuff_idx: = outbuff; inbuff_end: = Pointer (LongInt (inbuff) + inbuff_len); product: {prosessen hvert element i inbuff} Mens LongInt (inbuff_idx) < LongInt (inbuff_end) Har Begynn {få ny belastning av kontroll biter hvis nødvendig} ctrl_mask: = ctrl_mask SHR 1; Hvis ctrl_mask = 0 Then Begynn ctrl_bits: = PWord (inbuff_idx) ^; Inc (inbuff_idx, 2); ctrl_mask: = $ 8000; Enden, product: {bare kopiere denne røye dersom kontrollen bit er null} Hvis (ctrl_bits Og ctrl_mask) = 0 Then Begynn outbuff_idx ^: = inbuff_idx ^; Inc (outbuff_idx); Inc (inbuff_idx); Fortsett; Enden, product: {angre komprimering kode} cmd: = (inbuff_idx ^ SHR 4) Og $ 0F; cnt: = inbuff_idx ^ Og $ 0F; Inc (inbuff_idx);
Case-cmd fra 0: {kort rle} Begynn Inc (CNT, 3); FillChar (outbuff_idx ^, CNT, inbuff_idx ^); Inc (inbuff_idx); Inc (outbuff_idx, CNT); Enden,
1: {lang rle} Begynn 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} Begynn 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); Move (outbuff_src " javascript: if (bekrefte ('http://atlas.csd.net/~cgadd/knowbase/^, \\ n \\ nDenne filen ble ikke hentet av Teleport Pro, fordi serveren rapporterer at denne filen ikke finnes . \\ n \\ nVil du åpne 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} Begynn OFS: = cnt + 3; Inc (OFS, inbuff_idx ^ Shl 4); Inc (inbuff_idx); outbuff_src: = Pointer (LongInt (outbuff_idx) - OFS); Move (outbuff_src " javascript: if (bekrefte ('http://atlas.csd.net/~cgadd/knowbase/^, \\ n \\ nDenne filen ble ikke hentet av Teleport Pro, fordi serveren rapporterer at denne filen ikke finnes . \\ n \\ nVil du åpne 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); Ende; Ende; Enden,
{return lengde dekomprimeres buffer} RDC_Decompress: = LongInt (outbuff_idx) - LongInt (outbuff); Enden,
Prosedyre Comp_FileToFile (Var infile, outfile: File); Var kode: Integer; bytes_read: Integer; compress_len: Integer; HashPtr: PWordArray; inputbuffer, outputbuffer: PByteArray; Begynn Getmem (HashPtr, HASH_SIZE); Fillchar (hashPtr ^, HASH_SIZE, # 0); Getmem (inputbuffer, BUFF_LEN); Getmem (outputbuffer, BUFF_LEN); product: {lese infile BUFF_LEN byte om gangen}
bytes_read: = BUFF_LEN; Mens bytes_read = BUFF_LEN Har Begynn Blockread (infile, inputbuffer ^, BUFF_LEN, bytes_read); product: {komprimere denne belastningen byte} compress_len: = RDC_Compress (PByte (inputbuffer), bytes_read, PByte (outputbuffer), HashPtr);
{write lengden av komprimert buffer} Blockwrite (outfile, compress_len, 2, kode); product: {sjekke for negative lengde indikerer buffer kan ikke komprimeres} Hvis compress_len < 0 Then compress_len: = 0 - compress_len; product: {skrive buffer} Blockwrite (outfile, outputbuffer ^, compress_len, kode); {Vi er ferdig om mindre enn full buffer ble lest} End, product: {legge trailer å indikere End of File} compress_len: = 0; Blockwrite (utfil, compress_len, 2, kode); {Hvis (kode < > 2) deretter err_exit ('. Feil ved skriving trailer' + # 13 + # 10); } FreeMem (HashPtr, HASH_SIZE); FreeMem (inputbuffer, BUFF_LEN); FreeMem (outputbuffer, BUFF_LEN); Enden,
Prosedyre Decomp_FileToFile (Var infile, outfile: File); Var kode: Integer; block_len: Integer; decomp_len: Integer; HashPtr: PWordArray; inputbuffer, outputbuffer: PByteArray; Begynn Getmem (inputbuffer, BUFF_LEN); Getmem (outputbuffer, BUFF_LEN); {Les infile BUFF_LEN byte om gangen} block_len: = 1; Mens block_len < > 0 gjør Begynn Blockread (infile, block_len, 2, kode); {Hvis (kode < > 2) deretter err_exit ('.' 'T lese blokklengde' + # 13 + # 10); } {Sjekk for End-of-file flagg} Hvis block_len < > 0 Deretter begynner Hvis (block_len < 0) Da {kopiere ukomprimerte chars} Begynn decomp_len: = 0 - block_len; Blockread (infile, outputbuffer ^, decomp_len, kode); {Hvis koden < > decomp_len) så err_exit ('' 't lese ukomprimert blokk.' + # 13 + # 10); } Avslutt Else {dekomprimere denne bufferen} Begynn Blockread (infile, inputbuffer ^, block_len, kode); {Hvis (kode < > block_len) så err_exit ('.' 'T lese komprimerte blokk' + # 13 + # 10); } Decomp_len: = RDC_Decompress (PByte (inputbuffer), block_len, PByte (outputbuffer)); Ende; {Og skrive denne bufferen outfile} Blockwrite (outfile, outputbuffer ^, decomp_len, kode); {If (kode < > decomp_len) så err_exit ('. Feil ved skriving ukomprimerte data' + # 13 + # 10); } Avslutt; Enden,
FreeMem (inputbuffer, BUFF_LEN); FreeMem (outputbuffer, BUFF_LEN); Slutten;.
END
< ------------------- CUT ------------------ ------- >
Her er testen programmet jeg brukte til å teste dette. Du er nødt til å endre det å reflektere andre filnavn, men det vil gi deg en idé om hvordan du bruker enheten
. ≪ ------------------- CUT ------------------------- > Program RDCTest; Bruker RDCUnit;
Var fin, fut: File; a: Array [0..50] Of Byte;
BEGIN {Assign (fin, 'ASMINTRO.TXT'); Tilbakestill (finnen, 1);
Assign (fout, 'ASMINTRO.RDC'); Omskriving (fout, 1);
Comp_FileToFile (finnen, fut); } Assign (fin, 'ASMINTRO.RDC'); Tilbakestill (finnen, 1);
Assign (fout, 'ASMINTRO.2'); Omskriving (fout, 1);
Decomp_FileToFile (finnen, fut);
Close (fin); Close (fut); END.