mimedec.pas

互联网套件

begin
    if Assigned(FOnPartHeaderBegin) then
        FOnPartHeaderBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartHeaderLine;
begin
    if Assigned(FOnPartHeaderLine) then
        FOnPartHeaderLine(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartHeaderEnd;
begin
    if Assigned(FOnPartHeaderEnd) then
        FOnPartHeaderEnd(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartBegin;
begin
    if Assigned(FOnPartBegin) then
        FOnPartBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartLine(Data : PChar; DataLen : Integer);
begin
    if Assigned(FOnPartLine) then
        FOnPartLine(Self, Data, DataLen);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.TriggerPartEnd;
begin
    if Assigned(FOnPartEnd) then
        FOnPartEnd(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessDecodedLine(Line : PChar; Len : Integer);
begin
    if Len > 0 then
        if uuprocessline(line) then
            Exit;                       
    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;
begin
    SourceIndex  := 0;
    DecodedIndex := 0;
    if (FCurrentData <> nil) and (FCurrentData^ <> #0) then begin
        while TRUE do begin
            Ch := FCurrentData[SourceIndex];
            if Ch = #0 then
                break;
            if Ch <> '=' then begin
                FCurrentData[DecodedIndex] := Ch;
                Inc(SourceIndex);
                Inc(DecodedIndex);
            end
            else begin
                Inc(SourceIndex);
                Ch := FCurrentData[SourceIndex];
                if Ch <> #0 then begin
                    Code := HexConv(Ch);
                    Inc(SourceIndex);
                    Ch := FCurrentData[SourceIndex];
                    if Ch <> #0 then begin
                        Code := (Code shl 4) + HexConv(Ch);
                        Inc(SourceIndex);
                    end;
                    FCurrentData[DecodedIndex] := Chr(Code);
                    Inc(DecodedIndex);
                end;
            end;
        end;
        FCurrentData[DecodedIndex] := #0;
    end;

    ProcessDecodedLine(FCurrentData, DecodedIndex);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMimeDecode.ProcessLineBase64;
var
    ByteCount           : Integer;
    SourceIndex         : Integer;
    DataOut             : array[0..2] of Byte;
    DataIn0             : Byte;
    DataIn1             : Byte;
    DataIn2             : Byte;
    DataIn3             : Byte;
    DecodedIndex        : Integer;
begin
    DecodedIndex := 0;

    { Skip white spaces }
    SourceIndex := 0;
    while (FCurrentData[SourceIndex] <> #0) and
          (FCurrentData[SourceIndex] = ' ') do
        Inc(SourceIndex);

    { Decode until end of line. Replace coded chars by decoded ones }
    while (FCurrentData[SourceIndex] <> #0) and
          (FCurrentData[SourceIndex] <> ' ') do begin
        DataIn0 := Base64In[Byte(FCurrentData[SourceIndex + 0])];
        DataIn1 := Base64In[Byte(FCurrentData[SourceIndex + 1])];
        DataIn2 := Base64In[Byte(FCurrentData[SourceIndex + 2])];
        DataIn3 := Base64In[Byte(FCurrentData[SourceIndex + 3])];

        DataOut[0] := (DataIn0 and $3F) shl 2 + (DataIn1 and $30) shr 4;
        if DataIn2 <> $40 then begin
            DataOut[1] := (DataIn1 and $0F) shl 4 + (DataIn2 and $3C) shr 2;
            if DataIn3 <> $40 then begin
                DataOut[2] := (DataIn2 and $03) shl 6 + (DataIn3 and $3F);
                ByteCount := 3;
            end
            else
                ByteCount := 2;
        end
        else
            ByteCount := 1;

        { Replace coded characters (4) by decoded characters (up to 3) }
        Move(DataOut, FCurrentData[DecodedIndex], ByteCount);
        DecodedIndex := DecodedIndex + ByteCount;

        SourceIndex := SourceIndex + 4;
    end;

    { Nul terminate decoded line }
    FCurrentData[DecodedIndex] := #0; { 16/02/99 }
    ProcessDecodedLine(FCurrentData, DecodedIndex);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function UUDec(Sym : Char): Word;
begin
    Result := (Ord(Sym) - Ord(' ')) and $3F;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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 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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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                := '';