mimedec.pas

BaiduMp3 search baidu mp3

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.PrepareNextPart;
begin
    FPartEncoding            := '';
    FPartContentType         := '';
    FPartDisposition         := '';
    FPartContentID           := '';
    FPartName                := '';
    FPartFileName            := '';
    FPartFormat              := '';
    FHeaderFlag              := TRUE;  { We begin by a header }
    FLineNum                 := 0;
    FUUProcessFlag           := FALSE;
    FProcessFlagYBegin       := FALSE;  { AS: Handle YEnc }
    FPartHeaderBeginSignaled := FALSE;
    FNext                    := ProcessPartHeaderLine;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessPartLine; { ##ERIC }
var
    Len : Integer;
    t   : Integer;
    s   : String;            { ##ERIC }
begin
    { Check if end of part (boundary line found) }
    if (FCurrentData <> nil) and (FCurrentData^ <> #0) then begin
        s := LowerCase(StrPas(FCurrentData));
        if (s = FBoundary) then begin
                PreparePart;
                exit;
        end
        else if (s = (FBoundary + '--')) then begin
            FEndOfMime := TRUE;
            PreparePart;
            exit;
        end
        else begin
            for t := 0 to FEmbeddedBoundary.Count - 1 do begin
                if (s = FEmbeddedBoundary[t]) or
                   (s = (FEmbeddedBoundary[t] + '--')) then begin
                    { we now have to wait for the next part }
                    PreparePart;
                    exit;
                end
            end;
        end;
    end;

    if not FPartOpened then begin
        FPartOpened := TRUE;
        TriggerPartBegin;
    end;

    if FPartEncoding = 'base64' then
        ProcessLineBase64
    else if FPartEncoding = 'quoted-printable' then
        ProcessLineQuotedPrintable
    else if FPartEncoding = 'x-uuencode' then   { ##ERIC }
        ProcessLineUUDecode                     { ##ERIC }
    else begin
        if FCurrentData = nil then
            Len := 0
        else
            Len := StrLen(FCurrentData);
            ProcessDecodedLine(FCurrentData, Len);
        ProcessDecodedLine(PChar(#13#10), 2); {tap: add \r\n to other encodings}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessPartHeaderLine;
var
    p       : PChar;
    Delim   : Char;
    Token   : String;
    KeyWord : String;
    Value   : String;
{   Value1  : String; }
begin
    if (FCurrentData = nil) or (FCurrentData^ = #0) then begin
        { End of part header }
        if not FPartHeaderBeginSignaled then begin
            Inc(FPartNumber);
            TriggerPartHeaderBegin;
        end;
        TriggerPartHeaderEnd;
        FHeaderFlag        := FALSE;  { Remember we are no more in a header }
        FLineNum           := 0;
        FUUProcessFlag     := FALSE;
        FProcessFlagYBegin := FALSE;
        FNext              := ProcessPartLine;
        Exit;
    end;

    Inc(FLineNum);
    if FLineNum = 1 then begin
        Inc(FPartNumber);
        FPartHeaderBeginSignaled := TRUE;
        TriggerPartHeaderBegin;
{       FEmbeddedBoundary.clear; }
    end;

    { A header line can't begin with a space nor tab char. If we got that }
    { then we consider the header as begin finished and process line      }
    if FHeaderFlag and (FCurrentData[0] in [' ', #9]) then begin
        TriggerPartHeaderEnd;
        FHeaderFlag        := FALSE;
        FLineNum           := 0;
        FUUProcessFlag     := FALSE;
        FProcessFlagYBegin := FALSE;
        FNext              := ProcessPartLine;
        ProcessPartLine;
        Exit;
    end;

    p := GetToken(FCurrentData, KeyWord, Delim);
    if KeyWord = 'content-type' then begin
        p := GetTokenEx(p, FPartContentType, Delim);
        while Delim = ';' do begin
            p := GetToken(p, Token, Delim);
            if Delim = '=' then begin
                p := GetValue(p, Value, Delim);
                if Token = 'name' then
                    FPartName     := Value
                else if Token = 'charset' then
                    FPartCharset := Value
                else if Token = 'format' then
                    FPartFormat := Value
                else if Token = 'boundary' then begin
                    { we have an embedded boundary }
                    FEmbeddedBoundary.Add('--' + LowerCase(Value));
{                   Value := Value + #0;  }{ NUL terminate string for Delphi 1 }
{                   GetQuoted(@Value[1], Value1);}                    { ##ERIC }
{                   FEmbeddedBoundary.Add('--' + LowerCase(Value1));} { ##ERIC }
                end;                                                  { ##ERIC }
            end;
        end;
    end
    else if KeyWord = 'content-transfer-encoding' then begin
        GetTokenEx(p, FPartEncoding, Delim);
    end
    else if KeyWord = 'content-id' then begin
        FPartContentID := StrPas(p);
        if (Length(FPartContentID) >= 2) and
           (FPartContentID[1] = '<') and
           (FPartContentID[Length(FPartContentID)] = '>') then
               FPartContentID := Copy(FPartContentID, 2, Length(FPartContentID) - 2);
    end
    else if KeyWord = 'content-disposition' then begin
        p := GetTokenEx(p, FPartDisposition, Delim);
        while Delim = ';' do begin
            p := GetToken(p, Token, Delim);
            if Delim = '=' then begin
                p := GetQuoted(p, Value);
                if Token = 'filename' then
                    FPartFileName := Value;
            end;
        end;
    end
    else if (KeyWord = 'content-description') and (FPartFileName = '') then begin
        Delim:= ';';
        while Delim = ';' do begin
            p := GetToken(p, Token, Delim);
            if Delim = '=' then begin
                p := GetQuoted(p, Value);
                if Token = 'filename' then
                    FPartFileName := Value;
            end;
        end;
    end;

    TriggerPartHeaderLine;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessHeaderLine;
var
    p     : PChar;
    pVal  : PChar;
    Delim : Char;
    Token : String;
    Value : String;
begin
    if (FCurrentData = nil) or (FCurrentData^ = #0) then begin
        FHeaderFlag        := FALSE;  { We are no more in a header }
        TriggerHeaderEnd;
        FLineNum           := 0;
        FUUProcessFlag     := FALSE;
        FProcessFlagYBegin := FALSE;
        if FBoundary = '' then
            FNext := ProcessMessageLine
        else begin
            TriggerPartBegin;
            FNext := ProcessWaitBoundary;
        end;
        Exit;
    end;

    Inc(FLineNum);
    if FLineNum = 1 then
        TriggerHeaderBegin;

    p    := GetToken(FCurrentData, Token, Delim);
    pVal := StpBlk(p);
    if Delim = ':' then begin
        p := GetTokenEx(p, Value, Delim);
        if Token = 'from' then
            FFrom := GetHeaderValue(pVal)
        else if Token = 'to' then
            FDest := GetHeaderValue(pVal)
        else if Token = 'subject' then
            FSubject := GetHeaderValue(pVal)
        else if Token = 'return-path' then begin
            FReturnPath := GetHeaderValue(pVal);
            if (Length(FReturnPath) >= 2) and
               (FReturnPath[1] = '<') and
               (FReturnPath[Length(FReturnPath)] = '>') then
                FReturnPath := Copy(FReturnPath, 2, Length(FReturnPath) - 2);
        end
        else if Token = 'date' then
            FDate := GetHeaderValue(pVal)
        else if Token = 'mime-version' then
            FMimeVersion := GetHeaderValue(pVal)
        else if Token = 'content-type' then begin
            FContentType := Value;
            while Delim = ';' do begin
                p := GetToken(p, Token, Delim);
                if Delim = '=' then begin
                    p := GetValue(p, Value, Delim);
                    if Token = 'name' then
                        FHeaderName := Value
                    else if Token = 'charset' then
                        FCharset := Value
                    else if Token = 'format' then
                        FFormat := Value
                    else if Token = 'boundary' then begin
                        FBoundary := '--' + LowerCase(Value);
                        FIsMultipart := TRUE;
                    end;             { ##ERIC }
                end;
            end;
        end
        else if Token = 'content-transfer-encoding' then
            FEncoding := Value
        else if Token = 'content-disposition' then begin
            FDisposition := Value;
            while Delim = ';' do begin
                p := GetToken(p, Token, Delim);
                if Delim = '=' then begin
                    p := GetValue(p, Value, Delim);
{                   p := GetQuoted(p, Value);}
                    if Token = 'filename' then
                        FFileName := Value;
                end
            end
        end
    end;
    FLengthHeader := FLengthHeader + Integer(StrLen(FCurrentData)) + 2;
    FHeaderLines.Add(GetHeaderValue(FCurrentData));
    TriggerHeaderLine;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.MessageEnd;
begin
    if (FBoundary = '') or FPartOpened then
        TriggerPartEnd;
    TriggerMessageEnd;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.MessageBegin;
begin
    FApplicationType         := '';
    FBoundary                := '';
    FCharset                 := '';
    FContentType             := '';
    FCurrentData             := nil;
    FDate                    := '';
    FDest                    := '';
    FDisposition             := '';
    FEncoding                := '';
    FEndOfMime               := FALSE;
    FFileName                := '';
    FFormat                  := '';
    FFrom                    := '';
    FHeaderFlag              := TRUE;
    FHeaderName              := '';
    FIsMultiPart             := FALSE;
    FLineNum                 := 0;
    FMimeVersion             := '';
    FNext                    := ProcessHeaderLine;
    FPartContentType         := '';
    FPartCharset             := '';
    FPartContentID           := '';
    FPartDisposition         := '';
    FPartEncoding            := '';
    FPartFileName            := '';
    FPartFormat              := '';
    FPartHeaderBeginSignaled := FALSE;
    FPartName                := '';
    FPartNumber              := 0;
    FPartOpened              := FALSE;
    FReturnPath              := '';
    FSubject                 := '';
    FUUProcessFlag           := FALSE;
    FProcessFlagYBegin       := FALSE;
    FHeaderLines.Clear;
    FEmbeddedBoundary.Clear;
    FLengthHeader := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.DecodeFile(FileName : String);
var
    aStream  : TStream;
begin
    aStream  := TFileStream.Create(FileName, fmOpenRead);
    try
        DecodeStream(aStream);
    finally
        aStream.Destroy;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.DecodeStream(aStream : TSt