⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mimedec.pas

📁 BaiduMp3 search baidu mp3
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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 + -