使用Thunderbird从Delphi发送邮件

我需要使用Thunderbird和Delphi XE3发送带有附件的电子邮件

---

我不知道从哪里开始，所以我问是否有人有指向我可以找到信息的站点的链接。

从文档中，您可以使用Thunderbird的，所以我认为使用应该可以。我没有试过这个

ShellExecute(Handle, 'path\to\thunderbird.exe',
    '-compose "to=foo@nowhere.net,attachment=''file:///c:/test.txt''", 
    nil, SW_SHOWNORMAL);

---

从文档中，您可以使用Thunderbird的，因此我认为使用Thunderbird应该是可行的。我没有试过这个

ShellExecute(Handle, 'path\to\thunderbird.exe',
    '-compose "to=foo@nowhere.net,attachment=''file:///c:/test.txt''", 
    nil, SW_SHOWNORMAL);

---

以下代码基于这两篇文章：

步骤：

在窗体上删除FileListBox和按钮，并将FileListBox MultiSelect属性设置为true。 使用此代码将filelistbox中的选定条目传递给默认邮件应用程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    FileListBox1: TFileListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX, ShlObj, ComObj;

{$R *.dfm}

function GetFileListDataObject(const Directory: string; Files:
  TStrings):
  IDataObject;
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Malloc: IMalloc;
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
begin
  Result := nil;
  if Files.Count = 0 then
    Exit;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil,
    PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for i := 0 to FileCount - 1 do
      begin
        OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i],
          dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
        nil,
        Pointer(Result)));
    finally
      for i := 0 to FileCount - 1 do
      begin
        if p^[i] <> nil then
          Malloc.Free(p^[i]);
      end;
      FreeMem(p);
    end;
  finally
    Malloc.Free(FolderPidl);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SelFileList: TStrings;
  I: Integer;
  DataObject: IDataObject;
  Effect: Integer;
  CLSID_SendMail: TGUID;
  DT: IDropTarget;
  P: TPoint;
begin
  CLSID_SendMail := StringToGUID('{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}');

  with FileListBox1 do
  begin
    SelFileList := TStringList.Create;
    try
      SelFileList.Capacity := SelCount;
      for i := 0 to FileListBox1.Items.Count - 1 do
        if Selected[i] then
          SelFileList.Add(Items[i]);
      DataObject := GetFileListDataObject(Directory, SelFileList);
    finally
      SelFileList.Free;
    end;
    Effect := DROPEFFECT_NONE;
    CoCreateInstance(CLSID_SendMail, nil, CLSCTX_ALL, IDropTarget, DT);
    DT.DragEnter(DataObject, MK_LBUTTON, P, Effect);
    DT.Drop(DataObject, MK_LBUTTON, P, Effect);
  end;
end;

end.

（使用Delphi 2009进行测试）

---

---

我的原始博客文章：

以下代码基于这两篇文章：

步骤：

在窗体上删除FileListBox和按钮，并将FileListBox MultiSelect属性设置为true。 使用此代码将filelistbox中的选定条目传递给默认邮件应用程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    FileListBox1: TFileListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX, ShlObj, ComObj;

{$R *.dfm}

function GetFileListDataObject(const Directory: string; Files:
  TStrings):
  IDataObject;
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Malloc: IMalloc;
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
begin
  Result := nil;
  if Files.Count = 0 then
    Exit;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil,
    PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for i := 0 to FileCount - 1 do
      begin
        OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i],
          dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
        nil,
        Pointer(Result)));
    finally
      for i := 0 to FileCount - 1 do
      begin
        if p^[i] <> nil then
          Malloc.Free(p^[i]);
      end;
      FreeMem(p);
    end;
  finally
    Malloc.Free(FolderPidl);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SelFileList: TStrings;
  I: Integer;
  DataObject: IDataObject;
  Effect: Integer;
  CLSID_SendMail: TGUID;
  DT: IDropTarget;
  P: TPoint;
begin
  CLSID_SendMail := StringToGUID('{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}');

  with FileListBox1 do
  begin
    SelFileList := TStringList.Create;
    try
      SelFileList.Capacity := SelCount;
      for i := 0 to FileListBox1.Items.Count - 1 do
        if Selected[i] then
          SelFileList.Add(Items[i]);
      DataObject := GetFileListDataObject(Directory, SelFileList);
    finally
      SelFileList.Free;
    end;
    Effect := DROPEFFECT_NONE;
    CoCreateInstance(CLSID_SendMail, nil, CLSCTX_ALL, IDropTarget, DT);
    DT.DragEnter(DataObject, MK_LBUTTON, P, Effect);
    DT.Drop(DataObject, MK_LBUTTON, P, Effect);
  end;
end;

end.

（使用Delphi 2009进行测试）

---

---

---

我的原创博客文章：

你为什么需要雷鸟？你可以自己用印地SMTP发送邮件，这很难。如果Thunderbird是您的默认邮件客户端，您可以执行电子邮件地址链接，但仍保留附件。谁的建议更好。Thunderbird与MAPI兼容，因此您可以编写一个程序，使用默认的电子邮件客户端使用MAPI发送带有附件的电子邮件，如果是Thunderbird（或其他），该程序将正常工作。我发现了一个使用google搜索delphi mapi的简单示例：尝试从unit mapi查看MapiSendMail；将Thunderbird定义为默认邮件。您要求链接。如果您想绕过Thunderbird，请使用Indy SMTP per whosrdaddy，尝试下载底部的“发送邮件”示例。为什么需要Thunderbird？你可以自己用印地SMTP发送邮件，这很难。如果Thunderbird是您的默认邮件客户端，您可以执行电子邮件地址链接，但仍保留附件。谁的建议更好。Thunderbird与MAPI兼容，因此您可以编写一个程序，使用默认的电子邮件客户端使用MAPI发送带有附件的电子邮件，如果是Thunderbird（或其他），该程序将正常工作。我发现了一个使用google搜索delphi mapi的简单示例：尝试从unit mapi查看MapiSendMail；将Thunderbird定义为默认邮件。您要求链接。如果要绕过Thunderbird，请使用Indy SMTP per whosrdaddy，尝试下载底部的“发送邮件”示例。如果直接执行.exe，则应使用

CreateProcess（）

ShellExecute（）

只需将.exe文件委托给

CreateProcess（）

，这样您就可以省去中间人。@RemyLebeau虽然这是事实，但CreateProcess是一个相当复杂的beast，它的灵活性需要付出代价。所以，无论如何，你最好使用一些简化（使之哑巴化）的包装器。它可以是类似于绝地代码库中的Delphi包装器，也可以使用Microsoft提供的包装器，即ShellExecute。如果有限的ShellExecute功能对您来说已经足够了-为什么要避免使用简单的API？@LeonardoHerrera-这可能是一种选择。看来，在广告中添加这个选项很简单。@RemyLebeau-注意到，谢谢你的评论。就我个人而言，我不在我的应用程序中进行很多系统调用，因为我讨厌支持（我使我的.exe文件尽可能独立。）我用命令行选项做了一些实验，90%成功了。最后10%是我需要一个读回执，这看起来不是命令行的选项。如果直接执行.exe，那么应该使用

CreateProcess（）

ShellExecute（）

只需将.exe文件委托给

CreateProcess（）

，这样您就可以省去中间人。@RemyLebeau虽然这是事实，但CreateProcess是一个相当复杂的beast，它的灵活性需要付出代价。所以，无论如何，你最好使用一些简化（使之哑巴化）的包装器。它可以是类似于绝地代码库中的Delphi包装器，也可以使用Microsoft提供的包装器，即ShellExecute。如果有限的ShellExecute功能对您来说已经足够了-为什么要避免使用简单的API？@LeonardoHerrera-这可能是一种选择。看来，在广告中添加这个选项很简单。@RemyLebeau-注意到，谢谢你的评论。就我个人而言，我在我的应用程序中不做很多系统调用，因为我讨厌支持（我使我的.exe文件尽可能独立）。我用命令行选项做了一些实验，这就完成了90%的技巧。最后10%是我需要一个读回执，这看起来不是命令行选项