Delphi的Decode解码函数

待我称王封你为后i 2021-11-23 19:04 356阅读 0赞

用法:

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;

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;

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

lFound := True;

nLastPos := nPos;

end

else begin

if nPos = Length(Result) then begin

Delete(Result, nPos, 1);

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;

转载于:https://www.cnblogs.com/MaxWoods/archive/2010/07/01/1768960.html

Delphi的Decode解码函数

发表评论取消回复

还没有评论，来说两句吧...

相关阅读

相关 Message Decoding 信息解码UVA 213

相关 decode函数用法(oracle的decode函数用法)

相关 decode函数的用法(decode函数的用法python二进制)

相关信息解码（Message Decoding)

相关 Decode Ways（C++解码方法）

相关 DECODE()函数

相关 [Leetcode][python]Decode Ways/解码方法

相关 LeetCode 91.Decode Ways (解码方法)

相关 Delphi中处理URL编码解码

相关 Delphi的Decode解码函数