mimedec.pas

包含常用Internet协议TCP,UDP、HTTP、FTP、Telnet等

        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;
begin
    Result := TRUE;
    if FCurrentData^ = #0 then begin
        result := false;
        Exit;
    end;
    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;
        if Assigned(FInlineBegin) then
            FInlineBegin(Self, cUUFilename);
        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; 
        if Assigned(FInlineEnd) 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 }
            FInlineEnd(self, cUUfilename);
        cUUFilename:='';
        Exit;
    end;
    if cUUFilename = '' then begin
        Result := FALSE;
        Exit;
    end;
    if Assigned(FInlineLine) then
        FInlineLine(Self, FCurrentData);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
    Result := PValue;
    while Result^ in [' ', #9, #10, #13] do
        Inc(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 <> #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 <> #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^ <> 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
        ProcessDecodedLine(FCurrentData, StrLen(FCurrentData));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.PrepareNextPart;
begin
    FPartEncoding            := '';
    FPartContentType         := '';
    FPartDisposition         := '';
    FPartName                := '';
    FPartFileName            := '';
    FHeaderFlag              := TRUE;  { We begin by a header }
    FLineNum                 := 0;
    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) or
           (s = (FBoundary + '--')) then begin
            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);
    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;
        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