Question

Answer 1

不要复杂，只需使用JCL MAPI代码即可。它位于JclMapi.pas单元中。我认为他们也有这个例子。代码非常强大，您可以执行MAPI允许的任何操作。

使用ShellExecute，您无法发送附件，邮件正文也限制为255个字符。

只要MAPI使用旧版Windows，它总是安装（2000，XP）。它与Outlook Express和Outlook Express几乎总是安装在一起。对于较新的Windows（Vista，7），没有Outlook Express，因此没有MAPI。但是，如果安装MS Outlook或Mozzila Thunderbird，则会自动安装MAPI。所以你很安全。这是基本MAPI而不是扩展MAPI。但它涵盖了你所需要的一切。

如果安装了MAPI，您还可以检入您的代码（JCL）并按照相应的方式执行操作。不久前我做过类似的事情并且工作正常。我还没有找到一个不支持简单MAPI的流行Windows邮件客户端。这是一个简单的JCL代码包装和下面的示例用法：

unit MAPI.SendMail;

interface

uses
  SysUtils, Classes, JclMapi;

type
  TPrerequisites = class
  public
    function IsMapiAvailable: Boolean;
    function IsClientAvailable: Boolean;
  end;

  TMAPISendMail = class
  private
    FAJclEmail: TJclEmail;
    FShowDialog: Boolean;
    FResolveNames: Boolean;
    FPrerequisites: TPrerequisites;
    // proxy property getters
    function GetMailBody: string;
    function GetHTMLBody: Boolean;
    function GetMailSubject: string;
    // proxy property setters
    procedure SetMailBody(const Value: string);
    procedure SetHTMLBody(const Value: Boolean);
    procedure SetMailSubject(const Value: string);
  protected
    function DoSendMail: Boolean; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    // properties of the wrapper class
    property MailBody: string read GetMailBody write SetMailBody;
    property HTMLBody: Boolean read GetHTMLBody write SetHTMLBody;
    property ShowDialog: Boolean read FShowDialog write FShowDialog;
    property MailSubject: string read GetMailSubject write SetMailSubject;
    property ResolveNames: Boolean read FResolveNames write FResolveNames;
    property Prerequisites: TPrerequisites read FPrerequisites;
    // procedure and functions of the wrapper class
    procedure AddRecipient(const Address: string; const Name: string = '');
    procedure AddAttachment(const FileName: string);
    function SendMail: Boolean;
  end;

implementation

{ TMAPISendMail }

constructor TMAPISendMail.Create;
begin
  FPrerequisites := TPrerequisites.Create;
  FAJclEmail := TJclEmail.Create;
  FShowDialog := True;
end;

destructor TMAPISendMail.Destroy;
begin
  FreeAndNil(FAJclEmail);
  FreeAndNil(FPrerequisites);

  inherited;
end;

function TMAPISendMail.DoSendMail: Boolean;
begin
  Result := FAJclEmail.Send(FShowDialog);
end;

function TMAPISendMail.SendMail: Boolean;
begin
  Result := DoSendMail;
end;

function TMAPISendMail.GetMailBody: string;
begin
  Result := FAJclEmail.Body;
end;

procedure TMAPISendMail.SetMailBody(const Value: string);
begin
  FAJclEmail.Body := Value;
end;

procedure TMAPISendMail.AddAttachment(const FileName: string);
begin
  FAJclEmail.Attachments.Add(FileName);
end;

procedure TMAPISendMail.AddRecipient(const Address, Name: string);
var
  LocalName: string;
  LocalAddress: string;
begin
  LocalAddress := Address;
  LocalName := Name;

  if FResolveNames then
    if not FAJclEmail.ResolveName(LocalName, LocalAddress) then
      raise Exception.Create('Could not resolve Recipient name and address!');

  FAJclEmail.Recipients.Add(LocalAddress, LocalName);
end;

function TMAPISendMail.GetMailSubject: string;
begin
  Result := FAJclEmail.Subject;
end;

procedure TMAPISendMail.SetMailSubject(const Value: string);
begin
  FAJclEmail.Subject := Value;
end;

function TMAPISendMail.GetHTMLBody: Boolean;
begin
  Result := FAJclEmail.HtmlBody;
end;

procedure TMAPISendMail.SetHTMLBody(const Value: Boolean);
begin
  FAJclEmail.HtmlBody := Value;
end;

{ TPrerequisites }

function TPrerequisites.IsClientAvailable: Boolean;
var
  SimpleMAPI: TJclSimpleMapi;
begin
  SimpleMAPI := TJclSimpleMapi.Create;
  try
    Result := SimpleMAPI.AnyClientInstalled;
  finally
    SimpleMAPI.Free;
  end;
end;

function TPrerequisites.IsMapiAvailable: Boolean;
var
  SimpleMAPI: TJclSimpleMapi;
begin
  SimpleMAPI := TJclSimpleMapi.Create;
  try
    Result := SimpleMAPI.SimpleMapiInstalled;
  finally
    SimpleMAPI.Free;
  end;
end;

end.

样本用法：

unit f_Main;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls, XPMan,

  // project units
  JclMapi, MAPI.SendMail, Dialogs;

type
  TfMain = class(TForm)
    XPManifest: TXPManifest;
    gbMailProperties: TGroupBox;
    eMailSubject: TEdit;
    stMailSubject: TStaticText;
    stMailBody: TStaticText;
    mmMailBody: TMemo;
    cbHTMLBody: TCheckBox;
    gbAttachments: TGroupBox;
    gbRecipients: TGroupBox;
    btnSendMail: TButton;
    lbRecipients: TListBox;
    eRecipAddress: TEdit;
    StaticText1: TStaticText;
    eRecipName: TEdit;
    btnAddRecipient: TButton;
    stRecipName: TStaticText;
    OpenDialog: TOpenDialog;
    lbAttachments: TListBox;
    btnAddAttachment: TButton;
    stMAPILabel: TStaticText;
    stClientLabel: TStaticText;
    stMAPIValue: TStaticText;
    stClientValue: TStaticText;
    procedure btnSendMailClick(Sender: TObject);
    procedure btnAddRecipientClick(Sender: TObject);
    procedure btnAddAttachmentClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

{$R *.dfm}

procedure TfMain.btnSendMailClick(Sender: TObject);
var
  I: Integer;
  Name: string;
  Address: string;
  ItemStr: string;
  Pos1, Pos2: Integer;
  MAPISendMail: TMAPISendMail;
begin
  MAPISendMail := TMAPISendMail.Create;
  try
    for I := 0 to lbRecipients.Items.Count - 1 do
    begin
      ItemStr := lbRecipients.Items[I];
      Pos1 := Pos('[', ItemStr);
      Pos2 := Pos(']', ItemStr);

      Name := Trim(Copy(ItemStr, Pos1 + 1, Pos2 - Pos1 - 1));
      Address := Trim(Copy(ItemStr, 1, Pos1 - 1));
      MAPISendMail.AddRecipient(Address, Name);
    end;

    for I := 0 to lbAttachments.Items.Count - 1 do
      MAPISendMail.AddAttachment(lbAttachments.Items[I]);

    MAPISendMail.MailSubject := eMailSubject.Text;
    MAPISendMail.HTMLBody := cbHTMLBody.Checked;
    MAPISendMail.MailBody := mmMailBody.Text;
    MAPISendMail.SendMail;
  finally
    MAPISendMail.Free;
  end;
end;

procedure TfMain.btnAddRecipientClick(Sender: TObject);
begin
  lbRecipients.Items.Add(Format('%s [%s]', [eRecipAddress.Text,
                                            eRecipName.Text]));
end;

procedure TfMain.btnAddAttachmentClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    lbAttachments.Items.Add(OpenDialog.FileName);
end;

procedure TfMain.FormCreate(Sender: TObject);
var
  ValidHost: Boolean;
  MAPISendMail: TMAPISendMail;
begin
  MAPISendMail := TMAPISendMail.Create;
  try
    ValidHost := True;

    if MAPISendMail.Prerequisites.IsMapiAvailable then
    begin
      stMAPIValue.Caption := 'Available';
      stMAPIValue.Font.Color := clGreen;
    end
    else
    begin
      stMAPIValue.Caption := 'Unavailable';
      stMAPIValue.Font.Color := clRed;
      ValidHost := False;
    end;

    if MAPISendMail.Prerequisites.IsClientAvailable then
    begin
      stClientValue.Caption := 'Available';
      stClientValue.Font.Color := clGreen;
    end
    else
    begin
      stClientValue.Caption := 'Unavailable';
      stClientValue.Font.Color := clRed;
      ValidHost := False;
    end;

    btnSendMail.Enabled := ValidHost;
  finally
    MAPISendMail.Free;
  end;
end;

end.

Answer 2

我使用两种方法发送MAPI邮件，具体取决于是否需要附件。对于没有附件的简单情况，我使用以下内容：

function SendShellEmail( ARecipientEmail, ASubject, ABody : string ) : boolean;
// Send an email to this recipient with a subject and a body
var
  iResult : integer;
  S       : string;
begin

 If Trim(ARecipientEmail) = '' then
   ARecipientEmail := 'mail';
 S := 'mailto:' + ARecipientEmail;

 S := S + '?subject=' + ASubject;

 If Trim(ABody) <> '' then
  S := S + '&body=' + ABody;

 iResult := ShellExecute( Application.Handle,'open', PChar(S), nil, nil, SW_SHOWNORMAL);
 Result := iResult > 0;
end;

这使用了一个简单的shell执行方法，因此除了最近的警报之外，您不应该遇到任何实际问题，以便用户确认您的程序可以发送电子邮件。

对于附件，我使用以下代码，这些代码最初取自Brian Long的Delphi杂志。也可以使用MAPI客户端发送电子邮件，但使用指定的SMTP服务器，但我认为您明确不希望这样。如果你这样做，我可以为你提供代码。

uses
  SysUtils,
  Windows,
  Dialogs,
  Forms,
  MAPI;

procedure ArtMAPISendMail(
            const Subject, MessageText, MailFromName, MailFromAddress,
                  MailToName, MailToAddress: String;
            const AttachmentFileNames: array of String);
//Originally by Brian Long: The Delphi Magazine issue 60 - Delphi And Email
var
  MAPIError: DWord;
  MapiMessage: TMapiMessage;
  Originator, Recipient: TMapiRecipDesc;
  Files, FilesTmp: PMapiFileDesc;
  FilesCount: Integer;
begin
   FillChar(MapiMessage, Sizeof(TMapiMessage), 0);

   MapiMessage.lpszSubject := PAnsiChar(AnsiString(Subject));
   MapiMessage.lpszNoteText := PAnsiChar(AnsiString(MessageText));

   FillChar(Originator, Sizeof(TMapiRecipDesc), 0);

   Originator.lpszName := PAnsiChar(AnsiString(MailFromName));
   Originator.lpszAddress := PAnsiChar(AnsiString(MailFromAddress));
//   MapiMessage.lpOriginator := @Originator;
   MapiMessage.lpOriginator := nil;


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

   MapiMessage.nFileCount := High(AttachmentFileNames) - Low(AttachmentFileNames) + 1;
   Files := AllocMem(SizeOf(TMapiFileDesc) * MapiMessage.nFileCount);
   MapiMessage.lpFiles := Files;
   FilesTmp := Files;
   for FilesCount := Low(AttachmentFileNames) to High(AttachmentFileNames) do
   begin
     FilesTmp.nPosition := $FFFFFFFF;
     FilesTmp.lpszPathName := PAnsiChar(AnsiString(AttachmentFileNames[FilesCount]));
     Inc(FilesTmp)
   end;

   try
     MAPIError := MapiSendMail(
       0,
       Application.MainForm.Handle,
       MapiMessage,
       MAPI_LOGON_UI {or MAPI_NEW_SESSION},
       0);
   finally
     FreeMem(Files)
   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.');
     SUCCESS_SUCCESS:
       Showmessage('MAPISendMail successfully sent the message.');
   else
     Showmessage('MAPISendMail failed with an unknown error code.');
   end;
end;

Answer 3

ShellExecute中的mailto似乎无法发送附件。

MAPI和Indy具有不一定选择用户电子邮件客户端的不幸特征。

所以另一种可能性是继续使用ShellExecute，但找到另一种方法将附件放入电子邮件客户端。

我决定做的是在创建电子邮件的Dialog上，我现在有一个FileListBox列出了用户可能想要附加到电子邮件的文件。当电子邮件弹出时，他们只需将它们拖放到电子邮件中即可。

在我的情况下，这实际上是一个很好的解决方案，因为这允许用户选择他们想要包含的文件。另一种方法（自动附加它们）将要求他们删除不想包含的方法。（即已经为您检查了“添加Google工具栏”选项并不好）

目前这个解决方案可行。

感谢所有提供答案的人，并帮助我了解了这一切（全+1）。

Answer 4

This article显示了Delphi如何模拟“发送到...”shell上下文菜单命令，并以编程方式打开带附件的默认邮件客户端。

此解决方案不需要MAPI并与默认邮件客户端一起使用，但不完整，因为邮件收件人，正文和主题不会自动填写。（可以使用剪贴板复制邮件正文）。

Answer 5

以下是有关所有电子邮件设置及其功能的摘要：
http://thesunstroke.blogspot.de/2017/03/how-to-configure-eurekalog-to-send-bugs.html

所以，远离壳牌（mailto） Mapi也是一个坏主意，因为它只适用于MS电子邮件客户端我默认设置简单MAPI，但我很少收到此频道发送的电子邮件。大多数电子邮件是通过SMTP服务器接收的。

大警告!!!!!!!!!
我已经看到，当您激活EurekaLog时，防病毒扫描程序的误报警数量要高得多。因此，只有在绝对必要时才使用EurekaLog 此外，Eureka本身充满了bug（只需查看发布历史，看看它们发布的每个新功能（甚至更改），它们稍后修复了一些错误！所以，如果你正在跟踪bug，请注意EurekaLog本身可能会在你的EXE中引入一些内容！

Delphi程序如何通过DEFAULT电子邮件客户端发送带附件的电子邮件？

5 个答案: