idmessageclient.pas

Indy控件的使用源代码

  LMIMEAttachments: boolean;
  ISOCharset: string;
  HeaderEncoding: Char;  { B | Q }
  TransferEncoding: TTransfer;

  procedure WriteTextPart(ATextPart: TIdText);
  var
    Data: string;
    i: Integer;
  begin
    if Length(ATextPart.ContentType) = 0 then
      ATextPart.ContentType := 'text/plain'; {do not localize}
    if Length(ATextPart.ContentTransfer) = 0 then
      ATextPart.ContentTransfer := 'quoted-printable'; {do not localize}
    WriteLn('Content-Type: ' + ATextPart.ContentType); {do not localize}
    WriteLn('Content-Transfer-Encoding: ' + ATextPart.ContentTransfer); {do not localize}
    WriteStrings(ATextPart.ExtraHeaders);
    WriteLn('');

    // TODO: Provide B64 encoding later
    // if AnsiSameText(ATextPart.ContentTransfer, 'base64') then begin
    //  LEncoder := TIdEncoder3to4.Create(nil);

    if AnsiSameText(ATextPart.ContentTransfer, 'quoted-printable') then
    begin
      for i := 0 to ATextPart.Body.Count - 1 do
      begin
        if Copy(ATextPart.Body[i], 1, 1) = '.' then
        begin
          ATextPart.Body[i] := '.' + ATextPart.Body[i];
        end;
        Data := TIdEncoderQuotedPrintable.EncodeString(ATextPart.Body[i] + EOL);
        if TransferEncoding = iso2022jp then
          Write(Encode2022JP(Data))
        else
          Write(Data);
      end;
    end

    else begin
      WriteStrings(ATextPart.Body);
    end;
    WriteLn('');
  end;

begin
  LMIMEAttachments := AMsg.Encoding = meMIME;
  LBoundary := '';

  InitializeISO(TransferEncoding, HeaderEncoding, ISOCharSet);
  BeginWork(wmWrite);
  try
    if AMsg.MessageParts.AttachmentCount > 0 then
    begin
      if LMIMEAttachments then
      begin
        WriteLn('This is a multi-part message in MIME format'); {do not localize}
        WriteLn('');
        if AMsg.MessageParts.RelatedPartCount > 0 then
        begin
          LBoundary := IndyMultiPartRelatedBoundary;
        end
        else begin
          LBoundary := IndyMIMEBoundary;
        end;
        WriteLn('--' + LBoundary);
      end
      else begin
        // It's UU, write the body
        WriteBodyText(AMsg);
        WriteLn('');
      end;

      if AMsg.MessageParts.TextPartCount > 1 then
      begin
        WriteLn('Content-Type: multipart/alternative; '); {do not localize}
        WriteLn('        boundary="' + IndyMultiPartAlternativeBoundary + '"'); {do not localize}
        WriteLn('');
        for i := 0 to AMsg.MessageParts.Count - 1 do
        begin
          if AMsg.MessageParts.Items[i] is TIdText then
          begin
            WriteLn('--' + IndyMultiPartAlternativeBoundary);
            DoStatus(hsStatusText,  [RSMsgClientEncodingText]);
            WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
            WriteLn('');
          end;
        end;
        WriteLn('--' + IndyMultiPartAlternativeBoundary + '--');
      end
      else begin
        if LMIMEAttachments then
        begin
          WriteLn('Content-Type: text/plain'); {do not localize}
          WriteLn('Content-Transfer-Encoding: 7bit'); {do not localize}
          WriteLn('');
          WriteBodyText(AMsg);
        end;
      end;

      // Send the attachments
      for i := 0 to AMsg.MessageParts.Count - 1 do
      begin
        if AMsg.MessageParts[i] is TIdAttachment then
        begin
          LAttachment := TIdAttachment(AMsg.MessageParts[i]);
          DoStatus(hsStatusText, [RSMsgClientEncodingAttachment]);
          if LMIMEAttachments then
          begin
            WriteLn('');
            WriteLn('--' + LBoundary);
            if Length(LAttachment.ContentTransfer) = 0 then
            begin
              LAttachment.ContentTransfer := 'base64'; {do not localize}
            end;
            if Length(LAttachment.ContentDisposition) = 0 then
            begin
              LAttachment.ContentDisposition := 'attachment'; {do not localize}
            end;
            if (LAttachment.ContentTransfer = 'base64') {do not localize}
              and (Length(LAttachment.ContentType) = 0) then
            begin
              LAttachment.ContentType := 'application/octet-stream'; {do not localize}
            end;
            WriteLn('Content-Type: ' + LAttachment.ContentType + ';'); {do not localize}
            WriteLn('        name="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
            WriteLn('Content-Transfer-Encoding: ' + LAttachment.ContentTransfer); {do not localize}
            WriteLn('Content-Disposition: ' + LAttachment.ContentDisposition +';'); {do not localize}
            WriteLn('        filename="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
            WriteStrings(LAttachment.ExtraHeaders);
            WriteLn('');
          end;
          LDestStream := TIdTCPStream.Create(Self);
          try
            TIdAttachment(AMsg.MessageParts[i]).Encode(LDestStream);
          finally
            FreeAndNil(LDestStream);
          end;
          WriteLn('');
        end;
      end;
      if LMIMEAttachments then
      begin
        WriteLn('--' + LBoundary + '--');
      end;
    end
    // S.G. 21/2/2003: If the user added a single texpart message without filling the body
    // S.G. 21/2/2003: we still need to send that out
    else
    if (AMsg.MessageParts.TextPartCount > 1) or
       ((AMsg.MessageParts.TextPartCount = 1) and (AMsg.Body.Count = 0)) then
    begin
      WriteLn('This is a multi-part message in MIME format'); {do not localize}
      WriteLn('');
      for i := 0 to AMsg.MessageParts.Count - 1 do
      begin
        if AMsg.MessageParts.Items[i] is TIdText then
        begin
          WriteLn('--' + IndyMIMEBoundary);
          DoStatus(hsStatusText, [RSMsgClientEncodingText]);
          WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
        end;
      end;
      WriteLn('--' + IndyMIMEBoundary + '--');
    end

    else begin
      DoStatus(hsStatusText, [RSMsgClientEncodingText]);
      // Write out Body
      //TODO: Why just iso2022jp? Why not someting generic for all MBCS? Or is iso2022jp special?
      if TransferEncoding = iso2022jp then
      begin
        for i := 0 to AMsg.Body.Count - 1 do
        begin
          if Copy(AMsg.Body[i], 1, 1) = '.' then
          begin
            WriteLn('.' + Encode2022JP(AMsg.Body[i]));
          end

          else begin
            WriteLn(Encode2022JP(AMsg.Body[i]));
          end;
        end;
      end

      else begin
        WriteBodyText(AMsg);
      end;
    end;
  finally
    EndWork(wmWrite);
  end;
end;

{ 2001-Oct-29 Don Siders
 procedure TIdMessageClient.SendMsg(AMsg: TIdMessage);
  begin
    SendHeader(AMsg);
    WriteLn('');
    SendBody(AMsg);
  end;  }

// 2001-Oct-29 Don Siders Added AHeadersOnly parameter
// TODO: Override TIdMessageClient.SendMsg to provide socket, stream, and file
//  versions like TIdMessageClient.ProcessMessage?
procedure TIdMessageClient.SendMsg(AMsg: TIdMessage; const AHeadersOnly: Boolean = False);
begin
  if AMsg.NoEncode then begin
    WriteStringS(AMsg.Headers);
    WriteLn('');
    if not AHeadersOnly then begin
      WriteStrings(AMsg.Body);
    end;
  end else begin
    SendHeader(AMsg);
    WriteLn('');
    if (not AHeadersOnly) then SendBody(AMsg);
  end;
end;

function TIdMessageClient.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
begin
  BeginWork(wmRead); try
    repeat
      Result := ReadLn;
      // Exchange Bug: Exchange sometimes returns . when getting a message instead of
      // '' then a . - That is there is no seperation between the header and the message for an
      // empty message.
      if ((Length(AAltTerm) = 0) and (Result = '.')) or
         ({APR: why? (Length(AAltTerm) > 0) and }(Result = AAltTerm)) then begin
        Break;
      end else if Result <> '' then begin
        AMsg.Headers.Append(Result);
      end;
    until False;
    AMsg.ProcessHeaders;
  finally EndWork(wmRead); end;
end;

procedure TIdMessageclient.ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False);
begin
  if IOHandler <> nil then
  begin
    ReceiveHeader(AMsg);
    if (not AHeaderOnly) then
    begin
      ReceiveBody(AMsg);
    end;
  end;
end;

procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AStream: TStream; AHeaderOnly: Boolean = False);
var
  LIOHS: TIdIOHandlerStream;
begin
  LIOHS := TIdIOHandlerStream.Create(nil); try
    LIOHS.InputStream := AStream;
    LIOHS.FreeStreams := False;
    IOHandler := LIOHS; try
      Connect; try
        ReceiveHeader(AMsg);
        if not AHeaderOnly then begin
          ReceiveBody(AMsg);
        end;
      finally Disconnect; end;
    finally IOHandler := nil; end;
  finally FreeAndNil(LIOHS); end;
end;

procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False);
var
  LStream: TFileStream;
begin
  LStream := TFileStream.Create(AFileName, fmOpenRead);
  try
    ProcessMessage(AMsg, LStream, AHeaderOnly);
  finally
    FreeAndNil(LStream);
  end;
end;

procedure TIdMessageClient.WriteBodyText(AMsg: TIdMessage);
var
  i: integer;
begin
  for i := 0 to AMsg.Body.Count - 1 do
  begin
    if Copy(AMsg.Body[i], 1, 1) = '.' then
    begin
      WriteLn('.' + AMsg.Body[i]);
    end

    else begin
      WriteLn(AMsg.Body[i]);
    end;
  end;
end;

end.