mimedec.pas

BaiduMp3 search baidu mp3

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TMimeDecode.UUProcessLine(FCurrentData: PChar): Boolean;
var
    S           : String;
    out1        : String;
    count       : Integer;
    bp          : PChar;
    chName      : String;
    I, C        : Integer;
begin
    Result := TRUE;
    S := StrPas(FCurrentData); { AS }
    if Trim(S) = '' then begin
        Result := FALSE;
        Exit;
    end;

    if (not FUUProcessFlag) and UUSectionBegin(S, chName) then begin { AS }
        if chName <> '' then                                         { AS }
            cUUFilename := chName;                                   { AS }
        out1 := LowerCase(S);
        if (Pos('--', out1) > 0) and (Pos('cut here', out1) > 0) then
            Exit;
        FUUProcessFlag := TRUE;
        FProcessFlagYBegin := false;
        TriggerInlineDecodeBegin(cUUFilename);
        Exit;
    end;
    { AS: Handle YEnc }
    if (not FUUProcessFlag) and (Copy(S, 1, 8) = '=ybegin ') then begin
        { Line format : "=ybegin line=128 size=XXXX name=YYYY"; }
        ParseYBegin(S);
        FUUProcessFlag     := TRUE;
        FProcessFlagYBegin := TRUE;
        TriggerInlineDecodeBegin(cUUFilename);
        Exit;
    end;

    if not FUUProcessFlag then begin
        Result := FALSE;
        Exit;
    end;

    if CompareText(Copy(S, 1, 3), 'end') = 0 then begin
        out1 := LowerCase(S);
        if (Pos('--', out1) > 0) and (Pos('cut here', out1) > 0) then
            Exit;
        FUUProcessFlag := FALSE;
        { I also use the filename here in case the client prefer to save   }
        { data to a stream and save to a file when the decoding is complete }
        TriggerInlineDecodeEnd(cUUFileName);
        cUUFilename := '';
        Exit;
    end;

    { AS: Handle YEnc }
    if CompareText(Copy(S, 1, 6), '=yend ') = 0 then begin
        FUUProcessFlag := FALSE;
        FProcessFlagYBegin := false;
        { I also use the filename here in case the client prefer to save   }
        { data to a stream and save to a file when the decoding is complete }
        TriggerInlineDecodeEnd(cUUFilename);
        cUUFilename := '';
        Exit;
    end;

    if CompareText(Copy(S, 1, 7), '=ypart ') = 0 then begin
        { The message is in several parts. Something to do ? }
        Exit;
    end;

    if FInlineDecodeLine or Assigned(FOnInlineDecodeLine) then begin
        { decode the line }
        { AS: Handle YEnc }
        if not FProcessFlagYBegin then begin
            Count := UUDec(S[1]);
            out1  := ''; { AS: 25/11/2002 }

           {AS : new method to ignore wrongly coded lines }
           I := Length(S) - 1;
           if (Count > 0) and (Length(S) > 1) then begin
               bp := @S[2];
               repeat
                   UUOutDec(bp, Count, out1);
                   if Count >= 3 then begin
                       Count := Count - 3;
                       I     := I - 4;
                   end
                   else begin
                       if I >= 4 then
                           I := I - 4
                       else if I > 0 then
                           I := 0;
                       Count := 0;
                   end;
                   bp    := bp + 4;
               until Count <= 0;
               if I <> 0 then
                   out1 := '';
           end;
{ Old code
           if (Count > 0) and (Length(S) > 1) then begin
               bp := @S[2];
               repeat
                   UUOutDec(bp, Count, out1);
                   Count := Count - 3;
                   bp    := bp + 4;
               until Count <= 0;
           end;
}
        end
        else begin { AS: Handle YEnc }
            out1 := '';
            I    := 0;
            bp   := FCurrentData;
            while (I < FSizeBlocY) and (bp[I] <> #0) do begin
                if bp[I] = '=' then begin
                    C := Byte(bp[I + 1]) - 64 - 42;
                    Inc(I);
                end
                else
                    C := byte(bp[I]) - 42;
                if C < 0 then
                    C := C + 256;
                out1 := out1 + Char(C);
                Inc(I);
            end;
        end;

        {$IFDEF VER80}
        if Length(Out1) = 0 then
            FOnInlineDecodeLine(Self, nil, 0)
        else
            FOnInlineDecodeLine(Self, @Out1[1], Length(Out1));
        {$ELSE}
        TriggerInlineDecodeLine(PChar(Out1), Length(Out1));
        {$ENDIF}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
    Result := PValue;
    { AS: Add #1 which is used to handle header lines }
    while Result^ in [' ', #9, #10, #13, #1] do
        Inc(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetValue(Src : PChar; var Dst : String; var Delim : Char) : PChar;
begin
    Result := StpBlk(Src);
    Dst    := '';
    Delim  := Result^;
    if Delim = '"' then begin
        Inc(Result);
        while TRUE do begin
            Delim  := Result^;
            if Delim = #0 then
                break;
            if Delim = '"' then begin
                Inc(Result);
                Delim := Result^;
                break;
            end;
            Dst := Dst + Delim;
            Inc(Result);
        end;
    end
    else begin
        while TRUE do begin
            Delim  := Result^;
            if Delim in [':', ' ', ';', '=', #9, #0] then
                break;
            Dst := Dst + LowerCase(Result^);
            Inc(Result);
        end;
    end;
    if Delim in [' ', #9] then begin
        Result := stpblk(Result);
        if Result^ in [':', ';', '=', #9] then
            Inc(Result);
    end
    else if Delim <> #0 then
        Inc(Result);
    Result := stpblk(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetToken(Src : PChar; var Dst : String; var Delim : Char) : PChar;
begin
    Result := StpBlk(Src);
    Dst    := '';
    while TRUE do begin
        Delim := Result^;
        if Delim in [':', ' ', ';', '=', #9, #0] then
                break;
        Dst := Dst + LowerCase(Result^);
        Inc(Result);
    end;
    if Delim in [' ', #9] then begin
        Result := stpblk(Result);
        if Result^ in [':', ';', '=', #9] then begin
            {AS: Take delimiter after space }
            Delim := Result^;
            Inc(Result);
        end;
    end
    else if Delim <> #0 then
        Inc(Result);
    Result := stpblk(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Same as GetToken, but take be aware of comments                           }
function GetTokenEx(Src : PChar; var Dst : String; var Delim : Char) : PChar;
var
    Comment: Integer;
begin
    Result  := StpBlk(Src);
    Dst     := '';
    Comment := 0;
    while TRUE do begin
        Delim := Result^;
        if Delim = #0 then
            break;
        if Delim = '(' then begin
            Inc(comment); { Comments can be nested }
            Inc(Result);
            Continue;
        end
        else if Delim = ')' then begin
            Dec(Comment);
            Inc(Result);
            Continue;
        end
        else if (Comment = 0) and (Delim in [':', ' ', ';', '=', #9]) then
            break;
        Dst := Dst + LowerCase(Result^);
        Inc(Result);
    end;
    if Delim in [' ', #9] then begin
        Result := stpblk(Result);
        if Result^ in [':', ';', '=', #9] then begin
            Delim := Result^;
            Inc(Result);
        end;
    end
    else if Delim <> #0 then
    Inc(Result);
    Result := StpBlk(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetQuoted(Src : PChar; var Dst : String) : PChar;
var
    Quote : Char;
begin
    Result := StpBlk(Src);
    Dst    := '';
    Quote  := Result^;
    if Quote <> #34 then begin  { ##ERIC }
        Dst := StrPas(Src);     { ##ERIC }
        Exit;                   { ##ERIC }
    end;                        { ##ERIC }

    Inc(Result);
    while (Result^ <> #0) and (Result^ <> Quote) do begin
        Dst := Dst + Result^;
        Inc(Result);
    end;
    Result := stpblk(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.PreparePart;
begin
    FPartOpened := FALSE;
    TriggerPartEnd;
    PrepareNextPart;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessWaitBoundary;       { ##ERIC }
var
    T : Integer;
    S : String;
begin
    S := LowerCase(StrPas(FCurrentData));
    if S = FBoundary then begin
        PreparePart;
        Exit;
    end
    else begin

    { are we in the embedded boundaries ? }
    for T := 0 to FEmbeddedBoundary.Count - 1 do begin
        if FEmbeddedBoundary[T] = S then begin
            cIsEmbedded := true;
            PreparePart;
            Exit;
        end;
    end;

   { if not in primary boundary or embedded boundaries, then process it.}
   ProcessDecodedLine(FCurrentData, StrLen(FCurrentData));
   end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessMessageLine;
begin
    Inc(FLineNum);
    if FLineNum = 1 then
        TriggerPartBegin;
    if FEncoding = 'base64' then
        ProcessLineBase64
    else if FEncoding = 'quoted-printable' then
        ProcessLineQuotedPrintable
    else if FEncoding = 'x-uuencode' then
        ProcessLineUUDecode                       { ##ERIC }
    else begin {tap}
        ProcessDecodedLine(FCurrentData, StrLen(FCurrentData));
        ProcessDecodedLine(PChar(#13#10), 2); {tap: add \r\n to other encodings}
    end; {tap}
end;