用法:
uses Decode.pas
......
var
str : String;
.....
str := DecodeLine7Bit('=?gb2312?B?0MK9qCDOxNfWzsS1tS50eHQ=?=');
.....
*********************************
//Decode.pas
unit Decode;
interface
uses
SysUtils;
function DecodeLineUUCODE(const Buffer: String; Decoded: PChar): Integer;
function DecodeLineBASE64(const Buffer: String; Decoded: PChar): Integer;
function DecodeQuotedPrintable(Texto: String): String;
function DecodeLine7Bit(Texto: String): String;
implementation
// Decode an UUCODE encoded line
function DecodeLineUUCODE(const Buffer: String; Decoded: PChar): Integer;
const
CHARS_PER_LINE = 80;
Table: String = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[[\]^_';
var
A24Bits: array[0..8 * CHARS_PER_LINE] of Boolean;
i, j, k, b: Word;
LineLen, ActualLen: Byte;
function p_ByteFromTable(Ch: Char): Byte;
var
ij: Integer;
begin
ij := Pos(Ch, Table);
if (ij > 64) or (ij = 0) then begin
if Ch = #32 then
Result := 0
else
raise Exception.Create('UUCODE: Message format error');
end
else
Result := ij - 1;
end;
begin
if Buffer = '' then begin
Result := 0;
Exit;
end;
LineLen := p_ByteFromTable(Buffer[1]);
ActualLen := 4 * LineLen div 3;
FillChar(A24Bits, 8 * CHARS_PER_LINE + 1, 0);
Result := LineLen;
if ActualLen <> (4 * CHARS_PER_LINE div 3) then
ActualLen := Length(Buffer) - 1;
k := 0;
for i := 2 to ActualLen + 1 do begin
b := p_ByteFromTable(Buffer[i]);
for j := 5 downto 0 do begin
A24Bits[k] := b and (1 shl j) > 0;
Inc(k);
end;
end;
k := 0;
for i := 1 to CHARS_PER_LINE do begin
b := 0;
for j := 7 downto 0 do begin
if A24Bits[k] then b := b or (1 shl j);
Inc(k);
end;
Decoded[i-1] := Char(b);
end;
end;
// Decode a BASE64 encoded line
function DecodeLineBASE64(const Buffer: String; Decoded: PChar): Integer;
var
A1: array[1..4] of Byte;
B1: array[1..3] of Byte;
I, J: Integer;
BytePtr, RealBytes: Integer;
begin
BytePtr := 0;
Result := 0;
for J := 1 to Length(Buffer) do begin
Inc(BytePtr);
case Buffer[J] of
'A'..'Z': A1[BytePtr] := Ord(Buffer[J])-65;
'a'..'z': A1[BytePtr] := Ord(Buffer[J])-71;
'0'..'9': A1[BytePtr] := Ord(Buffer[J])+4;
'+': A1[BytePtr] := 62;
'/': A1[BytePtr] := 63;
'=': A1[BytePtr] := 64;
end;
if BytePtr = 4 then begin
BytePtr := 0;
RealBytes := 3;
if A1[1] = 64 then RealBytes:=0;
if A1[3] = 64 then begin
A1[3] := 0;
A1[4] := 0;
RealBytes := 1;
end;
if A1[4] = 64 then begin
A1[4] := 0;
RealBytes := 2;
end;
B1[1] := A1[1]*4 + (A1[2] div 16);
B1[2] := (A1[2] mod 16)*16+(A1[3] div 4);
B1[3] := (A1[3] mod 4)*64 + A1[4];
for I := 1 to RealBytes do begin
Decoded[Result+I-1] := Chr(B1[I]);
end;
Inc(Result, RealBytes);
end;
end;
end;
// Decode a quoted-printable encoded string
function DecodeQuotedPrintable(Texto: String): String;
var
nPos: Integer;
nLastPos: Integer;
lFound: Boolean;
begin
Result := Texto;
lFound := True;
nLastPos := 0;
while lFound do begin
lFound := False;
if nLastPos < Length(Result) then
nPos := Pos('=', Copy(Result, nLastPos+1, Length(Result)-nLastPos))+nLastPPos
else
nPos := 0;
if (nPos < (Length(Result)-1)) and (nPos > nLastPos) then begin
if (Result[nPos+1] in ['A'..'F', '0'..'9']) and (Result[nPos+2] in ['A'..''F', '0'..'9']) then begin
Insert(Char(StrToInt('$'+Result[nPos+1]+Result[nPos+2])), Result, nPos);
Delete(Result, nPos+1, 3);
end
else begin
if (Result[nPos+1] = #13) and (Result[nPos+2] = #10) then begin
Delete(Result, nPos, 3);
end
else begin
if (Result[nPos+1] = #10) and (Result[nPos+2] = #13) then begin
Delete(Result, nPos, 3);
end
else begin
if (Result[nPos+1] = #13) and (Result[nPos+2] <> #10) then begin
Delete(Result, nPos, 2);
end
else begin
if (Result[nPos+1] = #10) and (Result[nPos+2] <> #13) then begin
Delete(Result, nPos, 2);
end;
end;
end;
end;
end;
lFound := True;
nLastPos := nPos;
end
else begin
if nPos = Length(Result) then begin
Delete(Result, nPos, 1);
end;
end;
end;
end;
// Decode an ISO8859-1 encoded line e.g. =?iso-8859-1?x?xxxxxx=?=
function DecodeLine7Bit(Texto: String): String;
var
Buffer: PChar;
Encoding: Char;
Size: Integer;
nPos1: Integer;
nPos2: Integer;
begin
Result := Trim(Texto);
if Length(Result) < 4 then begin
Exit;
end;
if (Result[1] <> '=') or (Result[2] <> '?') then begin
Exit;
end;
nPos1 := Pos('?', Copy(Result, 3, Length(Result)-2))+2;
nPos2 := Pos('?=', Result);
if (nPos1 > 0) and (nPos2 > nPos1) then begin
Result := Copy(Result, nPos1+1, nPos2-nPos1-1);
if (Result[2] = '?') and (UpCase(Result[1]) in ['B', 'Q', 'U']) then begin
Encoding := UpCase(Result[1]);
Result := Copy(Result, 3, Length(Result)-2);
end
else begin
Encoding := 'Q';
end;
case Encoding of
'B': begin
GetMem(Buffer, Length(Result));
Size := DecodeLineBASE64(Result, Buffer);
Buffer[Size] := #0;
Result := String(Buffer);
end;
'Q': begin
while Pos('_', Result) > 0 do
Result[Pos('_', Result)] := #32;
Result := DecodeQuotedPrintable(Result);
end;
'U': begin
GetMem(Buffer, Length(Result));
Size := DecodeLineUUCODE(Result, Buffer);
Buffer[Size] := #0;
Result := String(Buffer);
end;
end;
end;
end;
