Delphi 自带了 Base64 编解码的单元

Delphi 自带了 Base64 编解码的单元，叫 EncdDecd，这名字很拗口而且不直观，估计这是一直很少人关注和知道的原因。

这个单元提供两套四个公开函数：

对流的编解码：
procedure EncodeStream(Input, Output: TStream); // 编码
procedure DecodeStream(Input, Output: TStream); // 解码

// 对字符串的编解码：
function  EncodeString(const Input: string): string; // 编码
function  DecodeString(const Input: string): string; // 解码

这几个函数在帮助中没有。应该不算是标准库中的函数。

{********************************************************} 
{                                                        } 
{          Borland Delphi Visual Component Library       } 
{                                                        } 
{ Copyright (c) 2000, 2001 Borland Software Corporation  } 
{                                                        } 
{********************************************************} 
unit EncdDecd; 
 
{ Have string use stream encoding since that logic wraps properly } 
 
 
 
interface 
 
uses Classes; 
 
procedure EncodeStream(Input, Output: TStream); 
procedure DecodeStream(Input, Output: TStream); 
function  EncodeString(const Input: string): string; 
function  DecodeString(const Input: string): string; 
 
implementation 
 
const 
  EncodeTable: array[0..63] of Char = 
    'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + 
    'abcdefghijklmnopqrstuvwxyz' + 
    '0123456789+/'; 
 
  DecodeTable: array[#0..#127] of Integer = ( 
    Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 
    64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 
    64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63, 
    52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64, 
    64,  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 
    15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64, 
    64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
    41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64); 
 
type 
  PPacket = ^TPacket; 
  TPacket = packed record 
    case Integer of 
      0: (b0, b1, b2, b3: Byte); 
      1: (i: Integer); 
      2: (a: array[0..3] of Byte); 
      3: (c: array[0..3] of Char); 
  end; 
 
procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar); 
begin 
  OutBuf[0] := EnCodeTable[Packet.a[0] shr 2]; 
  OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f]; 
  if NumChars < 2 then 
    OutBuf[2] := '=' 
  else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f]; 
  if NumChars < 3 then 
    OutBuf[3] := '=' 
  else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f]; 
end; 
 
function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket; 
begin 
  Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or 
    (DecodeTable[InBuf[1]] shr 4); 
  NChars := 1; 
  if InBuf[2] <> '=' then 
  begin 
    Inc(NChars); 
    Result.a[1] := Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2)); 
  end; 
  if InBuf[3] <> '=' then 
  begin 
    Inc(NChars); 
    Result.a[2] := Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]); 
  end; 
end; 
 
procedure EncodeStream(Input, Output: TStream); 
type 
  PInteger = ^Integer; 
var 
  InBuf: array[0..509] of Byte; 
  OutBuf: array[0..1023] of Char; 
  BufPtr: PChar; 
  I, J, K, BytesRead: Integer; 
  Packet: TPacket; 
begin 
  K := 0; 
  repeat 
    BytesRead := Input.Read(InBuf, SizeOf(InBuf)); 
    I := 0; 
    BufPtr := OutBuf; 
    while I < BytesRead do 
    begin 
      if BytesRead - I < 3 then 
        J := BytesRead - I 
      else J := 3; 
      Packet.i := 0; 
      Packet.b0 := InBuf[I]; 
      if J > 1 then 
        Packet.b1 := InBuf[I + 1]; 
      if J > 2 then 
        Packet.b2 := InBuf[I + 2]; 
      EncodePacket(Packet, J, BufPtr); 
      Inc(I, 3); 
      Inc(BufPtr, 4); 
      Inc(K, 4); 
      if K > 75 then 
      begin 
        BufPtr[0] := #$0D; 
        BufPtr[1] := #$0A; 
        Inc(BufPtr, 2); 
        K := 0; 
      end; 
    end; 
    Output.Write(Outbuf, BufPtr - PChar(@OutBuf)); 
  until BytesRead = 0; 
end; 
 
procedure DecodeStream(Input, Output: TStream); 
var 
  InBuf: array[0..75] of Char; 
  OutBuf: array[0..60] of Byte; 
  InBufPtr, OutBufPtr: PChar; 
  I, J, K, BytesRead: Integer; 
  Packet: TPacket; 
 
  procedure SkipWhite; 
  var 
    C: Char; 
    NumRead: Integer; 
  begin 
    while True do 
    begin 
      NumRead := Input.Read(C, 1); 
      if NumRead = 1 then 
      begin 
        if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] then 
        begin 
          Input.Position := Input.Position - 1; 
          Break; 
        end; 
      end else Break; 
    end; 
  end; 
 
  function ReadInput: Integer; 
  var 
    WhiteFound, EndReached : Boolean; 
    CntRead, Idx, IdxEnd: Integer; 
  begin 
    IdxEnd:= 0; 
    repeat 
      WhiteFound := False; 
      CntRead := Input.Read(InBuf[IdxEnd], (SizeOf(InBuf)-IdxEnd)); 
      EndReached := CntRead < (SizeOf(InBuf)-IdxEnd); 
      Idx := IdxEnd; 
      IdxEnd := CntRead + IdxEnd; 
      while (Idx < IdxEnd) do 
      begin 
        if not (InBuf[Idx] in ['0'..'9','A'..'Z','a'..'z','+','/','=']) then 
        begin 
          Dec(IdxEnd); 
          if Idx < IdxEnd then 
            Move(InBuf[Idx+1], InBuf[Idx], IdxEnd-Idx); 
          WhiteFound := True; 
        end 
        else 
          Inc(Idx); 
      end; 
    until (not WhiteFound) or (EndReached); 
    Result := IdxEnd; 
  end; 
 
begin 
  repeat 
    SkipWhite; 
    { 
    BytesRead := Input.Read(InBuf, SizeOf(InBuf)); 
    } 
    BytesRead := ReadInput; 
    InBufPtr := InBuf; 
    OutBufPtr := @OutBuf; 
    I := 0; 
    while I < BytesRead do 
    begin 
      Packet := DecodePacket(InBufPtr, J); 
      K := 0; 
      while J > 0 do 
      begin 
        OutBufPtr^ := Char(Packet.a[K]); 
        Inc(OutBufPtr); 
        Dec(J); 
        Inc(K); 
      end; 
      Inc(InBufPtr, 4); 
      Inc(I, 4); 
    end; 
    Output.Write(OutBuf, OutBufPtr - PChar(@OutBuf)); 
  until BytesRead = 0; 
end; 
 
function EncodeString(const Input: string): string; 
 
var 
  InStr, OutStr: TStringStream; 
begin 
  InStr := TStringStream.Create(Input); 
  try 
    OutStr := TStringStream.Create(''); 
    try 
      EncodeStream(InStr, OutStr); 
      Result := OutStr.DataString; 
    finally 
      OutStr.Free; 
    end; 
  finally 
    InStr.Free; 
  end; 
end; 
  
function DecodeString(const Input: string): string; 
 
var 
  InStr, OutStr: TStringStream; 
begin 
  InStr := TStringStream.Create(Input); 
  try 
    OutStr := TStringStream.Create(''); 
    try 
      DecodeStream(InStr, OutStr); 
      Result := OutStr.DataString; 
    finally 
      OutStr.Free; 
    end; 
  finally 
    InStr.Free; 
  end; 
end; 

end.