[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{
> Yeah ! Please post your UU(EN/DE)CODE here ! I am interested, as well !

Here she goes then.
}

PROGRAM uuencode;

Uses Dos,Crt;

CONST
  Header = 'begin';
  Trailer = 'end';
  DefaultMode = '644';
  DefaultExtension = '.uue';
  OFFSET = 32;
  CHARSPERLINE = 60;
  BYTESPERHUNK = 3;
  SIXBITMASK = $3F;
TYPE
  Str80 = STRING[80];
VAR
  Infile: FILE OF Byte;
  Outfile: TEXT;
  Infilename, Outfilename, Mode: Str80;
  lineLength, numbytes, bytesInLine: INTEGER;
  Line: ARRAY [0..59] OF CHAR;
  hunk: ARRAY [0..2] OF Byte;
  chars: ARRAY [0..3] OF Byte;
  size,remaining : longint;  {v1.1 REAL;}
PROCEDURE Abort (Msg : Str80);
  BEGIN
    WRITELN(Msg);
    {$I-}                 {v1.1}
    CLOSE(Infile);
    CLOSE(Outfile);
    {$I+}                 {v1.1}
    HALT
  END; {of Abort}
PROCEDURE Init;
  PROCEDURE GetFiles;
    VAR
      i : INTEGER;
      TempS : Str80;
      Ch : CHAR;
    BEGIN
      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;
      { Process 2d cmdline arg (if any).
        It could be a new mode (rather than default "644")
        or it could be a forced output name (rather than
        "infile.uue")       }
      IF ParamCount > 1                         {got more args}
      THEN FOR i := 2 TO ParamCount DO BEGIN
        TempS := ParamStr(i);
        IF TempS[1] IN ['0'..'9']               {numeric : it's a mode}
        THEN Mode := TempS
        ELSE Outfilename := TempS               {it's output filename}
      END;
      IF POS ('.', Outfilename) = 0       {he didn't give us extension..}
                                          {..so make it ".uue"}
      THEN Outfilename := CONCAT(Outfilename, DefaultExtension);
      ASSIGN (Outfile, Outfilename);
      WRITELN (' to file ', Outfilename, '.');
      {$I-}
      RESET(Outfile);
      {$I+}
      IF IOResult = 0 THEN BEGIN          {output file exists!}
        WRITE ('Overwrite current ', Outfilename, '? [Y/N] ');
        REPEAT
          Ch := Upcase(ReadKey);
        UNTIL Ch IN ['Y', 'N'];
        WRITELN (Ch);
        IF Ch = 'N' THEN Abort(CONCAT (Outfilename, ' not overwritten.'))
      END;
      {$I-}
      CLOSE(Outfile);
      IF IOResult <> 0 THEN ;  {v1.1 we don't care}
      REWRITE(Outfile);
      {$I+}
      IF IOResult > 0 THEN Abort(CONCAT('Can''t open ', Outfilename));
    END; {of GetFiles}
  BEGIN {Init}
    GetFiles;
    bytesInLine := 0;
    lineLength := 0;
    numbytes := 0;
    WRITELN (Outfile, Header, ' ', Mode, ' ', Infilename);
  END; {init}
{You'll notice from here on we don't do any error-trapping on disk
 read/writes.  We just let DOS do the job.  Any errors are terminal
 anyway, right? }
PROCEDURE FlushLine;
  VAR i: INTEGER;
  PROCEDURE WriteOut(Ch: CHAR);
    BEGIN
      IF Ch = ' ' THEN WRITE(Outfile, '`')
                  ELSE WRITE(Outfile, Ch)
    END; {of WriteOut}
  BEGIN {FlushLine}
    {write ('.');}
    WRITE('bytes remaining: ',remaining:7,' (',
          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; {of FlushLine}
PROCEDURE FlushHunk;
  VAR i: INTEGER;
  BEGIN
    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);}
      Inc(lineLength);
    END;
    {writeln;}
    Inc(bytesInLine,numbytes);
    numbytes := 0
  END; {of FlushHunk}
PROCEDURE Encode1;
  BEGIN
    IF numbytes = BYTESPERHUNK THEN FlushHunk;

    READ (Infile, hunk[numbytes]);
    Dec(remaining);
    Inc(numbytes);
  END; {of Encode1}
PROCEDURE Terminate;
  BEGIN
    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}

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]