{-------------------------------------------------------------------------------
  This unit provides decoding and encoding of UUEncode and Base64.

  This code was cuted from biger project written by:

	Andreas H"orstemeier
        Mefferdatisstrasse 16-18
        52062 Aachen
        Germany
	ah@scp.de (at work), andy@hoerstemeier.de (at home)
	http://www.westend.de/~hoerstemeier
  
  Andreas H"orstemeir put it to public domain, this piece is released
  under same terms. Andreas write:
	This component is Public Domain. If you like it you can send me
	a thank you on a nice postcard from your hometown, but if you
	really want to send me money I won't complain :-) , but count
	it as a gift not a payment.  You are free to put this component
	on a CD-ROM, but if you do so please send me a copy. And of
	course only spread this component complete with all the readme's
	and sources.

  Cutter is:
	Jan Tomasek
	xtomasej@fel.cvut.cz
	http://mujweb.cz/web/tomasek

  Simple example of use:
	Procedure XYZ;
	Var
          S1 : String;
	Begin
	  S1 := 'Hello world!';
	  S1 := EncodeLine(encBase64, S1[1], Length(S1));
	  S1 := DecodeLine(encBase64, S1);
	End;

  Version: 1.00
  History:
	28.10.1998 - Released.
-------------------------------------------------------------------------------}

unit mime;

interface
Type
  TEncoding = (encUuencode, encBase64, encMime);

Function EncodeLine(Mode:TEncoding; Const Buf; Size:Integer):String;
Function DecodeLine(Mode:TEncoding; Const Inp:String):String;

implementation

Type
  ta_8u=packed array [0..65530] of byte;
Const
  bin2uue :String = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  bin2b64 :String = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  uue2bin :String = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ ';
  b642bin :String = '~~~~~~~~~~~^~~~_TUVWXYZ[\]~~~|~~~ !"#$%&''()*+,-./0123456789~~~~~~:;<=>?@ABCDEFGHIJKLMNOPQRS';

{ Find the n'th occurence of a character different to c,
  if n<0 look from the back }
Function PosCN(C:char; Const S:String; N: Integer):Integer;
Var
  I: Integer;
Begin
  If N=0 Then N:=1;
  If N>0 Then Begin
    For I:=1 To Length(S) Do Begin
      If S[I]<>C Then Begin
        Dec(n);
        Result:=I;
        If N=0 Then Exit;
      End;
    End;
  End Else Begin
    For I:=Length(S) DownTo 1 Do Begin
      If S[I]<>C Then Begin
        Inc(N);
        Result:=I;
        If N=0 Then Exit;
      End;
    End;
  End;
  Result:=0;
End;{-- PosCN -----------------------------------------------------------------}

Function EncodeLine(Mode:TEncoding; Const Buf; Size:Integer):String;
Var
  Buff      : ta_8u absolute buf;
  Offset    : shortint;
  Pos1,Pos2 : byte;
  I         : byte;
  Ret       : String;
Begin
  {$IFDEF Win32}
  SetLength(Ret, Size*4 div 3 + 4);
  {$ELSE}
  Ret[0]:=chr(Size*4 div 3 + 4);
  {$ENDIF}
  Fillchar(Ret[1], Size*4 div 3 +2,#0);   { worst case }
  If Mode=encUuencode Then Begin
    Ret[1] := char(((Size-1) and $3f)+$21);
    Size   := ((Size+2) div 3)*3;
  End;
  Offset:=2;
  Pos1:=0;
  Pos2:=0;   { Delphi 2 Shut up! }
  Case Mode of
    encUuencode       : Pos2:=2;
    encBase64, encMime: Pos2:=1;
  End;
  Ret[Pos2]:=#0;

  While Pos1<Size Do Begin
    If Offset>0 Then Begin
      Ret[Pos2]  := char(ord(Ret[Pos2]) or
                      ((Buff[Pos1] and ($3f shl Offset)) shr Offset));
      Offset     := Offset-6;
      Inc(Pos2);
      Ret[Pos2]  := #0;
    End Else If Offset<0 Then Begin
      Offset     := abs(Offset);
      Ret[Pos2]  := char(ord(Ret[Pos2]) or
                      ((Buff[Pos1] and ($3f shr Offset)) shl Offset));
      Offset     := 8-Offset;
      Inc(Pos1);
    End Else Begin
      Ret[Pos2]  := char(ord(Ret[Pos2]) or ((Buff[Pos1] and $3f)));
      Inc(Pos2); Inc(Pos1);
      Ret[Pos2]  := #0;
      Offset:=2;
    End;
  End; {While}

  Case Mode of
    encUuencode: Begin
     If Offset=2 Then dec(Pos2);
     For I:=2 To Pos2 Do
     Ret[I]:=bin2uue[ord(Ret[i])+1];
    End;
    encBase64, encMime: Begin
     If Offset=2 Then dec(Pos2);
     For I:=1 To Pos2 Do
       Ret[i]:=bin2b64[ord(Ret[i])+1];
       While (Pos2 and 3)<>0  Do Begin
         inc(Pos2);
         Ret[Pos2] := '=';
       End;
    End;
  End; {Case}
  Result := copy(Ret,1,Pos2);
End;{-- EncodeLine ------------------------------------------------------------}

Function DecodeLine(Mode:TEncoding; const Inp:String):String;
Var
  Count,Pos1,Pos2 : integer;
  Offset          : shortint;
  S               : string;
  Ret             : string;
begin
  S:=Inp;
  {$IFDEF Win32}
  SetLength(Ret, length(s)*3 div 4 +3);
  {$ELSE}
  Ret[0]:=chr(length(s)*3 div 4 +3);
  {$ENDIF}
  FillChar(Ret[1],length(s)*3 div 4 +3,#0);   { worst case }
  If (Mode=encUuencode) and not (s[1] in [' '..'M','`']) Then
    Count:=0   { ignored line }
  Else Begin
    Count:=0; Pos1:=0;  { Delphi 2 Shut up! }
    Case Mode Of  { !!! No check for invalid data yet }
      encUuencode: Begin
        Count:=(ord(S[1]) - $20) and $3f;
        For Pos1:=2 To length(S) Do
          S[Pos1]:=char(ord(uue2bin[ord(S[Pos1])-$20+1])-$20);
        Pos1:=2;
      End;
      encBase64, encMime: Begin {set Count,Pos1, string -> Data into $00..$3F}
        Count:=Poscn('=',S,-1)*3 div 4;
        For Pos1:=1 To length(S) Do
        S[Pos1]:=char(ord(b642bin[ord(S[Pos1])-$20+1])-$20);
        Pos1:=1;
      End;
    End;
    Pos2:=1;
    Offset:=2;
    While Pos2<=Count Do Begin
      If (Pos1>length(s)) or ((Mode<>encUuencode) and (s[Pos1]='\'))  Then Begin
        If Offset<>2 Then inc(Pos2);
        Count:=Pos2-1;
      End Else
        If ((Mode<>encUuencode) and (s[Pos1]='^')) Then   { illegal char in source }
          inc(Pos1)  { skip char, prevent endless loop jane :}
        Else
          If Offset>0 Then Begin
            Ret[Pos2]:=char(ord(Ret[Pos2]) or (ord(s[Pos1]) shl Offset));
            inc(Pos1);
            Offset:=Offset-6;
          End Else
            If Offset<0 Then Begin
              Offset:=abs(Offset);
              Ret[Pos2]:=char(ord(Ret[Pos2]) or (ord(s[Pos1]) shr Offset));
              inc(Pos2);
              Offset:=8-Offset;
            End Else Begin
              Ret[Pos2]:=char(ord(Ret[Pos2]) or ord(s[Pos1]));
              inc(Pos1);
              inc(Pos2);
              Offset:=2;
            End;
    End; {While}
  End;
  Result:=copy(Ret,1,Count);
End;{-- DecodeLine ------------------------------------------------------------}

end.
