原创: Base64, Quoted-Printable 的解码与编码函数

作者: 陆岛工作室



以前写的几个 Base64 与  Quoted-Printable的解码与编码函数。贴出来给有用的朋友参考一下。

{ Quoted-Printable 解码 }
function DecodeQuotedPrintable(Str: String): String;

{ Quoted-Printable 编码 }
function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;

{ Base64 编码函数 }
function EncodeBase64(Source:string):string;

{ Base64 解码函数 }
function DecodeBase64(Source: String):string;
procedure DecodeBase64ToStream(AIn: String; ADest: TStream);

uses Axctrls, ActiveX, MSHTML;

const
   {  BASE64码表  }
  Base64CodeTable: String  =   ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/= ' ;

type
  TSpecials  =   set   of  AnsiChar;

const

  SpecialChar: TSpecials  =
  [ ' = ' ,  ' ( ' ,  ' ) ' ,  ' [ ' ,  ' ] ' ,  ' < ' ,  ' > ' ,  ' : ' ,  ' ; ' ,  ' , ' ,  ' @ ' ,  ' / ' ,  ' ? ' ,  ' \ ' ,
     ' " ' ,  ' _ ' ];
  NonAsciiChar: TSpecials  =
  [Char( 0 )..Char( 31 ), Char( 127 )..Char( 255 )];
  URLFullSpecialChar: TSpecials  =
  [ ' ; ' ,  ' / ' ,  ' ? ' ,  ' : ' ,  ' @ ' ,  ' = ' ,  ' & ' ,  ' # ' ,  ' + ' ];
  URLSpecialChar: TSpecials  =
  [#$ 00 ..#$ 20 ,  ' _ ' ,  ' < ' ,  ' > ' ,  ' " ' ,  ' % ' ,  ' { ' ,  ' } ' ,  ' | ' ,  ' \ ' ,  ' ^ ' ,  ' ~ ' ,  ' [ ' ,  ' ] ' ,
     ' ` ' , #$7F..#$FF];
  TableBase64  =
     ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/= ' ;
  TableBase64mod  =
     ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,= ' ;
  TableUU  =
     ' `!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ ' ;
  TableXX  =
     ' +-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ' ;
  ReTablebase64  =
    #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$3E  + #$ 40
     + #$ 40   + #$ 40   + #$3F  + #$ 34   + #$ 35   + #$ 36   + #$ 37   + #$ 38   + #$ 39   + #$3A  + #$3B  + #$3C
     + #$3D  + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 00   + #$ 01   + #$ 02   + #$ 03
     + #$ 04   + #$ 05   + #$ 06   + #$ 07   + #$ 08   + #$ 09   + #$0A  + #$0B  + #$0C  + #$0D  + #$0E  + #$0F
     + #$ 10   + #$ 11   + #$ 12   + #$ 13   + #$ 14   + #$ 15   + #$ 16   + #$ 17   + #$ 18   + #$ 19   + #$ 40   + #$ 40
     + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$1A  + #$1B  + #$1C  + #$1D  + #$1E  + #$1F  + #$ 20   + #$ 21
     + #$ 22   + #$ 23   + #$ 24   + #$ 25   + #$ 26   + #$ 27   + #$ 28   + #$ 29   + #$2A  + #$2B  + #$2C  + #$2D
     + #$2E  + #$2F  + #$ 30   + #$ 31   + #$ 32   + #$ 33   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40 ;
  ReTableUU  =
    #$ 01   + #$ 02   + #$ 03   + #$ 04   + #$ 05   + #$ 06   + #$ 07   + #$ 08   + #$ 09   + #$0A  + #$0B  + #$0C
     + #$0D  + #$0E  + #$0F  + #$ 10   + #$ 11   + #$ 12   + #$ 13   + #$ 14   + #$ 15   + #$ 16   + #$ 17   + #$ 18
     + #$ 19   + #$1A  + #$1B  + #$1C  + #$1D  + #$1E  + #$1F  + #$ 20   + #$ 21   + #$ 22   + #$ 23   + #$ 24
     + #$ 25   + #$ 26   + #$ 27   + #$ 28   + #$ 29   + #$2A  + #$2B  + #$2C  + #$2D  + #$2E  + #$2F  + #$ 30
     + #$ 31   + #$ 32   + #$ 33   + #$ 34   + #$ 35   + #$ 36   + #$ 37   + #$ 38   + #$ 39   + #$3A  + #$3B  + #$3C
     + #$3D  + #$3E  + #$3F  + #$ 00   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40
     + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40
     + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40 ;
  ReTableXX  =
    #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 00   + #$ 40
     + #$ 01   + #$ 40   + #$ 40   + #$ 02   + #$ 03   + #$ 04   + #$ 05   + #$ 06   + #$ 07   + #$ 08   + #$ 09   + #$0A
     + #$0B  + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$0C  + #$0D  + #$0E  + #$0F
     + #$ 10   + #$ 11   + #$ 12   + #$ 13   + #$ 14   + #$ 15   + #$ 16   + #$ 17   + #$ 18   + #$ 19   + #$1A  + #$1B
     + #$1C  + #$1D  + #$1E  + #$1F  + #$ 20   + #$ 21   + #$ 22   + #$ 23   + #$ 24   + #$ 25   + #$ 40   + #$ 40
     + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 26   + #$ 27   + #$ 28   + #$ 29   + #$2A  + #$2B  + #$2C  + #$2D
     + #$2E  + #$2F  + #$ 30   + #$ 31   + #$ 32   + #$ 33   + #$ 34   + #$ 35   + #$ 36   + #$ 37   + #$ 38   + #$ 39
     + #$3A  + #$3B  + #$3C  + #$3D  + #$3E  + #$3F  + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40   + #$ 40 ;

function  EncodeTriplet( const  Value: AnsiString; Delimiter: AnsiChar;
  Specials: TSpecials): AnsiString;
var
  n, l: Integer;
  s: AnsiString;
  c: AnsiChar;
begin
  SetLength(Result, Length(Value)  *   3 );
  l : =   1 ;
   for  n : =   1   to  Length(Value)  do
   begin
    c : =  Value[n];
     if  c  in  Specials  then
     begin
      Result[l] : =  Delimiter;
      Inc(l);
      s : =  IntToHex(Ord(c),  2 );
      Result[l] : =  s[ 1 ];
      Inc(l);
      Result[l] : =  s[ 2 ];
      Inc(l);
     end
     else
     begin
      Result[l] : =  c;
      Inc(l);
     end ;
   end ;
  Dec(l);
  SetLength(Result, l);
end ;

{ ============================================================================== }

function  EncodeQuotedPrintable( const  Value: AnsiString): AnsiString;
begin
  Result : =  EncodeTriplet(Value,  ' = ' ,  [ ' = ' ]  +  NonAsciiChar);
end ;

{  DecodeQuotedPrintable  }

function  DecodeQuotedPrintable(Str: String): String;
var
  I, O: Integer;
  S: String;
begin
  Result : =   '' ;
  I : =   1 ;
   while  I <= Length(Str)  do
   begin
    S : =  Str[I];
    Inc(I);
     if  S <> ' = '   then
     begin
      Result : =  Result  +  S
     end   else
     begin
      S : =   '' ;
       if  (I < Length(Str))  then
       begin
        S : =  Str[I];
        Inc(I);
         if  (I < Length(Str))  then
         begin
          S : =  S  +  Str[I];
           if  S <> # 13 # 10   then
           begin
            O : =  HexToInt(S);
             if  (O > 0 )  and  (O < 255 )  then
             begin
              S : =  Char(O);
              Result : =  Result  +  S;
             end ;
           end ;
          Inc(I);
         end   else
         begin
           if   not  (S[ 1 ]  in  [# 13 , # 10 ])  then
            Result : =  Result  +   ' = ' ;
          Dec(I);
         end ;
       end   else
        Result : =  Result  +   ' = ' ;
     end ;
   end ;
end ;

function  FindInTable(CSource:char):integer;
begin
 result: = Pos(string(CSource),Base64CodeTable) - 1 ;
end ;

{  EncodeBase64  }

function  EncodeBase64(Source:string):string;
var
 Times,LenSrc,i:integer;
 x1,x2,x3,x4:char;
 xt:byte;
begin
 Result : =   '' ;
 LenSrc : =  length(Source);
  if  LenSrc  mod   3   = 0   then  Times: = LenSrc  div   3
  else  Times: = LenSrc  div   3   +   1 ;
  for  i: = 0   to  times - 1   do
  begin
    if  LenSrc  >=  ( 3 + i * 3 )  then
    begin
     x1 : =  Base64CodeTable[(ord(Source[ 1 + i * 3 ]) shr  2 ) + 1 ];
     xt : =  (ord(Source[ 1 + i * 3 ]) shl  4 )  and   48 ;
     xt : =  xt  or  (ord(Source[ 2 + i * 3 ]) shr  4 );
     x2 : =  Base64CodeTable[xt + 1 ];
     xt : =  (Ord(Source[ 2 + i * 3 ]) shl  2 )  and   60 ;
     xt : =  xt  or  (ord(Source[ 3 + i * 3 ]) shr  6 );
     x3 : =  Base64CodeTable[xt + 1 ];
     xt : =  (ord(Source[ 3 + i * 3 ])  and   63 );
     x4 : =  Base64CodeTable[xt + 1 ];
    end
    else   if  LenSrc >= ( 2 + i * 3 )  then
    begin
     x1 : =  Base64CodeTable[(ord(Source[ 1 + i * 3 ]) shr  2 ) + 1 ];
     xt : =  (ord(Source[ 1 + i * 3 ]) shl  4 )  and   48 ;
     xt : =  xt  or  (ord(Source[ 2 + i * 3 ]) shr  4 );
     x2 : =  Base64CodeTable[xt + 1 ];
     xt : =  (ord(Source[ 2 + i * 3 ]) shl  2 )  and   60 ;
     x3 : =  Base64CodeTable[xt + 1 ];
     x4 : =   ' = ' ;
    end   else
    begin
     x1 : =  Base64CodeTable[(ord(Source[ 1 + i * 3 ]) shr  2 ) + 1 ];
     xt : =  (ord(Source[ 1 + i * 3 ]) shl  4 )  and   48 ;
     x2 : =  Base64CodeTable[xt + 1 ];
     x3 : =   ' = ' ;
     x4 : =   ' = ' ;
    end ;
   Result : =  Result  +  x1  +  x2  +  x3  +  x4;
  end ;
end ;

{  DecodeBase64  }

function  DecodeBase64(Source: String):string;
var
 SrcLen,Times,i:integer;
 x1,x2,x3,x4,xt:byte;
begin
 Result : =   '' ;
 Source : =  StrReplace(Source, # 13 ,  '' );
 Source : =  StrReplace(Source, # 10 ,  '' );
 SrcLen : =  Length(Source);
 Times : =  SrcLen  div   4 ;
  for  I: = 0   to  Times - 1   do
  begin
   x1 : =  FindInTable(Source[ 1 + i * 4 ]);
   x2 : =  FindInTable(Source[ 2 + i * 4 ]);
   x3 : =  FindInTable(Source[ 3 + i * 4 ]);
   x4 : =  FindInTable(Source[ 4 + i * 4 ]);
   x1 : =  x1 shl  2 ;
   xt : =  x2 shr  4 ;
   x1 : =  x1  or  xt;
   x2 : =  x2 shl  4 ;
   Result : =  result + chr(x1);
    if  x3 =   64   then  break;
   xt : = x3 shr  2 ;
   x2 : = x2  or  xt;
   x3 : = x3 shl  6 ;
   Result : =  result + chr(x2);
    if  x4 = 64   then  break;
   x3 : = x3  or  x4;
   Result : =  result + chr(x3);
  end ;
end ;

{  DecodeBase64ToStream  }

procedure  DecodeBase64ToStream(AIn: string; ADest: TStream);
var
  LOut: string;
begin
  LOut : =  DecodeBase64(AIn);
   if  LOut  <>   ''   then  
    ADest.WriteBuffer(LOut[ 1 ], Length(LOut));
end ;

转载于:https://www.cnblogs.com/iinsnian/archive/2008/06/09/1216168.html