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.