Delphi程序如何通过默认电子邮件客户端发送带有附件的电子邮件?
-
21-09-2019 - |
题
在我的程序中,我正在撰写一封电子邮件以使用在用户计算机上安装的默认电子邮件客户端软件发送。
我已经撰写了邮件地址,主题,多层面的机构,并且有几个附件要包括在内。
我几乎使用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);
在Windows Vista机器上使用Delphi 2009,这将打开Microsoft Mail“ Create Mail”窗口,并正确填充TO,主题和身体。但是,该文件未连接。
当我研究这一点时,我注意到一些评论指出,该技术不适合所有邮件客户端。但是,大多数评论都相当古老,因为我意识到这是一种非常古老的技术。
然后我发现 Zarko Gajic说 “这种方法还可以,但是您无法以这种方式发送附件”。
我也看到了Windows Simple Mail API(MAPI),但Zarko说,只有在最终用户具有符合MAPI兼容的电子邮件软件时才起作用。关于与Delphi一起使用MAPI的技术有充分的文献记载(例如 使用MAPI发送电子邮件),但他们都有免责声明,即Mapi并不总是随Windows安装。
此外,我真的希望该消息在用户的默认电子邮件程序中首先出现,因此他们将其作为电子邮件记录的一部分,并且可以编辑并决定是否以及何时要发送。我不确定MAPI是如何工作的以及它是否会这样做。
所以我的要求是:
在用户的邮件程序中提出电子邮件。
允许一个或多个附件。
与(希望)与XP UP(IE XP,Vista或7)的任何Windows Machine上的所有电子邮件客户端一起工作。
有这样的动物吗?或者,也许有人知道如何获得依恋来使用MailTo/Shellexecute技术?
大多数人做什么?
编辑:
MAPI解决方案甚至Indy解决方案都有一些答案。
我对他们的问题是他们不一定使用默认邮件客户端。例如,在我的Vista机器上,我将Windows Mail设置为默认客户端。当我发送MAPI发送时,它不会播放Windows邮件,但是它会提出并在Outlook中设置电子邮件。我不要那个。
我计划的两个用户抱怨:
您的调试例程未能发送文件,因为它试图出于某种原因启动Windows邮件,而不是使用默认邮件客户端(在我的情况下,雷鸟)
我试图填写异常报告,但在要求该服务器的服务器时放弃了!然后我真的很生气,因为它推出了Outlook-我从来没有使用过它或想使用它。
我不需要Mapi或Indy的代码。它们很容易获得。但是,如果您建议Mapi或Indy,我真正需要的是找到默认客户端并确保它通过发送电子邮件发送的一种方法。
另外,我需要知道MAPI现在是否是通用的。 5年前,它不能保证在所有机器上使用,因为它没有作为操作系统的一部分安装。这仍然是正确的,还是MAPI现在默认情况下随Windows XP,Vista和7附带了吗?
同样的问题对于印地或任何其他建议的解决方案也是如此。它可以与默认客户端一起使用吗?它几乎可以在所有Windows XP和更高版本的机器上使用吗?
“ MailTo”解决方案如此不错的原因是,所有机器都必须支持它,以便处理网页上的HTML Mailto语句。现在,如果我可以用它来添加附件...
可能发现的解决方案:Mjustin指出了使用操作系统的sendto命令的替代方案。这很可能是要走的路。
Mailto不仅限于HTML Mailto的256个字符,但我感到震惊,发现它最终仅限于2048个字符。幸运的是,几个小时后,Mjustin给出了答案。
如果实施还可以,他的回答将为我做。如果没有,我将在这里添加我的评论。
否。事实证明,SendTo解决方案不会始终打开默认电子邮件程序。在我的计算机上,当我的默认邮件是Windows邮件时,它将打开Outlook。太糟糕了。尽管有2048年的角色限制,但我不得不回到MailTo方法。
但是,我确实在文章中找到了: 发送邮件收件人 那:
此时,您可以使用注册表中声明的实际Mailto命令行替换:: Shellexecute :: Winexec呼叫,并定位当前电子邮件客户端(例如,“%programFiles% Outlook express msimn) .exe“ /mailurl:%1)。但是限制为32 kb。总而言之,没有办法使用MailTo协议发送大于32KB的电子邮件。
但是,我必须确定每种情况下的邮件客户端是谁。我希望这会导致进一步的并发症。
我发现的另一件事是,MailTo允许设置“到”,“ CC”,“ BCC”,“主题”和“身体”,但没有附件。而sendto仅允许附件,然后设置带有默认消息的默认电子邮件,而您无法设置各个字段和身体。
解决方案 3
看来Shellexecute中的Mailto无法发送附件。
Mapi和Indy具有不一定选择用户的电子邮件客户端的不幸特征。
因此,另一种可能性是继续使用Shellexecute,但要找到另一种将附件进入电子邮件客户端的方法。
我决定要做的是在创建电子邮件的对话框中,我现在有一个filelistbox列出用户可能要将其附加到电子邮件的文件。当电子邮件弹出时,他们可以简单地将其拖放到电子邮件中。
就我而言,这实际上是一个很好的解决方案,因为这允许用户选择他们要包含的文件。另一种方法(自动连接它们)将要求它们删除不需要的方法。 (即拥有已经为您检查的“添加Google工具栏”选项不好)
目前,该解决方案将起作用。
感谢所有贡献答案的人,并帮助我看到了这一点(ALL +1)。
其他提示
不要复杂,只需使用 JCL MAPI代码。它在jclmapi.pas的单元中。我认为他们也有榜样。该代码非常强大,您可以执行MAPI允许的任何操作。
使用Shellexecute,您无法发送附件,并且您的邮件正文还限制为255个字符。
只要Mapi走了,始终安装了旧的窗口(2000,XP)。它与Outlook Express在一起,几乎总是安装Outlook Express。使用较新的窗口(Vista,7),没有Outlook Express,因此没有MAPI。但是,如果您安装MS Outlook或Mozzila Thunderbird,MAPI将自动安装。所以你很安全。这是基本的MAPI,而不是扩展的MAPI。但这涵盖了您所需的一切。
如果安装了MAPI并采取行动,您也可以检查代码(JCL)。不久前,我做了类似的事情,而且还可以。我还没有找到不支持简单MAPI的流行Windows Mail客户端。这是围绕JCL代码的简单包装器,示例用法bellow:
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.
我使用两种方法来发送MAPI邮件,具体取决于是否需要进行ATTATCH。对于没有附件的简单情况,我使用以下内容:
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;
这使用了一个简单的外壳执行方法,因此除了最新的警报以使用户确认您的程序发送电子邮件可以确认他们可以确认他们可以确认他们不应该有任何实际问题。
对于Attchments,我使用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;
本文 显示Delphi如何模拟“发送到...” Shell上下文菜单命令,并以编程为附件打开默认邮件客户端。
该解决方案不需要MAPI,并且与默认的邮件客户端一起工作,但不完整,因为消息收件人,身体和主题不会自动填充。 (可以使用剪贴板复制消息主体)。
这是所有这些电子邮件设置及其所做的摘要:
http://thesunstroke.blogspot.de/2017/03/how-to-to-configure-eurekalog-to-send-bugs.html
因此,远离Shell(Mailto)。
MAPI也是一个坏主意,因为它仅适用于MS电子邮件客户端。
默认情况下,我设置了简单的MAPI,但很少收到此频道发送的电子邮件。大多数电子邮件都是通过SMTP服务器收到的。
大警告!!!!!!!!!
我已经看到,当您激活Eurekalog时,来自防病毒扫描仪的假阳性警报数量要高得多。因此,只有在绝对必要时才使用Eurekalog。
另外,尤里卡(Eureka)本身都充满了错误(只需查看发行记录,并查看它们发布的每个新功能(甚至更改),后来又修复了一些错误!因此,如果您要跟踪错误,请注意Eurekalog本身可能会在您的EXE中介绍很少!