📄 mimedec.pas
字号:
property OnHeaderBegin : TNotifyEvent read FOnHeaderBegin
write FOnHeaderBegin;
property OnHeaderLine : TNotifyEvent read FOnHeaderLine
write FOnHeaderLine;
property OnHeaderEnd : TNotifyEvent read FOnHeaderEnd
write FOnHeaderEnd;
property OnPartHeaderBegin : TNotifyEvent read FOnPartHeaderBegin
write FOnPartHeaderBegin;
property OnPartHeaderLine : TNotifyEvent read FOnPartHeaderLine
write FOnPartHeaderLine;
property OnPartHeaderEnd : TNotifyEvent read FOnPartHeaderEnd
write FOnPartHeaderEnd;
property OnPartBegin : TNotifyEvent read FOnPartBegin
write FOnPartBegin;
property OnPartLine : TMimeDecodePartLine read FOnPartLine
write FOnPartLine;
property OnPartEnd : TNotifyEvent read FOnPartEnd
write FOnPartEnd;
property OnInlineDecodeBegin : TInlineDecodeBegin
read FInlineBegin
write FInlineBegin;
property OnInlineDecodeLine : TInlineDecodeLine
read FInlineLine
write FInlineLine;
property OnInlineDecodeEnd : TInlineDecodeEnd
read FInlineEnd
write FInlineEnd;
end;
procedure Register;
implementation
type
TLookup = array [0..127] of Byte;
const
Base64In: TLookup = (
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54, 55,
56, 57, 58, 59, 60, 61, 255, 255, 255, 64, 255, 255, 255,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
255, 255, 255, 255, 255, 255, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 255, 255, 255, 255, 255
);
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
RegisterComponents('FPiette', [TMimeDecode]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function HexConv(Ch : Char) : Integer;
begin
if Ch in ['0'..'9'] then
Result := Ord(Ch) - Ord('0')
else
Result := (Ord(Ch) and 15) + 9;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerHeaderBegin;
begin
if Assigned(FOnHeaderBegin) then
FOnHeaderBegin(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerHeaderLine;
begin
if Assigned(FOnHeaderLine) then
FOnHeaderLine(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerHeaderEnd;
begin
if Assigned(FOnHeaderEnd) then
FOnHeaderEnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartHeaderBegin;
begin
if Assigned(FOnPartHeaderBegin) then
FOnPartHeaderBegin(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartHeaderLine;
begin
if Assigned(FOnPartHeaderLine) then
FOnPartHeaderLine(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartHeaderEnd;
begin
if Assigned(FOnPartHeaderEnd) then
FOnPartHeaderEnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartBegin;
begin
if Assigned(FOnPartBegin) then
FOnPartBegin(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartLine(Data : PChar; DataLen : Integer);
begin
if Assigned(FOnPartLine) then
FOnPartLine(Self, Data, DataLen);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartEnd;
begin
if Assigned(FOnPartEnd) then
FOnPartEnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessDecodedLine(Line : PChar; Len : Integer);
begin
if Len > 0 then
if uuprocessline(line) then
Exit;
TriggerPartLine(Line, Len);
{ Write decoded characters to the destination stream }
if Assigned(FDestStream) and (Len > 0) then
FDestStream.WriteBuffer(Line^, Len);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This works if charset="iso-8859-1" ! }
procedure TMimeDecode.ProcessLineQuotedPrintable;
var
SourceIndex : Integer;
DecodedIndex : Integer;
Ch : Char;
Code : Integer;
begin
SourceIndex := 0;
DecodedIndex := 0;
if (FCurrentData <> nil) and (FCurrentData^ <> #0) then begin
while TRUE do begin
Ch := FCurrentData[SourceIndex];
if Ch = #0 then begin
{ Nov 25, 1999: Ken Petersen told me to insert CRLF }
FCurrentData[DecodedIndex] := #13;
Inc(DecodedIndex);
FCurrentData[DecodedIndex] := #10;
Inc(DecodedIndex);
break;
end;
if Ch <> '=' then begin
FCurrentData[DecodedIndex] := Ch;
Inc(SourceIndex);
Inc(DecodedIndex);
end
else begin
Inc(SourceIndex);
Ch := FCurrentData[SourceIndex];
if Ch <> #0 then begin
Code := HexConv(Ch);
Inc(SourceIndex);
Ch := FCurrentData[SourceIndex];
if Ch <> #0 then begin
Code := (Code shl 4) + HexConv(Ch);
Inc(SourceIndex);
end;
FCurrentData[DecodedIndex] := Chr(Code);
Inc(DecodedIndex);
end;
end;
end;
FCurrentData[DecodedIndex] := #0;
end;
ProcessDecodedLine(FCurrentData, DecodedIndex);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessLineBase64;
var
ByteCount : Integer;
SourceIndex : Integer;
DataOut : array[0..2] of Byte;
DataIn0 : Byte;
DataIn1 : Byte;
DataIn2 : Byte;
DataIn3 : Byte;
DecodedIndex : Integer;
begin
DecodedIndex := 0;
{ Skip white spaces }
SourceIndex := 0;
while (FCurrentData[SourceIndex] <> #0) and
(FCurrentData[SourceIndex] = ' ') do
Inc(SourceIndex);
{ Decode until end of line. Replace coded chars by decoded ones }
while (FCurrentData[SourceIndex] <> #0) and
(FCurrentData[SourceIndex] <> ' ') do begin
DataIn0 := Base64In[Byte(FCurrentData[SourceIndex + 0])];
DataIn1 := Base64In[Byte(FCurrentData[SourceIndex + 1])];
DataIn2 := Base64In[Byte(FCurrentData[SourceIndex + 2])];
DataIn3 := Base64In[Byte(FCurrentData[SourceIndex + 3])];
DataOut[0] := (DataIn0 and $3F) shl 2 + (DataIn1 and $30) shr 4;
if DataIn2 <> $40 then begin
DataOut[1] := (DataIn1 and $0F) shl 4 + (DataIn2 and $3C) shr 2;
if DataIn3 <> $40 then begin
DataOut[2] := (DataIn2 and $03) shl 6 + (DataIn3 and $3F);
ByteCount := 3;
end
else
ByteCount := 2;
end
else
ByteCount := 1;
{ Replace coded characters (4) by decoded characters (up to 3) }
Move(DataOut, FCurrentData[DecodedIndex], ByteCount);
DecodedIndex := DecodedIndex + ByteCount;
SourceIndex := SourceIndex + 4;
end;
{ Nul terminate decoded line }
FCurrentData[DecodedIndex] := #0; { 16/02/99 }
ProcessDecodedLine(FCurrentData, DecodedIndex);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function UUDec(Sym : Char): Word;
begin
Result := (Ord(Sym) - Ord(' ')) and $3F;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure UUOutDec(buf: PChar; n: Integer; var out1 : String);
var
c1, c2, c3: Char;
begin
c1 := Chr((word(UUDec(buf[0])) SHL 2) or (word(UUDec(buf[1])) SHR 4));
c2 := Chr((word(UUDec(buf[1])) SHL 4) or (word(UUDec(buf[2])) SHR 2));
c3 := Chr((word(UUDec(buf[2])) SHL 6) or (word(UUDec(buf[3]))));
if n >= 1 then
out1 := out1 + c1;
if n >= 2 then
out1 := out1 + c2;
if n >= 3 then
out1 := out1 + c3;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessLineUUDecode; { ##ERIC }
var
count, Size : Integer;
s : String;
out1 : String;
bp : PChar;
pos1 : Integer;
begin
if FCurrentData^ = #0 then
exit;
s := StrPas(FCurrentData);
if LowerCase(copy(s, 1, 6)) = 'begin ' then begin
out1:=lowercase(s);
if (Pos('--', out1) > 0) and (Pos('cut here', out1) > 0) then
Exit;
pos1 := Pos(' ', s);
s := Copy(s, pos1 + 1, 255);
pos1 := Pos(' ', s);
s := Copy(s, pos1 + 1, 255);
cUUFilename := s;
exit;
end
else if LowerCase(Copy(s, 1, 3)) = 'end' then begin
out1 := LowerCase(s);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -