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

Question

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

lke*_*ler 14 mailto delphi email attachment shellexecute

在我的程序中,我正在编写一封电子邮件,使用安装在用户计算机上的默认电子邮件客户端软件进行发送.

我已经写了mailto地址,主题,多字体,我有几个附件要包括在内.

我几乎使用mailto和ShellExecute工作如下:

  Message := 'mailto:someone@somewhere.com'
    + '?subject=This is the subjectBehold Error Report'
    + '&body=This is line 1' + '%0D%0A'
    + 'This is line 2' + '%0D%0A'
    + 'This is line 3'
    + '&Attach=c:\file1.txt';
  RetVal := ShellExecute(Handle, 'open', PChar(Message), nil, nil, SW_SHOWNORMAL);
  if RetVal <= 32 then
    MessageDlg('Cannot find program to send e-mail.', mtWarning, [mbOK], 0);

Run Code Online (Sandbox Code Playgroud)

在Windows Vista计算机上使用Delphi 2009,这将打开Microsoft Mail"创建邮件"窗口,正确填充"收件人","主题"和"正文".但是文件没有附加.

当我研究这个时,我注意到一些评论说这种技术不适用于所有邮件客户端.然而,大多数评论都相当陈旧,因为我意识到这是一种非常古老的技术.

然后我发现Zarko Gajic说 "这种方法没问题,但是你无法以这种方式发送附件".

我看过还有Windows Simple Mail API(MAPI),但Zarko说只有最终用户拥有符合MAPI标准的电子邮件软件才有效.有关使用MAPI和Delphi的文档很好(例如使用mapi发送电子邮件),但他们都有免责声明MAPI并不总是与Windows一起安装.

此外,我真的希望在用户的默认电子邮件程序中首先显示该消息,因此他们将其作为其电子邮件记录的一部分,并且他们可以编辑它并决定是否以及何时发送它.我不确定MAPI是如何工作的,如果它会这样做.

所以我的要求是:

将电子邮件发送到用户的邮件程序中.
允许一个或多个附件.
在XP上(即XP,Vista或7)使用任何Windows机器上的所有电子邮件客户端(希望如此).

有这样的动物吗？或者也许有人知道如何使用mailto/ShellExecute技术获取附件？

大多数人做什么？

编辑:

MAPI解决方案甚至是Indy解决方案都有一些答案.

我遇到的问题是他们不一定使用默认的邮件客户端.例如,在我的Vista计算机上,我已将Windows Mail设置为我的默认客户端.当我执行MAPI发送时,它不会启动Windows Mail,但它会调出并在Outlook中设置电子邮件.我不希望这样.

我的两个用户抱怨我的程序:

您的调试例程无法发送文件,因为它尝试以自己已知的某些原因启动Windows邮件而不是使用默认邮件客户端(在我的情况下是雷鸟)

我试图填写异常报告,但是当它要求这台服务器时,放弃了该服务器!然后我真的生气了,因为它推出了Outlook - 我从来没有,曾经使用它或想要使用它.

我不需要MAPI或Indy的代码.它们随时可用.但是,如果您建议使用MAPI或Indy,我真正需要的是一种查找默认客户端的方法,并确保它是通过要发送的电子邮件的客户端.

此外,我需要知道MAPI现在是否通用.5年前,它不能保证在所有机器上运行,因为它没有作为操作系统的一部分安装.这仍然是真的,或者MAPI现在默认配备Windows XP,Vista和7？

同样的问题适用于Indy或任何其他建议的解决方案.它可以与默认客户端一起使用,它几乎可以在所有Windows XP和更高版本的机器上运行吗？

"mailto"解决方案之所以如此优秀,是因为所有机器都必须支持它才能处理网页上的HTML mailto语句.现在,如果我只能用它来添加附件......

找到了可能的解决方案:mjustin指出了一种利用操作系统的sendto命令的替代方案.这很可能是要走的路.

mailto不限于像HTML mailto那样的256个字符,但我发现它最终被限制为2048个字符.幸运的是,几个小时后,mjustin回答了他的问题.

如果实现这一点没问题,他的回答将会为我完成.如果没有,我会在这里添加我的评论.

不.事实证明,sendto解决方案并不总是打开默认的电子邮件程序.在我的计算机上,当我的默认邮件程序是Windows Mail时,它会打开Outlook.太糟糕了.尽管有2048个字符限制,我还是要回到mailto方法.

但是,我在文章中找到了:SendTo邮件收件人:

此时,您可以使用经过深思熟虑的:: WinExec调用替换:: ShellExecute,使用注册表中声明的实际mailto命令行并定位当前的电子邮件客户端(例如,"%ProgramFiles%\ Outlook Express\msimn" .exe"/ mailurl:%1).但那么限制是32 KB.总之,使用mailto协议无法发送大于32KB的电子邮件.

但是我必须确定邮件客户端在每种情况下是谁.我希望这会导致进一步的复杂化.

我发现的另一件事是mailto允许设置"to","cc","bcc","subject"和"body"但没有附件.而sendto仅允许附件,然后设置默认电子邮件和默认消息,您无法设置各种字段和正文.

Answer 1

Run*_*ner 5

不要复杂，只需使用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。但这涵盖了您所需的一切。

您还可以检入代码（JCL）是否已安装MAPI并采取相应措施。不久前我做过类似的事情，而且效果很好。我还没有找到不支持简单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.

Run Code Online (Sandbox Code Playgroud)

用法示例：

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.

Run Code Online (Sandbox Code Playgroud)

Answer 2

lke*_*ler 4

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

MAPI 和 Indy 都有一个不幸的特性，即不一定选择用户的电子邮件客户端。

因此，另一种可能性是继续使用 ShellExecute，但找到另一种方法将附件获取到电子邮件客户端。

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

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

暂时这个解决方案是可行的。

感谢所有提供答案并帮助我解决这个问题的人（全部+1）。

归档时间：	15 年，12 月前
查看次数：	38785 次
最近记录：	8 年，7 月前