VAR inf : file;
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;
{ 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; }
{Binary file read added by Ross Alford, ...!mcnc!ecsvax!alford. The original
MSDOS versions of uuencode/decode just use read/write on a FILE OF BYTE.
CP/M Turbo expects some file info to be stored in the first 4 bytes of files
of any type other than TEXT. Getbyte (below) and Putbyte (in UUDECODE)
bypass this 'feature' by using blockread and blockwrite. The only global
variables either use are 'infilename' and 'inf' or 'outfilename' and 'outf'}
function getbyte(var b : byte) : boolean;
type bufptr = ^bufrec;
bufrec = record
next : bufptr;
buffer : array[1..128] of byte
end;
begin
if notopen then
begin
notopen := FALSE;
assign(inf,infilename);
{$i-}
reset(inf);
{$i+}
if ioresult <> 0 then
begin
writeln('File ',infilename,' not found. Aborting');
halt
end;
infsize := filesize(inf);
new(list);
list^.next := NIL;
listsaveofs := ofs(list^);
listsaveseg := seg(list^);
sectsread := 0
end;
list := ptr(listsaveseg,listsaveofs);
if bytptr > 128 then
begin
if list^.next <> NIL then
begin
temp := list^.next;
dispose(list);
list := temp;
bytptr := 1
end
else begin
dispose(list);
list := NIL;
j := 0;
while (sectsread<infsize) and (j<sectstobuf) do
begin
new(temp2);
temp2^.next := NIL;
if list=NIL then
begin
list := temp2;
temp := list
end
else begin
temp^.next := temp2;
temp := temp2
end;
blockread(inf,temp^.buffer,1);
j := succ(j);
sectsread := succ(sectsread)
end;
bytptr := 1
end
end;
listsaveofs := ofs(list^);
listsaveseg := seg(list^);
if list <> NIL then
begin
b := list^.buffer[bytptr];
bytptr := succ(bytptr);
getbyte := TRUE
end
else begin
b := 0;
getbyte := FALSE
end
end;
procedure Abort (message: string80);
begin {abort}
writeln(message);
close(inf);
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 (inf, infilename);
reset (inf);
{$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 {writeout}
if ch = ' ' then write(outfile, '`')
else write(outfile, ch)
end; {writeout}
begin {FlushLine}
write ('.');
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;
endofinfile := not (getbyte(hunk[numbytes]));
if not endofinfile then numbytes := succ(numbytes) {No succ at EOF -BE}
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 (inf);
end; {terminate}
begin {uuencode}
init;
while not endofinfile do encode1;
terminate
end. {uuencode}
