Delphi的Decode解码函数-蒲公英云

用法:

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;

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

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

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