uuencoding 
Author Message
 uuencoding

Hi,

 Does anyone know of a Pascal source for uuencoding?
 At least, where can I get the algorithm.

Saludos,



Fri, 06 Aug 1999 03:00:00 GMT  
 uuencoding

Quote:
> Does anyone know of a pascal source for uuencoding?
> At least, where can I get the algorithm.

Theres lots of UUencoders which include source code..
If your looking for an XXencoder too, a good one with full TP source is
included in the SWAG archive...
--
    Valdus -/- Hilton Janfield -(- sysop of dark genesis bbs -\- Valdus
dark genesis bbs system * 250/561-2850 * 14400 baud * lots of games * MORE!
** Official Distribution Site for OutWorld Arts, Outlaw Triad, and SWAG! **


Fri, 06 Aug 1999 03:00:00 GMT  
 uuencoding

Quoting

created  17 Feb 97 12:37
received 17.02.97

Subject: uuencoding

Hi jffraiz and everybody else!

j> Hi,
j>
j>  Does anyone know of a pascal source for uuencoding?
j>  At least, where can I get the algorithm.
j>

program uuencode;
uses crt, dos;
  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);
        {Ich glaube hier fehlt noch was}
        {$I-}
      close(infile);
      close(outfile);
        {$I+}
        if ioresult <> 0 then;
      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-}
          {Und hier nochwas: statt rewrite reset}
          reset(outfile);
        {$i+}
        if IOresult = 0 then
          begin
            Write ('Overwrite current ', outfilename, '? [Y/N] ');
            repeat
              ch:=readkey;
              ch := Upcase(ch)
            until ch in ['Y', 'N'];
            writeln (ch);
            if ch = 'N' then abort(concat (outfilename, ' not overwritten.'))
          end;
          {Das "close(outfile)" was hier stand konnte weg}
        {$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}
cu,        Clemens

* * * * * * * * * * *  on the net since tuesday  * * * * * * * * * * * * *
_P.S._ Answer and/or comment _please_ (also) as follow-up-to: poster



Fri, 06 Aug 1999 03:00:00 GMT  
 uuencoding




 Look in SWAG, a freeware collection of pascal source, its 6MB+ big.

 ftp.gdsoft.com

"And all those crazy clothes make me look pretty crappy sometimes..."
  - Pete Townshend, The Who, "You better you bet"

.. Not tonight, dear, I have a modem.
___ Blue Wave/386 v2.30



Sun, 08 Aug 1999 03:00:00 GMT  
 
 [ 4 post ] 

 Relevant Pages 

1. Base64 and UUEncoding

2. MIME/UUEncoding <- The Solution

3. Mime / UUencoding

4. muencode (MIME Base64/UU Encoding in TPascal) (was Re: Mime / UUencoding)

 

 
Powered by phpBB® Forum Software