📄 mymail.pas
字号:
repeat
nPos0 := Pos('=?', Result);
Found := False;
if nPos0 > 0 then
begin
nPos1 := Pos('?', Copy(Result, nPos0+2, Length(Result)))+nPos0+1;
nPos2 := Pos('?=', Copy(Result, nPos1+1, Length(Result)))+nPos1;
nPos3 := Pos('?', Copy(Result, nPos2+1, Length(Result)))+nPos2;
if nPos3 > nPos2 then
begin
if Length(Result) > nPos3 then
begin
if Result[nPos3+1] = '=' then
begin
nPos2 := nPos3;
end;
end;
end;
if (nPos1 > nPos0) and (nPos2 > nPos1) then
begin
Texto := Copy(Result, nPos1+1, nPos2-nPos1-1);
if (Length(Texto) >= 2) and (Texto[2] = '?') and (UpCase(Texto[1]) in ['B', 'Q', 'U']) then
begin
Encoding := UpCase(Texto[1]);
end
else
begin
Encoding := 'Q';
end;
Texto := Copy(Texto, 3, Length(Texto)-2);
case Encoding of
'B':
begin
GetMem(Buffer, Length(Texto));
Size := DecodeLineBASE64(Texto, Buffer);
Buffer[Size] := #0;
Texto := String(Buffer);
end;
'Q':
begin
while Pos('_', Texto) > 0 do
Texto[Pos('_', Texto)] := #32;
Texto := DecodeQuotedPrintable(Texto);
end;
'U':
begin
GetMem(Buffer, Length(Texto));
Size := DecodeLineUUCODE(Texto, Buffer);
Buffer[Size] := #0;
Texto := String(Buffer);
end;
end;
Result := Copy(Result, 1, nPos0-1)+Texto+Copy(Result,nPos2+2,Length(Result));
Found := True;
end;
end;
until not Found;
end;
// Encode an ISO8859-1 encoded line e.g. =?iso-8859-1?x?xxxxxx=?=
function EncodeLine7Bit(Texto, Charset: String): String;
var
Loop: Integer;
Encode: Boolean;
begin
Encode := False;
for Loop := 1 to Length(Texto) do
if (Ord(Texto[Loop]) > 127) or (Ord(Texto[Loop]) < 32) then
begin
Encode := True;
Break;
end;
if Encode then
Result := '=?'+Charset+'?Q?'+EncodeQuotedPrintable(Texto, True)+'?='
else
Result := Texto;
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))+nLastPos
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;
// Encode a string in quoted-printable format
function EncodeQuotedPrintable(Texto: String; HeaderLine: Boolean): String;
var
nPos: Integer;
LineLen: Integer;
begin
Result := '';
LineLen := 0;
for nPos := 1 to Length(Texto) do
begin
if (Texto[nPos] > #127) or
(Texto[nPos] = '=') or
((Texto[nPos] <= #32) and HeaderLine) or
((Texto[nPos] = '"') and HeaderLine) then
begin
Result := Result + '=' + PadL(Format('%2x', [Ord(Texto[nPos])]), 2, '0');
Inc(LineLen, 3);
end
else
begin
Result := Result + Texto[nPos];
Inc(LineLen);
end;
if Texto[nPos] = #13 then
LineLen := 0;
if (LineLen >= 70) and (not HeaderLine) then
begin
Result := Result + '='#13#10;
LineLen := 0;
end;
end;
end;
// Decode an UUCODE encoded line
function DecodeLineUUCODE(const Buffer: String; Decoded: PChar): Integer;
const
CHARS_PER_LINE = 45;
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 an UUCODE text
function DecodeUUCODE(Encoded: PChar; Decoded: TMemoryStream): Boolean;
var
nTL, nPos, nLen: Integer;
Line: PChar;
LineDec: array[0..79] of Char;
LineLen: Integer;
DataEnd: Boolean;
begin
Decoded.Clear;
DataEnd := False;
nPos := -1;
nTL := StrLen(Encoded);
DataLinePChar(Encoded, nTL, nPos, nLen, Line, DataEnd);
while not DataEnd do
begin
if nLen > 0 then
begin
LineLen := DecodeLineUUCODE(String(Line), LineDec);
if LineLen > 0 then
Decoded.Write(LineDec[0], LineLen);
end;
DataLinePChar(Encoded, nTL, nPos, nLen, Line, DataEnd);
end;
Result := True;
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;
// Padronize header labels; remove double spaces, decode quoted text, lower the cases, indentify mail addresses
function NormalizeLabel(Texto: String): String;
const
EncLabels: String = _C_T+':'+_C_TE+':'+_C_D+':';
var
Quote: Boolean;
Quoted: String;
Loop: Integer;
lLabel: Boolean;
sLabel: String;
Value: String;
begin
Quote := False;
lLabel := True;
Value := '';
sLabel := '';
for Loop := 1 to Length(Texto) do
begin
if (Texto[Loop] = '"') and (not lLabel) then
begin
Quote := not Quote;
if Quote then
begin
Quoted := '';
end
else
begin
Value := Value + Quoted;
end;
end;
if not Quote then
begin
if lLabel then
begin
if (sLabel = '') or (sLabel[Length(sLabel)] = '-') then
sLabel := sLabel + UpCase(Texto[Loop])
else
if (Copy(sLabel, Length(sLabel)-1, 2) = '-I') and (UpCase(Texto[Loop]) = 'D') and
(Loop < Length(Texto)) and (Texto[Loop+1] = ':') then
sLabel := sLabel + 'D'
else
sLabel := sLabel + LowerCase(Texto[Loop]);
if Texto[Loop] = ':' then
begin
lLabel := False;
Value := '';
end;
end
else
begin
if Texto[Loop] = #32 then
begin
Value := TrimRightSpace(Value) + #32;
end
else
begin
if (not lLabel) and (Pos(sLabel, EncLabels) > 0) then
Value := Value + LowerCase(Texto[Loop]);
if (not lLabel) and (Pos(sLabel, EncLabels) = 0) then
Value := Value + Texto[Loop];
end;
end;
end
else
begin
Quoted := Quoted + Texto[Loop];
end;
end;
Result := TrimSpace(sLabel)+' '+TrimSpace(Value);
end;
// Return the value of a label; e.g. Label: value
function LabelValue(cLabel: String): String;
var
Loop: Integer;
Quote: Boolean;
Value: Boolean;
Ins: Boolean;
begin
Quote := False;
Value := False;
Result := '';
for Loop := 1 to Length(cLabel) do
begin
Ins := True;
if cLabel[Loop] = '"' then
begin
Quote := not Quote;
Ins := False;
end;
if not Quote then
begin
if (cLabel[Loop] = ':') and (not Value) then
begin
Value := True;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -