{
  UNMIME.PAS - decodes mime encapsulated (Base64 and quoted-printable
  messages. Doesn't support multipart messages and messages larger than
  64 KB. Usage 

       unmime filename

, where filename can contain wildcard

  Installation in UUPC environment:
  insert call to unmime  Drive:\uupc\spool\your-provider\d\*.*
  into uupc.bat between uucico and uuxqt
}
uses Dos;
Const HeadLine='Content-Transfer-Encoding: ';
      etNoEncoding=0;
      etBase64=1;  {et==Encoding Type}
      etQuoted=2;
      hsBase64='BASE64'; {hs=Header String}
      hsQuoted='QUOTED-PRINTABLE';
Type TBuf=Array[0..65530] of char;
     PBuf=^TBuf;
var
{Variables of main program. Used for searching all files, matching
 specified pattern}

   SR:SearchRec;
   D:DirStr;
   N:NameStr;
   E:ExtStr;
Function DecodeQuotedPrintable(P:PBuf;StartChar,Size:word):Word;
var i,j,code,err:Integer;
    S:String[4];
begin
   I:=StartChar;
   J:=I;
   While i<Size do
    begin
     if P^[i]='=' then
      begin
       inc(i);
       Case P^[i] of
       '=':begin P^[J]:='=';inc(J); end;
       #10,#13:if P^[i+1] in [#13,#10] then inc(i);
       '0'..'9','A'..'F','a'..'f':
        begin
         S:='$'+P^[i];inc(i);
         S:=S+P^[i];
         Val(S,Code,Err);
         {if Recode then P^[j]:=Xlat[chr(code)] else  }
         P^[J]:=chr(Code);
         inc(j);
        end;
       end{case}
    end
    else
    begin
     P^[J]:=P^[i];
     inc(J);
    end;
   inc(I);
  end;
  DecodeQuotedPrintable:=J;
end;
Function DecodeBase64(P:PBuf;StartChar,Size:Word):word;
{This procedure is almost literally translated from C from
 function rfc822_binary, got from sources of Pine v3.91 mailer}
var c,d,e:integer;
    i,j:Word;
begin
 e:=0;
 i:=StartChar-1;
 j:=StartChar;
 While (i<size) do
  begin
   inc(i);
   case P^[i] of
   'A'..'Z':c:=ord(P^[i])-ord('A');
   'a'..'z':c:=ord(P^[i])-(ord('a')-26);
   '0'..'9':c:=ord(P^[i])-(ord('0')-52);
   '+':c:=62;
   '/':c:=63;
   '=':{padding} begin
                   case e of
                   2:begin
                     if P^[i+1]<>'=' then
                      begin
                       DecodeBase64:=0; exit;{Error. Better to leave message
                                             unchanged}
                       exit;
                      end;
                     inc(i);
                    end;
                   3:e:=0; {restart}
                   else
                     begin
                       DecodeBase64:=0; exit;{Error. Better to leave message
                                             unchanged}
                       exit;
                      end;
                 end;
                 continue;
             end;
       else continue;
      end;{case}
    inc(e);
    case e of
    1: d:=c shl 2;
    2:begin
      d:=d or (c shr 4);
       p^[j]:=chr(d);inc(j);
       d:=c shl 4;
      end;
    3:begin
      d:=d or (c shr 2);
       p^[j]:=chr(d);inc(j);
       d:=c shl 6;
      end;
    4:begin
      d:=d or c;
       p^[j]:=chr(d);inc(j);
       e:=0;
      end;
    end;
  end;{while}
  DecodeBase64:=j;
end;
Function GetLine(P:PBuf;var index:word):string;
{Extracts one line from file, loaded into buffer}
var S:String;
begin
 S:='';
 While (P^[index]<>#10) do
  begin
   S:=S+P^[index];
   inc(index);
  end;
  inc(index);
  GetLine:=s;
end;
Procedure DecodeFile(Name:String);
{Determines encoding of this file}
var F:File;
P:PBuf;Size:LongInt;NewSize,I:Word;
S:String;
HS:String;
J,Encoding:Integer;
begin
 Encoding:=etNoEncoding;
 Assign(F,Name);
 Reset(F,1);
 Size:=FileSize(F);
 if Size>65521 then
  begin
   Close(F);
   Exit;
  end;
 GetMem(P,Size);
 BlockRead(F,P^,Size);
 I:=0;
 Repeat
  S:=GetLine(P,i);
  if Copy(S,1,length(HeadLine))=HeadLine then
   begin
    HS:=copy(S,length(HeadLine)+1,255);
    if HS[Length(HS)]=#13 then Dec(HS[0]); {Perhaps letter has DOS-style linefeeds}
    for j:=1 to length(HS) do HS[j]:=UpCase(HS[j]);
    if (HS=hsBase64) then Encoding:=etBase64
     else
    if (HS=hsQuoted) then Encoding:=etQuoted;
   end;
 Until (S='')or(I>=size);{Empty line indicates beginning of message body}
 if (I>=size) then
   begin
    Close(F);
    exit;
   end;
Case Encoding of
etNoEncoding:begin Close(F);exit end;
etBase64:NewSize:=DecodeBase64(P,i,Size);
etQuoted:NewSize:=DecodeQuotedPrintable(P,i,Size);
end;
if NewSize<>0 then
begin
 Rewrite(F,1);
 BlockWrite(F,P^,NewSize);
end;
Close(F);
end;
{**************** main program *******************}
begin
 if ParamStr(1)='' then
  begin
   Writeln('Use: unmime filespec');
   Halt;
  end;
 FSplit(ParamStr(1),D,N,E);
 FindFirst(ParamStr(1),AnyFile and not (Directory+VolumeID),Sr);
 While DosError=0 do
  begin
   DecodeFile(D+Sr.Name);
   FindNext(Sr);
  end;
end.