mimedec.pas

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

    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;
        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;
        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 = '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;
        if FBoundary = '' then begin
            FNext := ProcessMessageLine;
        end
        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 := StrPas(pVal)
        else if Token = 'to' then
            FDest := StrPas(pVal)
        else if Token = 'subject' then
            FSubject := StrPas(pVal)
        else if Token = 'return-path' then begin
            FReturnPath := StrPas(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 := StrPas(pVal)
        else if Token = 'mime-version' then
            FMimeVersion := StrPas(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 = '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;
    FHeaderLines.Add(StrPas(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                := '';
    FFrom                    := '';
    FHeaderFlag              := TRUE;
    FHeaderName              := '';
    FIsMultiPart             := FALSE;
    FLineNum                 := 0;
    FMimeVersion             := '';
    FNext                    := ProcessHeaderLine;
    FPartContentType         := '';
    FPartCharset             := '';
    FPartContentID           := '';
    FPartDisposition         := '';
    FPartEncoding            := '';
    FPartFileName            := '';
    FPartHeaderBeginSignaled := FALSE;
    FPartName                := '';
    FPartNumber              := 0;
    FPartOpened              := FALSE;
    FReturnPath              := '';
    FSubject                 := '';
    FUUProcessFlag           := FALSE;
    FHeaderLines.Clear;
    FEmbeddedBoundary.Clear;
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 : TStream);
begin
    FBufferSize := 2048;      { Start with a reasonable FBuffer }
    GetMem(FBuffer, FBufferSize);
    try
        cUUFilename       := '';                    { ##ERIC }
        FEmbeddedBoundary := TStringList.Create;    { ##ERIC }
        try
            InternalDecodeStream(aStream);
        finally
            FEmbeddedBoundary.Free;		    { ##ERIC }
        end;
    finally
        FreeMem(FBuffer, FBufferSize);
        FBuffer     := nil;
        FBufferSize := 0;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This routine use an intelligent buffer management, trying to move data    }
{ the less possible times. The buffer is enlarged as necessary to contains  }
{ the largest line we encounter.                                            }
procedure TMimeDecode.InternalDecodeStream(aStream : TStream);
var
    RdCnt   : LongInt;
    nUsed   : Integer;
    nStart  : Integer;
    nLast   : Integer;
    nSearch : Integer;
    I, J    : Integer;
begin
    nUsed  := 0;
    nStart := 0;
    MessageBegin;
    while TRUE do begin
        nSearch := nStart + nUsed;
        RdCnt   := aStream.Read(FBuffer[nSearch],
                                FBufferSize - nUsed - nStart -
                                2);  { for next char and #0 }
        if RdCnt <= 0 then begin
            break;
        end;

        nUsed  := nUsed + RdCnt;
        nLast  := nStart + nUsed;

        { Nul terminate the FBuffer }
        FBuffer[nLast] := #0;

        { Search for terminating line feed }
        while TRUE do begin
            I := nSearch;
            while (I < nLast) and (FBuffer[I] <> #10) do
                Inc(I);
            if I >= nLast then begin
                { We did'nt find any LF in the FBuffer, need to read more ! }
                if nStart > (3 * (FBufferSize div 4)) then begin
                    { Reuse start of FBuffer because 3/4 buffer is unused   }
                    Move(FBuffer[nStart], FBuffer[0], nUsed + 1);
                    nStart := 0;
                end
                else begin
                    { Makes FBuffer larger }
                    {$IFDEF VER80}
                    FBuffer := ReallocMem(FBuffer, FBufferSize, FBufferSize + 32);
                    {$ELSE}
                    ReallocMem(FBuffer, FBufferSize + 32);
                    {$ENDIF}
                    FBufferSize := FBufferSize + 32;
                end;
                break;
            end;

            { We found a line feed, process FBuffer up to this point }
            { Remove any preceding CR                               }
            if (I > nStart) and (FBuffer[I - 1] = #13) then
                j := I - 1
            else
                J := I;

            { We found a LF, if we are processing a header, we must     }
            { have the next character to see if the line is continuated }
            if FHeaderFlag then begin
                if I >= (nLast - 1) then begin
                    { We don't have the next character in our FBuffer, }
                    { we need to read more data                        }
                    { Read a single byte at the end of the FBuffer     }
                    { We have room because we preserved it previously  }
                    RdCnt := aStream.Read(FBuffer[I + 1], 1);
                    if RdCnt > 0 then begin
                        { We have read the next char }
                        Inc(nLast);
                        Inc(nUsed);
                        FBuffer[I + 2] := #0;
                    end;
                end;

                if I < nLast then begin
                    if (not (FBuffer[nStart] in [#10, #13])) and  { 27/08/98 }
                       (FBuffer[I + 1] in [' ', #9]) then begin
                        { We have a continuation line, replace CR/LF by spaces }
                        FBuffer[I]     := ' ';
                        FBuffer[J]     := ' ';
                        FBuffer[I + 1] := ' ';
                        nSearch   := I;
                        { and search new end of line }
                        continue;
                    end;
                end;
            end;

            FBuffer[J] := #0;
            FCurrentData := FBuffer + nStart;

            FNext;
            FBuffer[J] := #10;         {tap: ERROR ? #13}
            nStart     := I + 1;
            nUsed      := nLast - nStart;
            nSearch    := nStart;
        end;
    end;
    { Process the last line }
    if nUsed > 0 then begin
        FCurrentData := FBuffer + nStart;
        FNext;
    end;

    MessageEnd;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.