program uudecode; CONST defaultSuffix = '.uue'; offset = 32; TYPE string80 = string[80]; VAR infile: text; outf : file; lineNum: integer; line: string80; outfilename : string80; {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. Putbyte (below) and Getbyte (in UUENCODE) bypass this 'feature' by using blockread and blockwrite. The only global variables either use are 'infilename' and 'inf' or 'outfilename' and 'outf'} procedure putbyte(b : byte; flush : boolean); type bufptr = ^bufrec; bufrec = record next : bufptr; buffer : array[1..128] of byte end; const sectstobuf = 8; {max number of sectors to buffer} sectswritten : integer = 1; {constants are essentially statics} bytptr : integer = 1; notopen : boolean = TRUE; infsize : integer = 0; listsave : integer = 0; tempsave : integer = 0; var list,temp,temp2 : bufptr; i : integer; begin if flush then begin list := ptr(listsave); temp := list; for i := 1 to sectswritten do begin blockwrite(outf,temp^.buffer,1); temp := temp^.next end; close(outf) end else begin if notopen then begin notopen := FALSE; assign(outf,outfilename); {$i-} reset(outf); {$i+} if ioresult = 0 then begin writeln('File ',outfilename,' exists. Cannot overwrite.'); halt end; {$i-} rewrite(outf); {$i+} if ioresult <> 0 then begin writeln('Cannot open file ',outfilename,' for output.'); halt end; new(list); temp := list; for i := 1 to sectstobuf - 1 do begin new(temp2); temp2^.next := NIL; temp^.next := temp2; temp := temp2 end; listsave := ord(list); tempsave := listsave; end; temp := ptr(tempsave); if bytptr > 128 then begin if temp^.next <> NIL then begin sectswritten := succ(sectswritten); temp := temp^.next; bytptr := 1 end else begin temp := ptr(listsave); for i := 1 to sectstobuf do begin blockwrite(outf,temp^.buffer,1); temp := temp^.next end; temp := ptr(listsave); sectswritten := 1; bytptr := 1 end end; temp^.buffer[bytptr] := b; bytptr := succ(bytptr); tempsave := ord(temp) end end; 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) end; {NextLine} procedure Init; procedure GetInFile; VAR infilename: string80; begin {GetInFile} if ParamCount = 0 then abort ('Usage: uudecode '); 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) end; {GetInFile} procedure GetOutFile; var header, mode : 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; 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; putbyte(hunk[byteNum],FALSE); {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); putbyte(26,TRUE) end; begin {uudecode} init; NextLine(line); while CheckLine do begin DecodeLine; NextLine(line) end; terminate end.