Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!columbia!rutgers!ll-xn!mit-eddie!genrad!panda!enmasse!drilex!axiom!linus!philabs!polaris!darmon
From: darmon@polaris.UUCP (Pierre Darmon)
Newsgroups: net.sources
Subject: Modified Turbo Pascal uudecode/encode. More user-friendly.
Message-ID: <768@polaris.UUCP>
Date: Wed, 29-Oct-86 20:12:40 EST
Article-I.D.: polaris.768
Posted: Wed Oct 29 20:12:40 1986
Date-Received: Mon, 3-Nov-86 20:19:50 EST
Reply-To: darmon@polaris.UUCP (Pierre Darmon)
Organization: IBM Research, Yorktown Heights, N.Y.
Lines: 450

The following are the Turbo Pascal source files for uudecode and uuencode,
modified from the net posting to display the remaining bytes to be processed,
instead of filling up the screen with periods. It also displays the percentage
left. See my previous posting to net.micro,net.micro.pc and net.sources for
details.

Enjoy!




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.





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}



-- 

Pierre Darmon, IBM Thomas J. Watson Research Center.                        
.....seismo!philabs!polaris!darmon.
darmon.yktvmz.ibm@csnet-relay