在 Delphi MAPI 中使用抄送和密件抄送

Question

我一直在使用以下功能通过 MAPI 发送邮件并且工作正常，但现在我想添加发送抄送和密件抄送消息的选项。这给我带来了问题，因为我无法找到方法

文件附件也不起作用，但我现在不使用它。

function SendMailMAPI(const  aFrom, aTo, aBcc, aSubject, aBody: string; aReceipt: boolean; FileNames: TStringList): boolean;
var
  MAPIError: DWord;
  MapiMessage: TMapiMessage;
  Originator: TMapiRecipDesc;
  Recipient: TMapiRecipDesc;
  MapiFiles: PMapiFileDesc;
  FilesTmp: PMapiFileDesc;
  FilesCount: Integer;
begin
  MAPIError := SUCCESS_SUCCESS;
  Result := True;
  try
    FillChar(MapiMessage, Sizeof(TMapiMessage), 0);
    if aReceipt then
      MapiMessage.flFlags := MAPI_RECEIPT_REQUESTED;
    MapiMessage.lpszSubject := PAnsiChar(AnsiString(aSubject));
    MapiMessage.lpszNoteText := PAnsiChar(AnsiString(aBody));
    FillChar(Originator, Sizeof(TMapiRecipDesc), 0);
    Originator.lpszName := PAnsiChar(AnsiString(aFrom));
    Originator.lpszAddress := PAnsiChar(AnsiString(aFrom));
    MapiMessage.lpOriginator := nil;
    MapiMessage.nRecipCount := 1;
    FillChar(Recipient, Sizeof(TMapiRecipDesc), 0);
    Recipient.ulRecipClass := MAPI_TO;
    Recipient.lpszName := PAnsiChar(AnsiString(aTo));
    Recipient.lpszAddress := PAnsiChar(AnsiString(aTo));
    MapiMessage.lpRecips := @Recipient;
    MapiMessage.nFileCount := FileNames.Count;
    MapiFiles := AllocMem(SizeOf(TMapiFileDesc) * MapiMessage.nFileCount);
    MapiMessage.lpFiles := MapiFiles;
    FilesTmp := MapiFiles;
    for FilesCount := 0 to FileNames.Count - 1 do
      begin
        FilesTmp.nPosition := $FFFFFFFF;
        FilesTmp.lpszPathName := PAnsiChar(AnsiString(FileNames.Strings[FilesCount]));
        Inc(FilesTmp)
      end;
    try
      MAPIError := MapiSendMail(0, Application.MainForm.Handle, MapiMessage, MAPI_LOGON_UI + MAPI_DIALOG, 0);
{or MAPI_NEW_SESSION}
    finally
      FreeMem(MapiFiles)
    end;
  except
    on E:Exception do
      Logfile.Error('U_Mailing.Mapi.SendMailMAPI: ' + E.Message);
  end;
  case MAPIError of
    MAPI_E_AMBIGUOUS_RECIPIENT:
      Showmessage('A recipient matched more than one of the recipient descriptor structures and MAPI_DIALOG was not set. No message was sent.');
    MAPI_E_ATTACHMENT_NOT_FOUND:
      Showmessage('The specified attachment was not found; no message was sent.');
    MAPI_E_ATTACHMENT_OPEN_FAILURE:
      Showmessage('The specified attachment could not be opened; no message was sent.');
    MAPI_E_BAD_RECIPTYPE:
      Showmessage('The type of a recipient was not MAPI_TO, MAPI_CC, or MAPI_BCC. No message was sent.');
    MAPI_E_FAILURE:
      Showmessage('One or more unspecified errors occurred; no message was sent.');
    MAPI_E_INSUFFICIENT_MEMORY:
      Showmessage('There was insufficient memory to proceed. No message was sent.');
    MAPI_E_LOGIN_FAILURE:
      Showmessage('There was no default logon, and the user failed to log on successfully when the logon dialog box was displayed. No message was sent.');
    MAPI_E_TEXT_TOO_LARGE:
      Showmessage('The text in the message was too large to sent; the message was not sent.');
    MAPI_E_TOO_MANY_FILES:
      Showmessage('There were too many file attachments; no message was sent.');
    MAPI_E_TOO_MANY_RECIPIENTS:
      Showmessage('There were too many recipients; no message was sent.');
    MAPI_E_UNKNOWN_RECIPIENT:
      Showmessage('A recipient did not appear in the address list; no message was sent.');
    MAPI_E_USER_ABORT:
      Showmessage('The user canceled the process; no message was sent.');
    else
      Showmessage('MAPISendMail failed with an unknown error code.');
    Result := False;
  end;
end;

Answer 1

将

Recipient.ulRecipClass := MAPI_TO

替换为

Recipient.ulRecipClass := MAPI_CC

或

Recipient.ulRecipClass := MAPI_BCC

Answer 2

修改SendMailMapi函数。在定义中添加两个新闻变量：

    function SendMailMAPI(const  aFrom, aTo, aBcc, aSubject, aBody: string; 
                          aReceipt: boolean; 
                          FileNames: TStringList;
                          const cc_ : string = '';
                          const bcc_ : string = '' ): boolean; 

在 var .. 部分添加以下代码：

    n : integer;
    recipients : array [0..2] of TMapiRecipDesc;    
    // precaution. With dynamic array not working.

在代码中替换此代码：

   MapiMessage.nRecipCount := 1;
   FillChar(Recipient, Sizeof(TMapiRecipDesc), 0);
   Recipient.ulRecipClass := MAPI_TO;
   Recipient.lpszName := PAnsiChar(AnsiString(aTo));
   Recipient.lpszAddress := PAnsiChar(AnsiString(aTo));
   MapiMessage.lpRecips := @Recipient;

作者：

    n:= 1 ;
    if trim(cc_)<>'' then n := n + 1;
    if trim(bcc_)<>'' then n := n + 1;

    MapiMessage.nRecipCount := n;
    FillChar(Recipients, Sizeof(TMapiRecipDesc)*n, 0);
    // to
    FillChar(Recipients[0], Sizeof(TMapiRecipDesc), 0);
    Recipients[0].ulRecipClass := MAPI_TO;
    Recipients[0].lpszName := PAnsiChar(AnsiString(aTo));
    Recipients[0].lpszAddress := PAnsiChar(AnsiString(aTo));
    // cc
    if trim(cc_)<>'' then
     begin
      FillChar(Recipients[1], Sizeof(TMapiRecipDesc), 0);
      Recipients[1].ulRecipClass := MAPI_CC;
      Recipients[1].lpszAddress := PAnsiChar(AnsiString(cc_));
     end;
    // bcc
    if trim(bcc_)<>'' then
     begin
      FillChar(Recipients[2], Sizeof(TMapiRecipDesc), 0);
      Recipients[2].ulRecipClass := MAPI_BCC;
      Recipients[2].lpszAddress := PAnsiChar(AnsiString(bcc_));
     end;
    MapiMessage.lpRecips := @Recipients;

在此代码中，cc_ 是一个字符串变量，抄送字段中包含邮件地址，bcc_ 是一个字符串变量，密件抄送字段中包含邮件地址。

使用 Delphi XE7 进行测试，但在其他版本上应该可以正常工作。

对不起我的英语。我不是本地人