draper@bu-tyng.bu.edu (Dave (dday) Draper) (05/19/88)
I have received several requests for the source code for uudecode and uuencode written in turbo pascal. Here they are. Please don't FLAME me for posting them here. They are not binaries so I felt they should not be posted to the binaries group. I will be posting the binary versions to the binaries group for those of you who do not have a pascal compiler. Good luck with these programs. I have found them to be quite useful. Dave (dday) Draper decvax!elrond!bu-tyng!draper --------(snip)----------(UUDECODE)--------(snip)------------------------------- 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. ----------------(snip)-------(UUENCODE)----------(snip)--------------------- 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} ------------------------(snip)--------------(snip)---------------------------- Disclaimer: I DID NOT write this code. I make NO GUARENTIES whatsoever about it usefulness or anything else. ============================================================================== * Dave Draper UUCP: decvax!elrond!bu-tyng!draper * * Wang Institute of Boston University * * * * I saw a Dead Head sticker on a Cadillac, * * Don't look back, you can never look back. - Don Henley - * *============================================================================*