darmon@polaris.UUCP (Pierre Darmon) (10/26/86)
I have made a slight modification to the TP sources of uudecode/encode posted
several times to the net not long ago. Instead of filling up the screen with
periods, this modified version displays the count of the remaining bytes to
be processed. The two advantages are:
1) it does not scroll away the contents of the screen any more.
2) it gives an idea of how much work is left to be done (handy for large
files).
In order not to clobber the net I won't post. I'll just mail upon request.
But if I get too many requests, hum... well I may consider posting to
net.sources only.
To see how many requests I get, I'll wait a few days to decide to mail or post.
--
Pierre Darmon, IBM Thomas J. Watson Research Center.
.....seismo!philabs!polaris!darmon.
darmon.yktvmz.ibm@csnet-relay darmon@polaris.UUCP (Pierre Darmon) (10/30/86)
Hold it! Stop sending your requests or my mailbox is going to blow up. I have been litterally flooded with requests for my modified version of TP uudecode/ encode. So I wil post it to net.sources as soon as this is posted. Enjoy. Pierre Darmon, IBM Thomas J. Watson Research Center. .....seismo!philabs!polaris!darmon. darmon.yktvmz.ibm@csnet-relay -- Pierre Darmon, IBM Thomas J. Watson Research Center. .....seismo!philabs!polaris!darmon. darmon.yktvmz.ibm@csnet-relay
darmon@polaris.UUCP (Pierre Darmon) (10/30/86)
The following are the Turbo Pascal source files for uudecode and uuencode,
modified from the net posting to display the remaining bytes to be processed,
instead of filling up the screen with periods. It also displays the percentage
left. See my previous posting to net.micro,net.micro.pc and net.sources for
details.
Enjoy!
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.
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}
--
Pierre Darmon, IBM Thomas J. Watson Research Center.
.....seismo!philabs!polaris!darmon.
darmon.yktvmz.ibm@csnet-relay