bleckmd@jacobs.cs.orst.edu (david bleckmann) (12/25/87)
These are pascal sources to uudecode and uuencode that I got from this group ages ago. Hope they help. #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # uudecode.pas # uuencode.pas # This archive created: Fri Dec 25 00:11:32 1987 export PATH; PATH=/bin:$PATH if test -f 'uudecode.pas' then echo shar: will not over-write existing file "'uudecode.pas'" else cat << \SHAR_EOF > 'uudecode.pas' program uudecode; CONST defaultSuffix = '.uue'; offset = 32; TYPE string80 = string[80]; VAR infile: text; outfile: file of byte; lineNum: integer; line: string80; 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 {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) 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. SHAR_EOF fi # end of overwriting check if test -f 'uuencode.pas' then echo shar: will not over-write existing file "'uuencode.pas'" else cat << \SHAR_EOF > 'uuencode.pas' 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; { 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 begin {abort program} writeln; writeln (' Usage: uuencode {filename}.'); halt end; infilename := ParamStr(1); {$I-} assign (infile, infilename); reset (infile); {$i+} if IOResult > 0 then abort (concat ('Can''t open file ', infilename)); 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 ('.'); 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]); 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 end. {uuencode} SHAR_EOF fi # end of overwriting check # End of shell archive exit 0