mimedec.pas

灰鸽子1.23源码,,,,,,,

        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 TMimeDecode.UUProcessLine(FCurrentData: PChar): Boolean;
var
    s           : String;
    out1        : String;
    pos1        : Integer;
    count       : Integer;
    bp          : PChar;
begin
    Result := TRUE;
{   if FCurrentData^ = #0 then begin
        result := false;
        Exit;
    end; }
    s := Trim(StrPas(FCurrentData));
    if S = '' then begin
        Result := FALSE;
        Exit;
    end;

    if (not FUUProcessFlag) and
       ((CompareText(Copy(s, 1, 9), 'begin 666') = 0) or
        (CompareText(Copy(s, 1, 9), 'begin 644') = 0)) 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;
        FUUProcessFlag := TRUE;
        if Assigned(FOnInlineDecodeBegin) then
            FOnInlineDecodeBegin(Self, 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;
        if Assigned(FOnInlineDecodeEnd) then
            { 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 }
            FOnInlineDecodeEnd(self, cUUfilename);
        cUUFilename := '';
        Exit;
    end;
{   if cUUFilename = '' then begin
        Result := FALSE;
        Exit;
    end; }

    if Assigned(FOnInlineDecodeLine) then begin
        { decode the line }
        count := UUDec(s[1]);
        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;
        {$IFDEF VER80}
        if Length(Out1) = 0 then
            FOnInlineDecodeLine(Self, nil, 0)
        else
            FOnInlineDecodeLine(Self, @Out1[1], Length(Out1));
        {$ELSE}
        FOnInlineDecodeLine(Self, PChar(Out1), Length(Out1));
        {$ENDIF}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
    Result := PValue;
    while Result^ in [' ', #9, #10, #13] 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
            Inc(Result);
    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
            Inc(Result);
    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(#13#10, 2); {tap: add \r\n to other encodings}
    end; {tap}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.PrepareNextPart;
begin
    FPartEncoding            := '';
    FPartContentType         := '';
    FPartDisposition         := '';
    FPartContentID           := '';
    FPartName                := '';
    FPartFileName            := '';
    FHeaderFlag              := TRUE;  { We begin by a header }
    FLineNum                 := 0;
    FUUProcessFlag           := FALSE;
    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(#13#10, 2); {tap: add \r\n to other encodings}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessPartHeaderLine;
var
    p       : PChar;
    Delim   : Char;
    Token   : String;
    KeyWord : String;