kuo@skatter.UUCP (Dr. Peter Kuo) (07/27/87)
I just dug up my copies of the (much demanded) UUenc/decode sources
from a backup diskette. Here we go. Maybe Brandon Allbery would like
to put this with <comp.sources.misc> for his monthly distribution with
PK{X}ARC? I just thought this is a better newsgroup for this posting
(no offense Brandon; and *no* flames please). The sources are packed into
a shar file. There are both C and Turbo Pascal sources, as well as one
for VMS. Enjoy.
... Peter/
-------------------------------------------------------------------------------
Peter Kuo | Bitnet (VMS) : KUO@SASK
Accelerator Laboratory |
(a.k.a. The Beam Warehouse) | uucp (Unix) : !alberta\
Univ. of Saskatchewan | !ihnp4 -- !sask!skatter!kuo
Saskatoon, Saskatchewan | !utcsri /
CANADA S7N 0W0 |
(Earth) | Ma Bell : (306) 966-6059
Disclaimer: I don't know what I am saying, I'm only a physicist.
Don't quote me on anything! I speak only for myself.
===========
Note:
1) UUDECODE.PAS/UUENCODE.PAS are slightly different from the "standard"
Unix uude/encode. This set of routines translate the blank into a `
(and back) so that some MAILERS do not truncate the line if the last
character in the UUENCODED file is a blank. This is a known problem in
sending files from APRAnet to Bitnet, for example.
I usually use the Unix uuencode, pass the output thru a home-brew
filter which adds an extra character to the end of each line (uudecode
stops scanning at byte 63) so the lines will not get truncated.
2) VMSDECOD.PAS is for VAX/VMS.
Disclaimer: I did not write any of these programs but have used them and
they seem to work. I got most of these routines off SIMTEL20
before it got shut down from e-mail access.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# uudecode.c
# uuencode.c
# uude.pas
# uudecode.pas
# uuen.pas
# uuencode.pas
# vmsdecod.pas
# This archive created: Sun Jul 26 16:07:43 1987
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'uudecode.c'
then
echo shar: "will not over-write existing file 'uudecode.c'"
else
cat << \SHAR_EOF > 'uudecode.c'
/*
* uudecode [input]
*
* if input not specified, get input from stdin
*
* Create the specified file, decoding as you go.
* Used with uuencode.
*
* Modified for use with Microsoft C and VAX/VMS.
* Define CI86 symbol to use with CI86.
*/
#ifndef VMS
#include <stdio.h>
#ifndef MSDOS
#include <pwd.h>
#endif /* ifndef MSDOS */
#ifndef CI86
#include <sys/types.h>
#include <sys/stat.h>
#endif
#else /* ifndef VMS */
#include stdio
#include types
#include stat
#endif /* ifndef VMS */
/* single character decode */
#define DEC(c) (((c) - ' ') & 077)
main(argc, argv)
char **argv;
{
FILE *in, *out;
#ifndef CI86
struct stat sbuf;
#endif
int mode;
char dest[128];
char buf[80];
/* optional input arg */
if (argc > 1) {
if ((in = fopen(argv[1], "r")) == NULL) {
perror(argv[1]);
exit(1);
}
argv++; argc--;
} else
in = stdin;
if (argc != 1) {
fprintf(stderr, "Usage: uudecode [infile]\n");
exit(2);
}
/* search for header line */
for (;;) {
if (fgets(buf, sizeof buf, in) == NULL) {
fprintf(stderr, "No begin line\n");
exit(3);
}
if (strncmp(buf, "begin ", 6) == 0)
break;
}
sscanf(buf, "begin %o %s", &mode, dest);
/* handle ~user/file format */
#ifndef MSDOS
#ifndef VMS
if (dest[0] == '~') {
char *sl;
struct passwd *getpwnam();
char *index();
struct passwd *user;
char dnbuf[100];
sl = index(dest, '/');
if (sl == NULL) {
fprintf(stderr, "Illegal ~user\n");
exit(3);
}
*sl++ = 0;
user = getpwnam(dest+1);
if (user == NULL) {
fprintf(stderr, "No such user as %s\n", dest);
exit(4);
}
strcpy(dnbuf, user->pw_dir);
strcat(dnbuf, "/");
strcat(dnbuf, sl);
strcpy(dest, dnbuf);
}
#endif /* ifndef VMS */
#endif /* ifndef MSDOS */
/* create output file */
#ifdef MSDOS
/* binary output file */
out = fopen(dest, "wb");
#else
#ifdef VMS
out = fopen(dest, "w", "rfm=var");
#else
out = fopen(dest, "w");
#endif /* ifdef VMS */
#endif /* ifdef MSDOS */
if (out == NULL) {
perror(dest);
exit(4);
}
#ifndef CI86
chmod(dest, mode);
#endif
decode(in, out);
if (fgets(buf, sizeof buf, in) == NULL || strcmp(buf, "end\n")) {
fprintf(stderr, "No end line\n");
exit(5);
}
#ifndef VMS
exit(0);
#else
exit(1); /* VMS successful */
#endif
}
/*
* copy from in to out, decoding as you go along.
*/
decode(in, out)
FILE *in;
FILE *out;
{
char buf[80];
char *bp;
int n;
for (;;) {
/* for each input line */
if (fgets(buf, sizeof buf, in) == NULL) {
fprintf(stderr, "Short file\n");
exit(10);
}
n = DEC(buf[0]);
if (n <= 0)
break;
bp = &buf[1];
while (n > 0) {
outdec(bp, out, n);
bp += 4;
n -= 3;
}
}
}
/*
* output a group of 3 bytes (4 input characters).
* the input chars are pointed to by p, they are to
* be output to file f. n is used to tell us not to
* output all of them at the end of the file.
*/
outdec(p, f, n)
char *p;
FILE *f;
{
int c1, c2, c3;
c1 = DEC(*p) << 2 | DEC(p[1]) >> 4;
c2 = DEC(p[1]) << 4 | DEC(p[2]) >> 2;
c3 = DEC(p[2]) << 6 | DEC(p[3]);
if (n >= 1)
putc(c1, f);
if (n >= 2)
putc(c2, f);
if (n >= 3)
putc(c3, f);
}
/* fr: like read but stdio */
int
fr(fd, buf, cnt)
FILE *fd;
char *buf;
int cnt;
{
int c, i;
for (i=0; i<cnt; i++) {
c = getc(fd);
if (c == EOF)
return(i);
buf[i] = c;
}
return (cnt);
}
/*
* Return the ptr in sp at which the character c appears;
* NULL if not found
*/
#define NULL 0
char *
index(sp, c)
register char *sp, c;
{
do {
if (*sp == c)
return(sp);
} while (*sp++);
return(NULL);
}
SHAR_EOF
fi
if test -f 'uuencode.c'
then
echo shar: "will not over-write existing file 'uuencode.c'"
else
cat << \SHAR_EOF > 'uuencode.c'
/*
* uuencode [input [output] ]
*
* if output not specified, output to stdout
* if input not specified, input from stdin
*
* Encode a file so it can be mailed to a remote system.
*
* Modified for use with Microsoft C and VAX/VMS.
* Define CI86 symbol to use with CI86.
*/
#ifndef VMS
#include <stdio.h>
#ifndef CI86
#include <sys/types.h>
#include <sys/stat.h>
#endif
#else /* ifndef VMS */
#include stdio
#include types
#include stat
#endif /* ifndef VMS */
/* ENC is the basic 1 character encoding function to make a char printing */
#define ENC(c) (((c) & 077) + ' ')
main(argc, argv)
char **argv;
{
FILE *in, *out;
#ifndef CI86
struct stat sbuf;
#endif
int mode;
/* if 3 arguments, then output file specified */
if (argc > 2) {
if ((out = fopen(argv[2], "w")) == NULL) {
perror(argv[2]);
exit(3);
}
argc--;
}
else
out = stdout;
if (argc > 1) {
#ifdef MSDOS
/* Use binary mode */
if ((in = fopen(argv[1], "rb")) == NULL) {
#else
if ((in = fopen(argv[1], "r")) == NULL) {
#endif
perror(argv[1]);
exit(1);
}
argc--;
} else
in = stdin;
if (argc != 1) {
fprintf(stderr,"Usage: uuencode [infile [outfile] ]\n");
exit(2);
}
#ifndef CI86
/* figure out the input file mode */
fstat(fileno(in), &sbuf);
mode = sbuf.st_mode & 0777;
#else
mode = 0; /* default to normal mode */
#endif
fprintf(out,"begin %o %s\n", mode, argv[1]);
encode(in, out);
fprintf(out,"end\n");
#ifndef VMS
exit(0);
#else
exit(1); /* VMS successful */
#endif
}
/*
* copy from in to out, encoding as you go along.
*/
encode(in, out)
FILE *in;
FILE *out;
{
char buf[80];
int i, n;
for (;;) {
/* 1 (up to) 45 character line */
n = fr(in, buf, 45);
putc(ENC(n), out);
for (i=0; i<n; i += 3)
outdec(&buf[i], out);
putc('\n', out);
if (n <= 0)
break;
}
}
/*
* output one group of 3 bytes, pointed at by p, on file f.
*/
outdec(p, f)
char *p;
FILE *f;
{
int c1, c2, c3, c4;
c1 = *p >> 2;
c2 = (*p << 4) & 060 | (p[1] >> 4) & 017;
c3 = (p[1] << 2) & 074 | (p[2] >> 6) & 03;
c4 = p[2] & 077;
putc(ENC(c1), f);
putc(ENC(c2), f);
putc(ENC(c3), f);
putc(ENC(c4), f);
}
/* fr: like read but stdio */
int
fr(fd, buf, cnt)
FILE *fd;
char *buf;
int cnt;
{
int c, i;
for (i=0; i<cnt; i++) {
c = getc(fd);
if (c == EOF)
return(i);
buf[i] = c;
}
return (cnt);
}
SHAR_EOF
fi
if test -f 'uude.pas'
then
echo shar: "will not over-write existing file 'uude.pas'"
else
cat << \SHAR_EOF > 'uude.pas'
program uudecode;
CONST defaultSuffix = '.uue';
offset = 32;
TYPE string80 = string[80];
VAR infile: text;
outfile: file of byte;
lineNum: integer;
line: string80;
procedure Abort(message: string80);
begin {abort}
writeln;
if lineNum > 0 then write('Line ', lineNum, ': ');
writeln(message);
halt
end; {Abort}
procedure NextLine(var s: string80);
begin {NextLine}
LineNum := succ(LineNum);
gotoxy(12,12);
clreol;
if lineNum > 1 then write('LineCount: ', lineNum - 1);
readln(infile, s)
end; {NextLine}
procedure Init;
procedure GetInFile;
VAR infilename: string80;
begin {GetInFile}
if ParamCount = 0 then abort ('Usage: uudecode <filename>');
infilename := ParamStr(1);
if pos('.', infilename) = 0
then infilename := concat(infilename, defaultSuffix);
assign(infile, infilename);
{$i-}
reset(infile);
{$i+}
if IOresult > 0 then abort (concat('Can''t open ', infilename));
gotoxy(1,1);
writeln ('Decoding ', infilename)
end; {GetInFile}
procedure GetOutFile;
var header, mode, outfilename: string80;
ch: char;
procedure ParseHeader;
VAR index: integer;
Procedure NextWord(var word:string80; var index: integer);
begin {nextword}
word := '';
while header[index] = ' ' do
begin
index := succ(index);
if index > length(header) then abort ('Incomplete header')
end;
while header[index] <> ' ' do
begin
word := concat(word, header[index]);
index := succ(index)
end
end; {NextWord}
begin {ParseHeader}
header := concat(header, ' ');
index := 7;
NextWord(mode, index);
NextWord(outfilename, index)
end; {ParseHeader}
begin {GetOutFile}
if eof(infile) then abort('Nothing to decode.');
NextLine (header);
while not ((copy(header, 1, 6) = 'begin ') or eof(infile)) do
NextLine(header);
writeln;
if eof(infile) then abort('Nothing to decode.');
ParseHeader;
assign(outfile, outfilename);
gotoxy(1,2);
writeln ('Destination is ', outfilename);
{$i-}
reset(outfile);
{$i+}
if IOresult = 0 then
begin
gotoxy(1,3);
write ('Overwrite current ', outfilename, '? [Y/N] ');
repeat
read (kbd, ch);
ch := UpCase(ch)
until ch in ['Y', 'N'];
writeln(ch);
if ch = 'N' then abort ('Overwrite cancelled.')
end;
rewrite (outfile);
end; {GetOutFile}
begin {init}
lineNum := 0;
clrscr;
writeln;
writeln;
GetInFile;
GetOutFile;
end; { init}
Function CheckLine: boolean;
begin {CheckLine}
if line = '' then abort ('Blank line in file');
CheckLine := not (line[1] in [' ', '`'])
end; {CheckLine}
procedure DecodeLine;
VAR lineIndex, byteNum, count, i: integer;
chars: array [0..3] of byte;
hunk: array [0..2] of byte;
function nextch: char;
begin {nextch}
lineIndex := succ(lineIndex);
if lineIndex > length(line) then abort('Line too short.');
if not (line[lineindex] in [' '..'`'])
then abort('Illegal character in line.');
if line[lineindex] = '`' then nextch := ' '
else nextch := line[lineIndex]
end; {nextch}
procedure DecodeByte;
procedure GetNextHunk;
VAR i: integer;
begin {GetNextHunk}
for i := 0 to 3 do chars[i] := ord(nextch) - offset;
hunk[0] := (chars[0] shl 2) + (chars[1] shr 4);
hunk[1] := (chars[1] shl 4) + (chars[2] shr 2);
hunk[2] := (chars[2] shl 6) + chars[3];
byteNum := 0 {;
debug }
end; {GetNextHunk}
begin {DecodeByte}
if byteNum = 3 then GetNextHunk;
write (outfile, hunk[byteNum]);
{writeln(bytenum, ' ', hunk[byteNum]);}
byteNum := succ(byteNum)
end; {DecodeByte}
begin {DecodeLine}
lineIndex := 0;
byteNum := 3;
count := (ord(nextch) - offset);
for i := 1 to count do DecodeByte
end; {DecodeLine}
procedure terminate;
var trailer: string80;
begin {terminate}
if eof(infile) then abort ('Abnormal end.');
NextLine (trailer);
if length (trailer) < 3 then abort ('Abnormal end.');
if copy (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
close (infile);
close (outfile);
gotoxy(1,22);
end;
begin {uudecode}
init;
NextLine(line);
while CheckLine do
begin
DecodeLine;
NextLine(line)
end;
terminate
end.
SHAR_EOF
fi
if test -f 'uudecode.pas'
then
echo shar: "will not over-write existing file 'uudecode.pas'"
else
cat << \SHAR_EOF > 'uudecode.pas'
program uudecode;
CONST defaultSuffix = '.uue';
offset = 32;
TYPE string80 = string[80];
VAR infile: text;
fi : file of byte;
outfile: file of byte;
lineNum: integer;
line: string80;
size,remaining :real;
procedure Abort(message: string80);
begin {abort}
writeln;
if lineNum > 0 then write('Line ', lineNum, ': ');
writeln(message);
halt
end; {Abort}
procedure NextLine(var s: string80);
begin {NextLine}
LineNum := succ(LineNum);
{write('.');}
readln(infile, s);
remaining:=remaining-length(s)-2; {-2 is for CR/LF}
write('bytes remaining: ',remaining:7:0,' (',
remaining/size*100.0:3:0,'%)',chr(13));
end; {NextLine}
procedure Init;
procedure GetInFile;
VAR infilename: string80;
begin {GetInFile}
if ParamCount = 0 then abort ('Usage: uudecode <filename>');
infilename := ParamStr(1);
if pos('.', infilename) = 0
then infilename := concat(infilename, defaultSuffix);
assign(infile, infilename);
{$i-}
reset(infile);
{$i+}
if IOresult > 0 then abort (concat('Can''t open ', infilename));
writeln ('Decoding ', infilename);
assign(fi,infilename); reset(fi);
size:=FileSize(fi); close(fi);
if size < 0 then size:=size+65536.0;
remaining:=size;
end; {GetInFile}
procedure GetOutFile;
var header, mode, outfilename: string80;
ch: char;
procedure ParseHeader;
VAR index: integer;
Procedure NextWord(var word:string80; var index: integer);
begin {nextword}
word := '';
while header[index] = ' ' do
begin
index := succ(index);
if index > length(header) then abort ('Incomplete header')
end;
while header[index] <> ' ' do
begin
word := concat(word, header[index]);
index := succ(index)
end
end; {NextWord}
begin {ParseHeader}
header := concat(header, ' ');
index := 7;
NextWord(mode, index);
NextWord(outfilename, index)
end; {ParseHeader}
begin {GetOutFile}
if eof(infile) then abort('Nothing to decode.');
NextLine (header);
while not ((copy(header, 1, 6) = 'begin ') or eof(infile)) do
NextLine(header);
writeln;
if eof(infile) then abort('Nothing to decode.');
ParseHeader;
assign(outfile, outfilename);
writeln ('Destination is ', outfilename);
{$i-}
reset(outfile);
{$i+}
if IOresult = 0 then
begin
write ('Overwrite current ', outfilename, '? [Y/N] ');
repeat
read (kbd, ch);
ch := UpCase(ch)
until ch in ['Y', 'N'];
writeln(ch);
if ch = 'N' then abort ('Overwrite cancelled.')
end;
rewrite (outfile);
end; {GetOutFile}
begin {init}
lineNum := 0;
GetInFile;
GetOutFile;
end; { init}
Function CheckLine: boolean;
begin {CheckLine}
if line = '' then abort ('Blank line in file');
CheckLine := not (line[1] in [' ', '`'])
end; {CheckLine}
procedure DecodeLine;
VAR lineIndex, byteNum, count, i: integer;
chars: array [0..3] of byte;
hunk: array [0..2] of byte;
{ procedure debug;
var i: integer;
procedure writebin(x: byte);
var i: integer;
begin
for i := 1 to 8 do
begin
write ((x and $80) shr 7);
x := x shl 1
end;
write (' ')
end;
begin
writeln;
for i := 0 to 3 do writebin(chars[i]);
writeln;
for i := 0 to 2 do writebin(hunk[i]);
writeln
end; }
function nextch: char;
begin {nextch}
lineIndex := succ(lineIndex);
if lineIndex > length(line) then abort('Line too short.');
if not (line[lineindex] in [' '..'`'])
then abort('Illegal character in line.');
{ write(line[lineindex]:2);}
if line[lineindex] = '`' then nextch := ' '
else nextch := line[lineIndex]
end; {nextch}
procedure DecodeByte;
procedure GetNextHunk;
VAR i: integer;
begin {GetNextHunk}
for i := 0 to 3 do chars[i] := ord(nextch) - offset;
hunk[0] := (chars[0] shl 2) + (chars[1] shr 4);
hunk[1] := (chars[1] shl 4) + (chars[2] shr 2);
hunk[2] := (chars[2] shl 6) + chars[3];
byteNum := 0 {;
debug }
end; {GetNextHunk}
begin {DecodeByte}
if byteNum = 3 then GetNextHunk;
write (outfile, hunk[byteNum]);
{writeln(bytenum, ' ', hunk[byteNum]);}
byteNum := succ(byteNum)
end; {DecodeByte}
begin {DecodeLine}
lineIndex := 0;
byteNum := 3;
count := (ord(nextch) - offset);
for i := 1 to count do DecodeByte
end; {DecodeLine}
procedure terminate;
var trailer: string80;
begin {terminate}
if eof(infile) then abort ('Abnormal end.');
NextLine (trailer);
if length (trailer) < 3 then abort ('Abnormal end.');
if copy (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
close (infile);
close (outfile)
end;
begin {uudecode}
init;
NextLine(line);
while CheckLine do
begin
DecodeLine;
NextLine(line)
end;
terminate
end.
SHAR_EOF
fi
if test -f 'uuen.pas'
then
echo shar: "will not over-write existing file 'uuen.pas'"
else
cat << \SHAR_EOF > 'uuen.pas'
Program uuencode;
CONST header = 'begin';
trailer = 'end';
defaultMode = '644';
defaultExtension = '.uue';
offset = 32;
charsPerLine = 60;
bytesPerHunk = 3;
sixBitMask = $3F;
TYPE string80 = string[80];
VAR infile: file of byte;
outfile: text;
infilename, outfilename, mode: string80;
lineNum,
lineLength, numbytes, bytesInLine: integer;
line: array [0..59] of char;
hunk: array [0..2] of byte;
chars: array [0..3] of byte;
procedure Abort (message: string80);
begin {abort}
writeln(message);
close(infile);
close(outfile);
halt
end; {abort}
procedure Init;
procedure GetFiles;
VAR i: integer;
temp: string80;
ch: char;
begin {GetFiles}
if ParamCount < 1 then abort ('No input file specified.');
infilename := ParamStr(1);
{$I-}
assign (infile, infilename);
reset (infile);
{$i+}
if IOResult > 0 then abort (concat ('Can''t open file ', infilename));
write('Uuencoding file ', infilename);
i := pos('.', infilename);
if i = 0
then outfilename := infilename
else outfilename := copy (infilename, 1, pred(i));
mode := defaultMode;
if ParamCount > 1 then
for i := 2 to ParamCount do
begin
temp := Paramstr(i);
if temp[1] in ['0'..'9']
then mode := temp
else outfilename := temp
end;
if pos ('.', outfilename) = 0
then outfilename := concat(outfilename, defaultExtension);
assign (outfile, outfilename);
writeln (' to file ', outfilename, '.');
{$i-}
reset(outfile);
{$i+}
if IOresult = 0 then
begin
Write ('Overwrite current ', outfilename, '? [Y/N] ');
repeat
read (kbd, ch);
ch := Upcase(ch)
until ch in ['Y', 'N'];
writeln (ch);
if ch = 'N' then abort(concat (outfilename, ' not overwritten.'))
end;
close(outfile);
{$i-}
rewrite(outfile);
{$i+}
if ioresult > 0 then abort(concat('Can''t open ', outfilename));
end; {getfiles}
begin {Init}
clrscr;
writeln;
writeln;
GetFiles;
bytesInLine := 0;
lineLength := 0;
numbytes := 0;
writeln;
writeln (outfile, header, ' ', mode, ' ', infilename);
linenum := 0;
end; {init}
procedure FlushLine;
VAR i: integer;
procedure writeout(ch: char);
begin {writeout}
if ch = ' ' then write(outfile, '`')
else write(outfile, ch)
end; {writeout}
begin {FlushLine}
gotoxy(12,12);
clreol;
linenum := linenum + 1;
write('LineCount: ',linenum);
writeout(chr(bytesInLine + offset));
for i := 0 to pred(lineLength) do
writeout(line[i]);
writeln (outfile);
lineLength := 0;
bytesInLine := 0
end; {FlushLine}
procedure FlushHunk;
VAR i: integer;
begin {FlushHunk}
if lineLength = charsPerLine then FlushLine;
chars[0] := hunk[0] shr 2;
chars[1] := (hunk[0] shl 4) + (hunk[1] shr 4);
chars[2] := (hunk[1] shl 2) + (hunk[2] shr 6);
chars[3] := hunk[2] and sixBitMask;
for i := 0 to 3 do
begin
line[lineLength] := chr((chars[i] and sixBitMask) + offset);
{write(line[linelength]:2);}
lineLength := succ(lineLength)
end;
{writeln;}
bytesInLine := bytesInLine + numbytes;
numbytes := 0
end; {FlushHunk}
procedure encode1;
begin {encode1};
if numbytes = bytesperhunk then flushhunk;
read (infile, hunk[numbytes]);
numbytes := succ(numbytes)
end; {encode1}
procedure terminate;
begin {terminate}
if numbytes > 0 then flushhunk;
if lineLength > 0
then
begin
flushLine;
flushLine;
end
else flushline;
writeln (outfile, trailer);
close (outfile);
close (infile);
gotoxy(1,22);
end; {terminate}
begin {uuencode}
init;
while not eof (infile) do encode1;
terminate
end. {uuencode}
SHAR_EOF
fi
if test -f 'uuencode.pas'
then
echo shar: "will not over-write existing file 'uuencode.pas'"
else
cat << \SHAR_EOF > 'uuencode.pas'
Program uuencode;
CONST header = 'begin';
trailer = 'end';
defaultMode = '644';
defaultExtension = '.uue';
offset = 32;
charsPerLine = 60;
bytesPerHunk = 3;
sixBitMask = $3F;
TYPE string80 = string[80];
VAR infile: file of byte;
outfile: text;
infilename, outfilename, mode: string80;
lineLength, numbytes, bytesInLine: integer;
line: array [0..59] of char;
hunk: array [0..2] of byte;
chars: array [0..3] of byte;
size,remaining :real;
{ procedure debug;
var i: integer;
procedure writebin(x: byte);
var i: integer;
begin
for i := 1 to 8 do
begin
write ((x and $80) shr 7);
x := x shl 1
end;
write (' ')
end;
begin
for i := 0 to 2 do writebin(hunk[i]);
writeln;
for i := 0 to 3 do writebin(chars[i]);
writeln;
for i := 0 to 3 do writebin(chars[i] and sixBitMask);
writeln
end; }
procedure Abort (message: string80);
begin {abort}
writeln(message);
close(infile);
close(outfile);
halt
end; {abort}
procedure Init;
procedure GetFiles;
VAR i: integer;
temp: string80;
ch: char;
begin {GetFiles}
if ParamCount < 1 then abort ('No input file specified.');
infilename := ParamStr(1);
{$I-}
assign (infile, infilename);
reset (infile);
{$i+}
if IOResult > 0 then abort (concat ('Can''t open file ', infilename));
size:=FileSize(infile);
if size < 0 then size:=size+65536.0;
remaining:=size;
write('Uuencoding file ', infilename);
i := pos('.', infilename);
if i = 0
then outfilename := infilename
else outfilename := copy (infilename, 1, pred(i));
mode := defaultMode;
if ParamCount > 1 then
for i := 2 to ParamCount do
begin
temp := Paramstr(i);
if temp[1] in ['0'..'9']
then mode := temp
else outfilename := temp
end;
if pos ('.', outfilename) = 0
then outfilename := concat(outfilename, defaultExtension);
assign (outfile, outfilename);
writeln (' to file ', outfilename, '.');
{$i-}
reset(outfile);
{$i+}
if IOresult = 0 then
begin
Write ('Overwrite current ', outfilename, '? [Y/N] ');
repeat
read (kbd, ch);
ch := Upcase(ch)
until ch in ['Y', 'N'];
writeln (ch);
if ch = 'N' then abort(concat (outfilename, ' not overwritten.'))
end;
close(outfile);
{$i-}
rewrite(outfile);
{$i+}
if ioresult > 0 then abort(concat('Can''t open ', outfilename));
end; {getfiles}
begin {Init}
GetFiles;
bytesInLine := 0;
lineLength := 0;
numbytes := 0;
writeln (outfile, header, ' ', mode, ' ', infilename);
end; {init}
procedure FlushLine;
VAR i: integer;
procedure writeout(ch: char);
begin {writeout}
if ch = ' ' then write(outfile, '`')
else write(outfile, ch)
end; {writeout}
begin {FlushLine}
{write ('.');}
write('bytes remaining: ',remaining:7:0,' (',
remaining/size*100.0:3:0,'%)',chr(13));
writeout(chr(bytesInLine + offset));
for i := 0 to pred(lineLength) do
writeout(line[i]);
writeln (outfile);
lineLength := 0;
bytesInLine := 0
end; {FlushLine}
procedure FlushHunk;
VAR i: integer;
begin {FlushHunk}
if lineLength = charsPerLine then FlushLine;
chars[0] := hunk[0] shr 2;
chars[1] := (hunk[0] shl 4) + (hunk[1] shr 4);
chars[2] := (hunk[1] shl 2) + (hunk[2] shr 6);
chars[3] := hunk[2] and sixBitMask;
{debug;}
for i := 0 to 3 do
begin
line[lineLength] := chr((chars[i] and sixBitMask) + offset);
{write(line[linelength]:2);}
lineLength := succ(lineLength)
end;
{writeln;}
bytesInLine := bytesInLine + numbytes;
numbytes := 0
end; {FlushHunk}
procedure encode1;
begin {encode1};
if numbytes = bytesperhunk then flushhunk;
read (infile, hunk[numbytes]);
remaining:=remaining-1;
numbytes := succ(numbytes)
end; {encode1}
procedure terminate;
begin {terminate}
if numbytes > 0 then flushhunk;
if lineLength > 0
then
begin
flushLine;
flushLine;
end
else flushline;
writeln (outfile, trailer);
close (outfile);
close (infile);
end; {terminate}
begin {uuencode}
init;
while not eof (infile) do encode1;
terminate;
writeln;
end. {uuencode}
SHAR_EOF
fi
if test -f 'vmsdecod.pas'
then
echo shar: "will not over-write existing file 'vmsdecod.pas'"
else
cat << \SHAR_EOF > 'vmsdecod.pas'
program uudecode_vms (INPUT,OUTPUT,INFILE,OUTFILE);
{ Original source pilfered from the MS-DOS turbo version on SIMTEL20}
{ Converted from Turbo to Vax-Pascal by Erik Olson, Harvey Mudd College
(EOLSON@HMCVAX.BITNET)
(eolson@muddcs.UUCP)
10/86 }
{Corrected small bug for End of file - 10/15/86 eol}
CONST offset = 32;
TYPE string80 = varying[80] of char;
pack_128 = packed array[1..128] of char;
VAR infile: text;
outfile: file of pack_128;
lineNum: integer;
line: string80;
outidx : integer;
outbuf : pack_128;
Procedure Writebin(ch : char);
begin
if outidx = 128 then begin
write(outfile,outbuf);
outidx := 1;
end
else outidx := outidx + 1;
outbuf[outidx] := ch;
end;
procedure Abort(message: string80);
begin {abort}
writeln;
if lineNum > 0 then write('Line ', lineNum, ': ');
writeln(message);
end; {Abort}
procedure NextLine(var s: string80);
begin {NextLine}
LineNum := succ(LineNum);
if linenum mod 50 = 1 then writeln(LineNum);
readln(infile, s)
end; {NextLine}
procedure Init;
procedure GetInFile;
VAR infilename: string80;
begin {GetInFile}
write('_File: ');
readln(infilename);
open(infile,infilename,history := old);
reset(infile);
writeln ('Decoding '+infilename)
end; {GetInFile}
procedure GetOutFile;
var header, mode, outfilename: string80;
ch: char;
procedure ParseHeader;
VAR index: integer;
Procedure NextWord(var word:string80; var index: integer);
begin {nextword}
word := '';
while header[index] = ' ' do
begin
index := succ(index);
if index > length(header) then abort ('Incomplete header')
end;
while header[index] <> ' ' do
begin
word := word+header[index];
index := succ(index)
end
end; {NextWord}
begin {ParseHeader}
header := header+' ';
index := 7;
NextWord(mode, index);
NextWord(outfilename, index)
end; {ParseHeader}
begin {GetOutFile}
if eof(infile) then abort('Nothing to decode.');
NextLine (header);
while not ((substr(header,1,6) = 'begin ') or eof(infile)) do
NextLine(header);
writeln;
if eof(infile) then abort('Nothing to decode.');
ParseHeader;
open(outfile, outfilename,history := new);
writeln ('Destination is ', outfilename);
rewrite (outfile);
end; {GetOutFile}
begin {init}
lineNum := 0;
GetInFile;
GetOutFile;
end; { init}
Function CheckLine: boolean;
begin {CheckLine}
if line = '' then abort ('Blank line in file');
CheckLine := not (line[1] in [' ', '`'])
end; {CheckLine}
procedure DecodeLine;
VAR lineIndex, byteNum, count, i: integer;
chars: array [0..3] of integer;
hunk: array [0..2] of integer;
function nextch: char;
begin {nextch}
lineIndex := succ(lineIndex);
if lineIndex > length(line) then abort('Line too short.');
if not (line[lineindex] in [' '..'`'])
then abort('Illegal character in line.');
if line[lineindex] = '`' then nextch := ' '
else nextch := line[lineIndex]
end; {nextch}
procedure DecodeByte;
procedure GetNextHunk;
VAR i: integer;
begin {GetNextHunk}
for i := 0 to 3 do chars[i] := ord(nextch) - offset;
hunk[0] := (chars[0] * 4) + (chars[1] div 16);
hunk[1] := (chars[1] * 16) + (chars[2] div 4);
hunk[2] := (chars[2] * 64) + chars[3];
byteNum := 0
end; {GetNextHunk}
begin {DecodeByte}
if byteNum = 3 then GetNextHunk;
writebin (chr(hunk[byteNum]));
byteNum := succ(byteNum)
end; {DecodeByte}
begin {DecodeLine}
lineIndex := 0;
byteNum := 3;
count := (ord(nextch) - offset);
for i := 1 to count do DecodeByte
end; {DecodeLine}
procedure terminate;
var trailer: string80;
begin {terminate}
if eof(infile) then abort ('Abnormal end.');
NextLine (trailer);
if length (trailer) < 3 then abort ('Abnormal end.');
if substr (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
write(outfile,outbuf);
close (infile);
close (outfile)
end;
begin {uudecode}
init;
NextLine(line);
while CheckLine do
begin
DecodeLine;
NextLine(line)
end;
terminate
end.
SHAR_EOF
fi
exit 0
# End of shell archive