📄 mimedec.pas
字号:
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;
DecodedBuf : String;
const
EmptyLine : array [0..2] of char = (#13, #10, #0);
begin
if FCurrentData = nil then
Exit;
{ Allocate a buffer for decode line. At most the length of encoded data }
{ plus 2 bytes for CRLF }
SetLength(DecodedBuf, StrLen(FCurrentData) + 2);
SourceIndex := 0; { It's a PChar so index start at 0 }
DecodedIndex := 1; { It's a String, so index start at 1 }
while TRUE do begin
Ch := FCurrentData[SourceIndex];
if Ch = #0 then begin
{ End of line, add CRLF and let's go }
DecodedBuf[DecodedIndex] := #13;
Inc(DecodedIndex);
DecodedBuf[DecodedIndex] := #10;
ProcessDecodedLine(@DecodedBuf[1], DecodedIndex);
break;
end;
if Ch = '=' then begin
{ Encoded character. Next two chars should be hex code }
Inc(SourceIndex);
Ch := FCurrentData[SourceIndex];
if Ch = #0 then begin
{*** Changed 20030806 ***}
{ process without #13#10 adding }
ProcessDecodedLine(@DecodedBuf[1], DecodedIndex-1);
break;
{*** ***}
end;
Code := HexConv(Ch);
Inc(SourceIndex);
Ch := FCurrentData[SourceIndex];
if Ch = #0 then begin
{ Should not occur: code truncated, ignore }
continue;
end;
Code := (Code shl 4) + HexConv(Ch);
DecodedBuf[DecodedIndex] := Chr(Code);
end
else
DecodedBuf[DecodedIndex] := FCurrentData[SourceIndex];
Inc(SourceIndex);
Inc(DecodedIndex);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessLineBase64;
var
SourceIndex : Integer;
DataIn0 : Byte;
DataIn1 : Byte;
DataIn2 : Byte;
DataIn3 : Byte;
DecodedIndex : Integer;
Len : Integer;
begin
SourceIndex := 0;
DecodedIndex := 0;
Len := StrLen(FCurrentData);
{ Remove spaces at the end of line }
while (Len > 0) and (FCurrentData[Len - 1] in [#9, ' ']) do
Dec(Len);
{ Skip white spaces at the start of line }
while (SourceIndex < Len) and (FCurrentData[SourceIndex] in [#9, ' ']) do
Inc(SourceIndex);
{ Decode until end of line. Replace coded chars by decoded ones }
{ Protect agains malformed messages. Normally we have a length which }
{ is multiple of four. But this may be corrupted ! }
while SourceIndex < Len do begin
{ "And $7F" will clear 8th bit and avoid range error. If found in }
{ a message, it is probably a corrupted message ! }
DataIn0 := Base64In[Byte(FCurrentData[SourceIndex]) and $7F];
Inc(SourceIndex);
if SourceIndex >= Len then begin
DataIn1 := $40;
DataIn2 := $40;
DataIn3 := $40;
end
else begin
DataIn1 := Base64In[Byte(FCurrentData[SourceIndex]) and $7F];
Inc(SourceIndex);
if SourceIndex >= Len then begin
DataIn2 := $40;
DataIn3 := $40;
end
else begin
DataIn2 := Base64In[Byte(FCurrentData[SourceIndex]) and $7F];
Inc(SourceIndex);
if SourceIndex >= Len then
DataIn3 := $40
else begin
DataIn3 := Base64In[Byte(FCurrentData[SourceIndex]) and $7F];
Inc(SourceIndex);
end;
end;
end;
FCurrentData[DecodedIndex] := Char((DataIn0 and $3F) shl 2 + (DataIn1 and $30) shr 4);
if DataIn2 <> $40 then begin
FCurrentData[DecodedIndex + 1] := Char((DataIn1 and $0F) shl 4 + (DataIn2 and $3C) shr 2);
if DataIn3 <> $40 then begin
FCurrentData[DecodedIndex + 2] := Char((DataIn2 and $03) shl 6 + (DataIn3 and $3F));
Inc(DecodedIndex, 3);
end
else
Inc(DecodedIndex, 2);
end
else
Inc(DecodedIndex, 1);
end;
{ Nul terminate decoded line }
FCurrentData[DecodedIndex] := #0; { 16/02/99 }
ProcessDecodedLine(FCurrentData, DecodedIndex);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function UUDec(Sym : Char): Byte;
begin
if Sym = #0 then
Result := 0
else
Result := (Ord(Sym) - Ord(' ')) and $3F;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure UUOutDec(buf: PChar; n: Integer; var out1 : String);
begin
case n of
0: ;
1: out1 := out1 + Char((UUDec(buf[0]) SHL 2) + (UUDec(buf[1]) SHR 4));
2: out1 := out1 + Char((UUDec(buf[0]) SHL 2) + (UUDec(buf[1]) SHR 4)) +
Char((UUDec(buf[1]) SHL 4) + (UUDec(buf[2]) SHR 2));
else out1 := out1 + Char((UUDec(buf[0]) SHL 2) + (UUDec(buf[1]) SHR 4)) +
Char((UUDec(buf[1]) SHL 4) + (UUDec(buf[2]) SHR 2)) +
Char((UUDec(buf[2]) SHL 6) + (UUDec(buf[3])));
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF NEVER}
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;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ AS: Get a value from a header line. Support multiline header. }
{ When a second line is present, make sure only ONE space is taken. }
{ InternalDecodeStream has replaced CR, LF and TAB by #1 character. }
function GetHeaderValue(X : PChar) : String;
var
I, J : Integer;
begin
Result := SysUtils.StrPas(X);
I := Length(Result);
while I >= 1 do begin
if Result[I] in [#1, #10, #13] then begin
{ Make sure we preserve a single space }
J := I;
while (I >= 1) and (Result[I - 1] in [#1, #10, #13, ' ', #9]) do
Dec(i);
while (J < Length(Result)) and
(Result[J + 1] in [#1, #10, #13, ' ', #9]) do
Inc(J);
Delete(Result, I, J - I);
Result[I] := ' ';
end;
Dec(I);
end;
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);
if (Pos('--', out1) > 0) and (Pos('cut here', out1) > 0) then
Exit;
cUUFilename := '';
exit;
end;
{ if no filename defined yet, exit }
if cUUFilename = '' then
exit;
{ decode the line }
count := UUDec(s[1]);
Size := Count;
if count > 0 then begin
bp := @s[2];
repeat
UUOutDec(bp, count, out1);
count := count - 3;
bp := bp + 4;
until count <= 0;
end;
{ we're done. copy and leave }
Move(Out1[1], FCurrentData[0], Size);
ProcessDecodedLine(FCurrentData, Size);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function UUSectionBegin(
const Line : String;
var FileName : String) : Boolean;
var
I : Integer;
begin
{ A UUEncoded section begins by a line having the syntax: }
{ "begin nnn filename" with xxx being a number (unix file permission) }
{ We accept xxx with at least 2 digits. Filename is optional. }
Result := FALSE;
FileName := '';
{ AS: "begin" _must_ be in lower case ! }
if Copy(Line, 1, 6) = 'begin ' then begin
I := 7;
while I <= Length(Line) do begin
if Line[I] = ' ' then begin
Result := (I > 8);
if Result then
FileName := Copy(Line, I + 1, Length(Line));
break
end;
if not (Line[I] in ['0'..'9']) then
break;
Inc(I)
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ AS: YEnc support routine }
procedure TMimeDecode.ParseYBegin(const Ch : String);
var
I, J : Integer;
begin
{ AS: Line format is "=ybegin line=128 size=XXXX name=YYYY"; }
FSizeFileY := 0;
FSizeBlocY := 0;
I := 9;
while I < Length(Ch) do begin
if Copy(Ch, I, 5) = 'line=' then begin
I := I + 5;
while Ch[I] in ['0'..'9'] do begin
FSizeBlocY := 10 * FSizeBlocY + (Ord(Ch[I]) - Ord('0'));
Inc(I);
end;
end
else if Copy(Ch, I, 5) = 'size=' then begin
I := I + 5;
while Ch[i] in ['0'..'9'] do begin
FSizeFileY := 10 * FSizeFileY + (Ord(Ch[I]) - Ord('0'));
Inc(I);
end;
end
else if Copy(Ch, I, 5) = 'name=' then begin
I := I + 5;
J := I;
repeat
while (J <= Length(Ch)) and (Ch[J] <> ' ') do
Inc(J);
if (J >= Length(Ch)) or (Ch[J + 1] = '=') then
break
else
Inc(J);
until FALSE;
cUUFilename := Copy(Ch, I, J - I);
I := J;
end;
Inc(I);
end;
FSizeLeftY := FSizeFileY;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -