[net.sources] Turbo UUENCODE/UUDECODE

mjb224@uiucuxf.CSO.UIUC.EDU (10/10/86)

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


I have seen several notes where someone is asking for UUENCODE and UUDECODE
source.  Well here is the Turbo Pascal version.  It is undocumented and I 
havn't as yet disected the algorithm but it does work.
What follows is two programs, UUENCODE.PAS and UUDECODE.PAS.  Separate them
and remove any junk at the top or between and compile.  
Have fun,

Mike Bruno
Arpanet: mjb224%uiucuxf@a.cs.uiuc.edu
Csnet:   mjb224%uiucuxf@uiuc.csnet
Bitnet:  mjb224@uiucuxf
UUCP:    {ihnp4,pur-ee}!uiucdcs!uiucuxc!uiucuxa!uiucuxf!mjb224
********* Only through December of 1986 **********************

Begin 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 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));
        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}

CUT HERE =======================================================

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.