1program uudecode; 2 3 CONST defaultSuffix = '.uue'; 4 offset = 32; 5 6 TYPE string80 = string[80]; 7 8 VAR infile: text; 9 fi : file of byte; 10 outfile: file of byte; 11 lineNum: integer; 12 line: string80; 13 size,remaining :real; 14 15 procedure Abort(message: string80); 16 17 begin {abort} 18 writeln; 19 if lineNum > 0 then write('Line ', lineNum, ': '); 20 writeln(message); 21 halt 22 end; {Abort} 23 24 procedure NextLine(var s: string80); 25 26 begin {NextLine} 27 LineNum := succ(LineNum); 28 {write('.');} 29 readln(infile, s); 30 remaining:=remaining-length(s)-2; {-2 is for CR/LF} 31 write('bytes remaining: ',remaining:7:0,' (', 32 remaining/size*100.0:3:0,'%)',chr(13)); 33 end; {NextLine} 34 35 procedure Init; 36 37 procedure GetInFile; 38 39 VAR infilename: string80; 40 41 begin {GetInFile} 42 if ParamCount = 0 then abort ('Usage: uudecode <filename>'); 43 infilename := ParamStr(1); 44 if pos('.', infilename) = 0 45 then infilename := concat(infilename, defaultSuffix); 46 assign(infile, infilename); 47 {$i-} 48 reset(infile); 49 {$i+} 50 if IOresult > 0 then abort (concat('Can''t open ', infilename)); 51 writeln ('Decoding ', infilename); 52 assign(fi,infilename); reset(fi); 53 size:=FileSize(fi); close(fi); 54 if size < 0 then size:=size+65536.0; 55 remaining:=size; 56 end; {GetInFile} 57 58 procedure GetOutFile; 59 60 var header, mode, outfilename: string80; 61 ch: char; 62 63 procedure ParseHeader; 64 65 VAR index: integer; 66 67 Procedure NextWord(var word:string80; var index: integer); 68 69 begin {nextword} 70 word := ''; 71 while header[index] = ' ' do 72 begin 73 index := succ(index); 74 if index > length(header) then abort ('Incomplete header') 75 end; 76 while header[index] <> ' ' do 77 begin 78 word := concat(word, header[index]); 79 index := succ(index) 80 end 81 end; {NextWord} 82 83 begin {ParseHeader} 84 header := concat(header, ' '); 85 index := 7; 86 NextWord(mode, index); 87 NextWord(outfilename, index) 88 end; {ParseHeader} 89 90 begin {GetOutFile} 91 if eof(infile) then abort('Nothing to decode.'); 92 NextLine (header); 93 while not ((copy(header, 1, 6) = 'begin ') or eof(infile)) do 94 NextLine(header); 95 writeln; 96 if eof(infile) then abort('Nothing to decode.'); 97 ParseHeader; 98 assign(outfile, outfilename); 99 writeln ('Destination is ', outfilename); 100 {$i-} 101 reset(outfile); 102 {$i+} 103 if IOresult = 0 then 104 begin 105 write ('Overwrite current ', outfilename, '? [Y/N] '); 106 repeat 107 read (kbd, ch); 108 ch := UpCase(ch) 109 until ch in ['Y', 'N']; 110 writeln(ch); 111 if ch = 'N' then abort ('Overwrite cancelled.') 112 end; 113 rewrite (outfile); 114 end; {GetOutFile} 115 116 begin {init} 117 lineNum := 0; 118 GetInFile; 119 GetOutFile; 120 end; { init} 121 122 Function CheckLine: boolean; 123 124 begin {CheckLine} 125 if line = '' then abort ('Blank line in file'); 126 CheckLine := not (line[1] in [' ', '`']) 127 end; {CheckLine} 128 129 130 procedure DecodeLine; 131 132 VAR lineIndex, byteNum, count, i: integer; 133 chars: array [0..3] of byte; 134 hunk: array [0..2] of byte; 135 136{ procedure debug; 137 138 var i: integer; 139 140 procedure writebin(x: byte); 141 142 var i: integer; 143 144 begin 145 for i := 1 to 8 do 146 begin 147 write ((x and $80) shr 7); 148 x := x shl 1 149 end; 150 write (' ') 151 end; 152 153 begin 154 writeln; 155 for i := 0 to 3 do writebin(chars[i]); 156 writeln; 157 for i := 0 to 2 do writebin(hunk[i]); 158 writeln 159 end; } 160 161 function nextch: char; 162 163 begin {nextch} 164 lineIndex := succ(lineIndex); 165 if lineIndex > length(line) then abort('Line too short.'); 166 if not (line[lineindex] in [' '..'`']) 167 then abort('Illegal character in line.'); 168{ write(line[lineindex]:2);} 169 if line[lineindex] = '`' then nextch := ' ' 170 else nextch := line[lineIndex] 171 end; {nextch} 172 173 procedure DecodeByte; 174 175 procedure GetNextHunk; 176 177 VAR i: integer; 178 179 begin {GetNextHunk} 180 for i := 0 to 3 do chars[i] := ord(nextch) - offset; 181 hunk[0] := (chars[0] shl 2) + (chars[1] shr 4); 182 hunk[1] := (chars[1] shl 4) + (chars[2] shr 2); 183 hunk[2] := (chars[2] shl 6) + chars[3]; 184 byteNum := 0 {; 185 debug } 186 end; {GetNextHunk} 187 188 begin {DecodeByte} 189 if byteNum = 3 then GetNextHunk; 190 write (outfile, hunk[byteNum]); 191 {writeln(bytenum, ' ', hunk[byteNum]);} 192 byteNum := succ(byteNum) 193 end; {DecodeByte} 194 195 begin {DecodeLine} 196 lineIndex := 0; 197 byteNum := 3; 198 count := (ord(nextch) - offset); 199 for i := 1 to count do DecodeByte 200 end; {DecodeLine} 201 202 procedure terminate; 203 204 var trailer: string80; 205 206 begin {terminate} 207 if eof(infile) then abort ('Abnormal end.'); 208 NextLine (trailer); 209 if length (trailer) < 3 then abort ('Abnormal end.'); 210 if copy (trailer, 1, 3) <> 'end' then abort ('Abnormal end.'); 211 close (infile); 212 close (outfile) 213 end; 214 215 begin {uudecode} 216 init; 217 NextLine(line); 218 while CheckLine do 219 begin 220 DecodeLine; 221 NextLine(line) 222 end; 223 terminate 224 end. 225