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

    {
     JD> This 'base64' encoding is new to me. Anybody out there who has an
     JD> algorithm or code.

    === UNBASE64.PAS
    { Decode base-64 files, Arne de Bruijn, 1996, Released to the Public Domain }
    { Strip everything but the base-64 lines before feeding it into this program }
    uses dos;
    var
     Base64:array[43..122] of byte;
    var
     T:text;
     Chars:set of char;
     S:string;
     K,I,J:word;
     Buf:pointer;
     DShift:integer;
     F:file;
     B,B1:byte;
     Decode:array[0..63] of byte;
     Shift2:byte;
     Size,W:word;
    begin
     FillChar(Base64,SizeOf(Base64),255);
     J:=0;
     for I:=65 to 90 do
      begin
       Base64[I]:=J;
       Inc(J);
      end;
     for I:=97 to 122 do
      begin
       Base64[I]:=J;
       Inc(J);
      end;
     for I:=48 to 57 do
      begin
       Base64[I]:=J;
       Inc(J);
      end;
     Base64[43]:=J; Inc(J);
     Base64[47]:=J; Inc(J);
     if ParamCount=0 then
      begin
       WriteLn('UNBASE64 <mime file> [<output file>]');
       Halt(1);
      end;
     S:=ParamStr(1);
     assign(T,S);
     GetMem(Buf,32768);
     SetTextBuf(T,Buf^,32768);
     {$I-} reset(T); {$I+}
     if IOResult<>0 then
      begin
       WriteLn('Error reading ',S);
       Halt(1);
      end;
     if ParamCount>=2 then
      S:=ParamStr(2)
     else
      begin write('Destination:'); ReadLn(S); end;
     assign(F,S);
     {$I-} rewrite(F,1); {$I+}
     if IOResult<>0 then
      begin
       WriteLn('Error creating ',S);
       Halt(1);
      end;
     while not eof(T) do
      begin
       ReadLn(T,S);
       if (S<>'') and (pos(' ',S)=0) and (S[1]>=#43) and (S[1]<=#122) and
        (Base64[byte(S[1])]<>255) then
        begin
         FillChar(Decode,SizeOf(Decode),0);
         DShift:=0;
         J:=0; Shift2:=1;
         Size:=255;
         B:=0;
         for I:=1 to Length(S) do
          begin
           case S[I] of
            #43..#122:B1:=Base64[Ord(S[I])];
           else
            B1:=255;
           end;
           if B1=255 then
            if S[I]='=' then
             begin
              B1:=0; if Size=255 then Size:=J;
             end
            else
             WriteLn('Char error:',S[I],' (',Ord(S[I]),')');
           if DShift and 7=0 then
            begin
             Decode[J]:=byte(B1 shl 2);
             DShift:=2;
            end
           else
            begin
             Decode[J]:=Decode[J] or Hi(word(B1) shl (DShift+2));
             Decode[J+1]:=Lo(word(B1) shl (DShift+2));
             Inc(J);
             Inc(DShift,2);
            end;
          end;
         if Size=255 then Size:=J;
         BlockWrite(F,Decode,Size);
        end;
      end;
     Close(F);
     close(T);
    end.

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