delphi 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;