idmessageclient.pas

photo.163.com 相册下载器 多线程下载

    if attachment was XX-encoded.  Added decoding of message bodies
    encoded as base64 or quoted-printable.  Added support for nested MIME parts
    (ParentPart).  Added support for TIdText in UU and XX encoding.  Added
    missing base64 and QP support where needed.
    Rewrote/rearranged most of code.

  2001-Oct-29 Don Siders
    Modified TIdMessageClient.SendMsg to use AHeadersOnly argument.

  2001-Dec-1  Don Siders
    Save ContentDisposition in TIdMessageClient.ProcessAttachment

  2003-Sep-04 Ciaran Costelloe (CC comments)
    Commented-out IOHandler.WriteLn(''); in SendBody which used to insert a blank line
    between boundary and text attachment header, causing the attachment header to
    be parsed as part of the attachment text (the blank line is the delimiter for
    the end of the header).

  2003-Sep-11 Ciaran Costelloe (CC2 comments)
    Added support in decoding for message body (as distinct from message parts) being
    encoded.
    Added support for generating encoded message body.
}

{$I IdCompilerDefines.inc}

interface

uses
  IdIOHandlerStream,
  Classes,
  IdExplicitTLSClientServerBase,
  IdGlobal,
  IdMessage, IdTCPClient, IdHeaderList,
  IdCoderMIME,
  IdTStrings;

type
  TIdIOHandlerStreamMsg = class(TIdIOHandlerStream)
  protected
    FTerminatorWasRead: Boolean;
    FLastByteRecv: Byte;
    function ReadFromSource(
      ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer;
       ARaiseExceptionOnTimeout: Boolean): Integer; override;
  public
    constructor Create(
      AOwner: TComponent;
      AReceiveStream: TStream;
      ASendStream: TStream = nil
    ); override;  //Should this be reintroduce instead of override?
    function Readable(AMSec: integer = IdTimeoutDefault): Boolean; override;
end;

type
  TIdMessageClient = class(TIdExplicitTLSClient)
  protected
    // The length of the folded line
    FMsgLineLength: integer;
    // The string to be pre-pended to the next line
    FMsgLineFold: string;

    procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); virtual;    {do not localize}
    function  ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string; virtual;
    procedure SendBody(AMsg: TIdMessage); virtual;
    procedure SendHeader(AMsg: TIdMessage); virtual;
    procedure WriteBodyText(AMsg: TIdMessage); virtual;
    procedure WriteFoldedLine(const ALine : string);
    procedure InitComponent; override;
  public
    destructor Destroy; override;
    procedure ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False); overload;
    procedure ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False); overload;
    procedure ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False); overload;
    procedure SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False); overload; virtual;
    //
    property Capabilities;
    property MsgLineLength: integer read FMsgLineLength write FMsgLineLength;
    property MsgLineFold: string read FMsgLineFold write FMsgLineFold;
  end;

implementation

uses
  //TODO: Remove these references and make it completely pluggable. Check other spots in Indy as well
  IdCoderQuotedPrintable, IdMessageCoderQuotedPrintable, IdMessageCoderMIME,
  IdMessageCoderUUE, IdMessageCoderXXE,
  //
  IdGlobalProtocols,
  IdCoder, IdCoder3to4, IdCoderBinHex4,
  IdCoderHeader, IdMessageCoder, IdComponent, IdException, IdResourceStringsProtocols,
  IdTCPConnection,
  IdStreamVCL, IdTCPStream, IdStream,
  IdIOHandler, IdAttachmentFile,
  SysUtils, IdText, IdAttachment;

const
  SContentType = 'Content-Type'; {do not localize}
  SContentTransferEncoding = 'Content-Transfer-Encoding'; {do not localize}
  SThisIsMultiPartMessageInMIMEFormat = 'This is a multi-part message in MIME format'; {do not localize}

function  GenerateTextPartContentType(AContentType, ACharSet: String): String;
Begin
  //ContentType may contain the charset also, but CharSet overrides it if it is present...
  if Length(ACharSet) > 0 then begin
    AContentType := RemoveHeaderEntry(AContentType, 'charset');  {do not localize}
  end;
  Result := SContentType + ': '+AContentType; {do not localize}
  if Length(ACharSet) > 0 then begin
    Result := Result + ' ; charset="'+ACharSet+'"'; {do not localize}
  end
End;//

function GetLongestLine(var ALine : String; ADelim : String) : String;
var
  i, fnd, lineLen, delimLen : Integer;
begin
  i := 0;
  fnd := -1;
  delimLen := length(ADelim);
  lineLen := length(ALine);

  while i < lineLen do
  begin
    if ALine[i] = ADelim[1] then
    begin
      if Copy(ALine, i, delimLen) = ADelim then
      begin
        fnd := i;
      end;
    end;
    Inc(i);
  end;

  if fnd = -1 then
  begin
    result := '';
  end

  else begin
    result := Copy(ALine, 1, fnd - 1);
    ALine := Copy(ALine, fnd + delimLen, lineLen);
  end;
end;

procedure RemoveLastBlankLine(Body: TIdStrings);
var
  Count: Integer;
begin
  if Assigned(Body) then begin
    { Remove the last blank line. The last blank line is added again in
      TIdMessageClient.SendBody(). }
    Count := Body.Count;
    if (Count > 0) and (Body[Count - 1] = '') then begin
      Body.Delete(Count - 1);
    end;
  end;
end;

////////////////////////
// TIdIOHandlerStreamMsg
////////////////////////

constructor TIdIOHandlerStreamMsg.Create(
  //AOwner: TComponent);
  AOwner: TComponent;
  AReceiveStream: TStream;
  ASendStream: TStream = nil
  );
begin
  inherited Create(AOwner, AReceiveStream, ASendStream);
  FTerminatorWasRead := False;
  FLastByteRecv := 0;
end;

function TIdIOHandlerStreamMsg.Readable(AMSec: integer = IdTimeoutDefault): Boolean;
begin
  if not FTerminatorWasRead then begin
    Result := inherited Readable(AMSec);
    if Result then begin
      Exit;
    end;
  end;
  if ReceiveStream <> nil then begin
    Result := not FTerminatorWasRead;
  end else begin
    Result := False;
  end;
end;

function TIdIOHandlerStreamMsg.ReadFromSource(
  ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer;
  ARaiseExceptionOnTimeout: Boolean): Integer;
var
  LTerminator: String;
begin
  if not FTerminatorWasRead then begin
    Result := inherited ReadFromSource(ARaiseExceptionIfDisconnected, ATimeout, ARaiseExceptionOnTimeout);
    if Result > 0 then begin
      FLastByteRecv := FInputBuffer.PeekByte(FInputBuffer.Size-1);
      Exit;
    end;
    // determine whether the stream ended with a line
    // break, adding an extra CR and/or LF if needed...
    if (FLastByteRecv = Ord(LF)) then begin
      // don't add an extra line break
      LTerminator := '.' + EOL;
    end else if (FLastByteRecv = Ord(CR)) then begin
      // add extra LF
      LTerminator := LF + '.' + EOL;
    end else begin
      // add extra CRLF
      LTerminator := EOL + '.' + EOL;
    end;
    FTerminatorWasRead := True;
    // in theory, TIdBuffer.Write() will write the string
    // into the buffer's byte array using 1-byte characters
    // even under DotNet where strings are usually Unicode
    // instead of ASCII...
    FInputBuffer.Write(LTerminator);
    Result := Length(LTerminator);
  end else begin;
    Result := 0;
  end;
end;

///////////////////
// TIdMessageClient
///////////////////

procedure TIdMessageClient.InitComponent;
begin
  inherited;

  FMsgLineLength := 79;
  FMsgLineFold := TAB;
end;

procedure TIdMessageClient.WriteFoldedLine(const ALine : string);
var
  ins, s, line, spare : String;
  msgLen, insLen : Word;
begin
  s := ALine;

  // To give an amount of thread-safety
  ins := FMsgLineFold;
  insLen := Length(ins);
  msgLen := FMsgLineLength;

  // Do first line
  if length(s) > FMsgLineLength then
  begin
    spare := Copy(s, 1, msgLen);
    line := GetLongestLine(spare, ' ');    {do not localize}
    s := spare + Copy(s, msgLen + 1, length(s));
    IOHandler.WriteLn(line);

    // continue with the folded lines
    while length(s) > (msgLen - insLen) do
    begin
      spare := Copy(s, 1, (msgLen - insLen));
      line := GetLongestLine(spare, ' ');      {do not localize}
      s := ins + spare + Copy(s, (msgLen - insLen) + 1, length(s));
      IOHandler.WriteLn(line);
    end;

    // complete the output with what's left
    if Trim(s) <> '' then
    begin
      IOHandler.WriteLn(ins + s);
    end;
  end

  else begin
    IOHandler.WriteLn(s);
  end;
end;

procedure TIdMessageClient.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.');  {do not localize}
var
  LMsgEnd: Boolean;
  LActiveDecoder: TIdMessageDecoder;
  LLine: string;
  LParentPart: integer;
  LPreviousParentPart: integer;

  function ProcessTextPart(ADecoder: TIdMessageDecoder; AUseBodyAsTarget: Boolean = False): TIdMessageDecoder;
  {Only set AUseBodyAsTarget to True if you want the input stream stored in TIdMessage.Body
  instead of TIdText.Body: this happens with some single-part messages.}
  var
    LDestStream: TIdStreamVCL;
    LStringStream: TStringStream;
    i: integer;
    LTxt : TIdText;
  begin
    LStringStream := TIdStringStream.Create('');
    try
      LDestStream := TIdStreamVCL.Create(LStringStream);
      try
        LParentPart := AMsg.MIMEBoundary.ParentPart;
        Result := ADecoder.ReadBody(LDestStream, LMsgEnd);
        if AUseBodyAsTarget then begin
          AMsg.Body.Text := LStringStream.DataString;
        end else begin
          LTxt := TIdText.Create(AMsg.MessageParts);
          LTxt.Body.Text := LStringStream.DataString;
          RemoveLastBlankLine(LTxt.Body);
          if AMsg.IsMsgSinglePartMime then begin
            LTxt.ContentType := LTxt.ResolveContentType(AMsg.Headers.Values[SContentType]);
            LTxt.Headers.Add('Content-Type: '+AMsg.Headers.Values[SContentType]);  {do not localize}
            LTxt.CharSet := LTxt.GetCharSet(AMsg.Headers.Values['Content-Type']);  {do not localize}
            LTxt.ContentTransfer := AMsg.Headers.Values['Content-Transfer-Encoding']; {do not localize}
            LTxt.Headers.Add('Content-Transfer-Encoding: '+AMsg.Headers.Values['Content-Transfer-Encoding']);  {do not localize}
            LTxt.ContentID := AMsg.Headers.Values['Content-ID'];  {do not localize}
            LTxt.ContentLocation := AMsg.Headers.Values['Content-Location'];  {do not localize}
          end else begin
            LTxt.ContentType := LTxt.ResolveContentType(ADecoder.Headers.Values[SContentType]);
            LTxt.Headers.Add('Content-Type: '+ADecoder.Headers.Values[SContentType]);          {do not localize}
            LTxt.CharSet := LTxt.GetCharSet(ADecoder.Headers.Values['Content-Type']);          {do not localize}
            LTxt.ContentTransfer := ADecoder.Headers.Values['Content-Transfer-Encoding']; {do not localize}
            LTxt.Headers.Add('Content-Transfer-Encoding: '+ADecoder.Headers.Values['Content-Transfer-Encoding']);  {do not localize}
            LTxt.ContentID := ADecoder.Headers.Values['Content-ID'];  {do not localize}
            LTxt.ContentLocation := ADecoder.Headers.Values['Content-Location'];  {do not localize}
            LTxt.ExtraHeaders.NameValueSeparator := '=';                          {do not localize}
            for i := 0 to ADecoder.Headers.Count-1 do begin
              if LTxt.Headers.IndexOfName(ADecoder.Headers.Names[i]) < 0 then begin
                LTxt.ExtraHeaders.Add(ADecoder.Headers.Strings[i]);
              end;
            end;
          end;
          if TextIsSame(Copy(LTxt.ContentType, 1, 10), 'multipart/') then begin {do not localize}
            LTxt.ParentPart := LPreviousParentPart;
          end else begin
            LTxt.ParentPart := LParentPart;
          end;
        end;
        ADecoder.Free;
      finally FreeAndNil(LDestStream); end;
    finally FreeAndNil(LStringStream); end;
  end;

  function ProcessAttachment(ADecoder: TIdMessageDecoder): TIdMessageDecoder;
  var