home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
LANGUAGS
/
PASCAL
/
USQ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
2000-06-30
|
9KB
|
281 lines
{$C-}
program Unsqueeze; { unsqueeze file from in_file to out_file }
{ This program unsqueezes a file which has been squeezed or compressed
to reduce the space required to store it on disk. The program was
converted from the original version written for CP/M in the C
language. This program can be used to unsqueeze files which have
been downloaded from RCP/M systems where almost all files are saved
in this squeezed format.
The technique used is the Huffman encoding technique which converts
the most common characters in the input file to a compressed bit
stream of data. This program unsqueezes such a Huffman encoded
file.
PUBLIC DOMAIN - Feel free to distribute this program. Do not
distribute it by commercial means or make any charge for this pgm.
Version 1.0 - 09/05/82 Scott Loftesness
Version 1.1 - 01/06/83 Added capability to strip off parity bit if
output file is text. Ernie LeMay 71435,730
Version 1.2 - 07/20/84 converted to Turbo Pascal. Steve Freeman
Version 1.3 - 12/30/84 changed file I/O to run on CP/M as well as
MS-DOS. Changed filetypes to 'file' and
used blockread/write for file I/O.
Jeff Duncan
}
const
recognize = $FF76;
numvals = 257; { max tree size + 1 }
speof = 256; { special end of file marker }
dle: char = #$90;
buffersize = 128; (* 128 byte buffer *)
type
tree = array [0..255,0..1] of integer;
hexstr = string[4];
var
debug : boolean;
in_file, out_file: file;
in_FN: string[30];
dnode: tree;
inchar, curin, filecksum, bpos, i, repct, numnodes: integer;
c, lastchar: char;
origfile: string[14];
docfile, eofin, abort: boolean;
abortM: string[50];
infilebuffer : array[1..2048] of byte; (* allow for a 2k input buffer *)
infilepointer : integer; (* pointer into buffer *)
infilesize : integer; (* input filesize for buffer loading *)
inbuffersize : integer; (* maximum count for buffer pointer *)
outfilebuffer : array[1..128] of byte; (* output buffer will be minimum *)
outfilepointer : integer; (* pointer into output buffer *)
outbuffer_num : integer; (* how many buffer-fulls used *)
{ iftext -- find out if output file is text and return true if so. EL }
function iftext : boolean;
var answer: char;
begin
repeat
write('Is the output file a text file? ');
read(kbd,answer);
answer := upcase(answer);
until (answer in ['Y','N']);
writeln(answer);
if answer='Y'
then iftext:=true
else iftext:=false;
end;
function hex(num: integer): hexstr;
var i, j: integer;
h: string[16];
str: hexstr;
begin
str := '0000'; h := '0123456789ABCDEF'; j := num;
for i:=4 downto 1
do begin
str[i] := h[(j and 15)+1];
j := j shr 4;
end;
hex := str;
end;
function getc: integer;
begin
if (infilepointer > inbuffersize) and (not eof(in_file)) then
begin (* is input buffer empty and more data to follow *)
if infilesize < 16 then (* less than 2048 bytes left? *)
begin
blockread(in_file, infilebuffer, infilesize); (* no get rest *)
infilepointer := 1;
inbuffersize := infilesize * 128;
end
else
begin (* full 2048 left so get maximum *)
blockread(in_file, infilebuffer, 16);
inbuffersize := 2048;
infilepointer := 1;
infilesize := infilesize - 16;
end;
end;
if not ((infilepointer > inbuffersize) and eof(in_file)) then
begin (* another character to read available *)
getc := infilebuffer[infilepointer];
infilepointer := infilepointer + 1;
end;
end;
{ getw - get a word value from the input file }
function getw: integer;
var in1,in2: byte;
begin
in1 := getc; (* use getc for these to simplify buffer manipulation *)
in2 := getc;
getw := ord(in1) + ord(in2) shl 8;
end;
procedure initialize;
var str: string[14];
begin
abort := false; { no error conditions presently exist }
repct:=0;
bpos:=99;
origfile:='';
eofin:=false;
clrscr; gotoxy(1,5); write('Enter the file to unsqueeze:');
readln(in_FN);
assign(in_file,in_FN);
{$I-}
reset(in_file);
{$I+}
if (IOresult = 0) then (* file is found *)
begin
inbuffersize := 0; (* dummy for first pass *)
infilesize := filesize(in_file); (* filesize at initiate *)
writeln('Input file ', in_fn,' is ',infilesize * 128,' bytes.');
infilepointer := 1; (* point beyond buffer, so we get data on entry *)
i := getw;
end
else
i := 0;
if (recognize <> i)
then begin
abort := true;
abortM := 'File is not a squeezed file'; (* could be not found also *)
numnodes := -1;
end
else begin
filecksum := getw; { get checksum from chars 2 - 3 of file }
repeat { build original file name }
inchar:=getc;
if inchar <> 0
then origfile := origfile + chr(inchar);
until inchar = 0;
writeln('Original file name is ',origfile);
write('Output to (return to default) ? ');
readln(str);
if length(str)=0 then
str:=origfile;
assign(out_file,str);
rewrite(out_file);
outfilepointer := 1; (* good idea to start at beginning of buffer *)
outbuffer_num := 0; (* not neccessary *)
numnodes:=ord(getw); { get the number of nodes in this files tree }
if (numnodes<0) or (numnodes>=numvals)
then begin
abort := true;
abortM := 'File has invalid decode tree size';
end;
end;
if not(abort)
then begin
dnode[0,0]:= -(speof+1);
dnode[0,1]:= -(speof+1);
numnodes:=numnodes-1;
for i:=0 to numnodes
do begin
dnode[i,0]:=getw;
dnode[i,1]:=getw;
end;
{ following is for test }
{for i:=0 to numnodes
do writeln(lst,'#',i:3,' ',hex(dnode[i,0]),' ',hex(dnode[i,1]));}
end;
end;
procedure dochar(c: char; text: boolean);
begin
if text then
c:=chr(ord(c) and $7F); {strip off parity bit}
outfilebuffer[outfilepointer] := ord(c); (* save data in output buffer *)
outfilepointer := outfilepointer + 1; (* increment the pointer *)
if outfilepointer > buffersize then
begin (* we have a full buffer, lets write it out *)
blockwrite(out_file,outfilebuffer,1);
outfilepointer := 1; (* reset pinter *)
outbuffer_num := outbuffer_num + 1;
end;
end;
function getuhuff: char;
var i: integer;
begin
i:=0;
repeat
bpos:=bpos+1;
if bpos>7 then begin
curin := getc;
bpos:=0;
end
else curin := curin shr 1;
i := ord(dnode[i,ord(curin and $0001)]);
until (i<0);
i := -(i+1);
if i=speof
then begin
eofin:=true;
getuhuff:=chr(26)
end
else getuhuff:=chr(i);
end;
function getcr: char;
var c: char;
begin
if (repct>0)
then begin
repct:=repct-1;
getcr:=lastchar;
end
else begin
c:=getuhuff;
if c<>dle
then begin
getcr:=c;
lastchar:=c;
end
else begin
repct:=ord(getuhuff);
if repct=0 then getcr:=dle
else begin
repct:=repct-2;
getcr:=lastchar;
end;
end;
end;
end; {getcr}
begin { main }
debug := true;
initialize;
if not(abort)
then begin
docfile := iftext;
writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
while not(eof(in_file)) or not(eofin)
do begin
c:=getcr;
dochar(c,docfile);
end;
if docfile then (* to close the file we have to write the last
buffer. If it's a text file we need to append
a ^Z to the buffer before writing.
*)
if outfilepointer <= buffersize then
outfilebuffer[outfilepointer] := ord(^Z);
blockwrite(out_file,outfilebuffer, 1);
close(out_file); (* write last buffer of data *)
end
else writeln('Error -- ',AbortM);
close(in_file);
end.
then