beatyr@pur-ee.UUCP (Robert Beaty) (09/12/86)
<<<<<>>>>>
I worked up this version of uudecode for the ST after getting
the turbo pascal version to work on my PC. It is the full
featured version, except that it will write only even numbered
binary files. This is because OSS Pascal can only write integers
to files and an integer is two bytes. This is not a functional
problem, only a theoretical one.
The original author should probably stand forward, as should
the copywrite info for OSS Pascal, but since this is the net,
and you need the Compiler to get it running, I think it is
good enough.
I don't guarantee anything other than it works for me, and it
does use the GEM interface (I added that). If you need the
executable then mail me at the address at the end of this posting,
I will try to work something out. Have fun!
****** cut here ******
program uudecode;
CONST
{$I gemconst }
defaultSuffix = '.UUE';
offset = 32;
TYPE
{$I gemtype }
string80 = string[80];
VAR infile: text;
outfile: file of integer;
lineNum: integer;
uuline, mess : string80;
path, name : Path_Name;
double_byte : integer;
Got_High_Byte : Boolean;
i : integer;
x : Str255;
{$I gemsubs }
procedure OutputWord( std_byte : byte );
{ This procedure is for the ST where the smallest thing is a word }
begin
if Got_High_Byte then
begin
double_byte:=double_byte + (std_byte & $00ff);
outfile^:=double_byte;
Put(outfile);
Got_High_Byte:=False;
end
else
begin
double_byte:=ShL(std_byte, 8) & $ff00;
Got_High_Byte:=True;
end;
end;
procedure Abort(message: string80);
var
x : str255;
a, b : integer;
i : integer;
begin {abort}
x:='[3][ '; { make it a stop sign }
if lineNum > 0 then
begin
x:=Concat(x,'Line ');
a:=lineNum;
for i:=4 downto 1 do
begin
b:=Trunc(a/PwrOfTen(i));
a:=a-Trunc(b*PwrOfTen(i));
x:=Concat(x,Chr(b+48));
end;
x:=Concat(x,Chr(a+48),' : | ');
end;
x:=Concat(x,message,' ]');
x:=Concat(x,'[ Exit ]');
i:=Do_Alert(x,1);
Exit_GEM;
Halt;
end; {Abort}
procedure NextLine(var s: string80);
begin {NextLine}
LineNum := LineNum+1;
readln(infile, s);
end; {NextLine}
procedure Init;
procedure GetInFile;
VAR infilename: string80;
i : integer;
begin {GetInFile}
path:='A:\*.UUE';
name:='';
if (Get_In_File( path, name )) then
begin
IO_Check( False );
reset(infile, name);
if IO_Result <> 0 then
begin
mess:=Concat( 'Cannot open ',name );
abort( mess );
end;
IO_Check( True );
infilename:=name;
end
else
abort( 'No input file specified' );
end; {GetInFile}
procedure GetOutFile;
var header, mode, outfilename, test: string80;
ch: char;
i : integer;
x : str255;
procedure ParseHeader;
VAR index: integer;
Procedure NextWord(var word:string80; var index: integer);
begin {nextword}
word := '';
while header[index] = ' ' do
begin
index := index+1;
if index > length(header) then abort ('Incomplete header');
end;
while header[index] <> ' ' do
begin
word := concat(word, header[index]);
index := index+1;
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);
test:=Copy( header, 1, 6 );
while not ((test = 'begin ') or EOF(infile)) do
begin
NextLine(header);
test:=Copy( header, 1, 6 );
end;
if eof(infile) then abort('Nothing to decode.');
ParseHeader;
x:=Concat( '[0][ Destination is ', outfilename,' ]' );
x:=Concat( x, '[ Fine ]' );
i:=Do_Alert(x,1); { do the message }
IO_Check( False );
reset(outfile, outfilename);
if IO_Result = 0 then
begin
x:='[2][';
x:=Concat(x,' Overwrite current |');
x:=Concat(x,outfilename,'? ]');
x:=Concat(x,'[ Yes | No ]');
i:=Do_Alert( x, 0 );
if i = 2 then abort ('Overwrite cancelled.');
end;
IO_Check( True );
rewrite (outfile, outfilename);
end; {GetOutFile}
begin {init}
lineNum := 0;
GetInFile;
GetOutFile;
end; { init}
Function CheckLine: boolean;
begin {CheckLine}
if uuline = '' then abort ('Blank line in file');
CheckLine := not (uuline[1] in [' ', '`']);
end; {CheckLine}
procedure DecodeLine;
VAR lineIndex, byteNum, count, i: integer;
chars: array [0..3] of integer;
hunk: array [0..2] of byte;
function nextch: char;
begin {nextch}
lineIndex := lineIndex+1;
if lineIndex > length(uuline) then abort('Line too short.');
if not (uuline[lineindex] in [' '..'`']) then
abort('Illegal character in line.');
if uuline[lineindex] = '`' then
nextch := ' '
else
nextch := uuline[lineIndex];
end; {nextch}
procedure DecodeByte;
procedure GetNextHunk;
VAR i : integer;
a,b,c,d,e,f : byte;
begin {GetNextHunk}
for i := 0 to 3 do
chars[i]:=ord(nextch)-offset;
a:=ShL(chars[0],2) & $00fc;
b:=ShR(chars[1],4) & $000f;
c:=ShL(chars[1],4) & $00f0;
d:=ShR(chars[2],2) & $003f;
e:=ShL(chars[2],6) & $00c0;
f:=chars[3];
hunk[0] := a + b;
hunk[1] := c + d;
hunk[2] := e + f;
byteNum := 0;
end; {GetNextHunk}
begin {DecodeByte}
if byteNum = 3 then GetNextHunk;
OutputWord( hunk[byteNum] ); { this is ST specific!! }
byteNum := byteNum+1;
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, test: string80;
begin {terminate}
if eof(infile) then abort ('Abnormal end.');
NextLine (trailer);
if length (trailer) < 3 then abort ('Abnormal end.');
test:=Copy( trailer, 1, 3 );
if test <> 'end' then abort ('Abnormal end.');
if Got_High_Byte then { rescue the lost byte }
begin
outfile^:=double_byte;
Put(outfile);
end;
close (infile);
close (outfile);
end;
begin {uudecode}
if Init_GEM >= 0 then
begin
init;
NextLine(uuline);
while CheckLine do
begin
DecodeLine;
NextLine(uuline);
end;
terminate;
Exit_GEM;
end;
end.
****** cut here ******
----------
... ihnp4!pur-ee!beatyr <- usenet
... beatyr@ed.ecn.purdue.edu <- arpa-net
... beatyr@pur-ee.UUCP <- UUCP
----------