使用 Thunderbird 从 Delphi 发送邮件

Question

我需要使用 Thunderbird 和 Delphi XE3 发送带有附件的电子邮件 我不知道从哪里开始，所以我问是否有人有我可以找到信息的网站的链接。

Answer 1

从文档中，您可以使用 Thunderbird 的 命令行选项，所以我认为使用 ShellExecute 应该可以。我没试过这个。

ShellExecute(Handle, 'path\to\thunderbird.exe',
    '-compose "[email protected],attachment=''file:///c:/test.txt''", 
    nil, SW_SHOWNORMAL);

Answer 2

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

• 在 Windows 资源管理器中拖放的日期？

• 以编程方式使用 SendTo 邮件收件人快捷方式

步骤：

将 FileListBox 和按钮拖放到窗体上，并将 FileListBox MultiSelect 属性设置为 true。 使用此代码将文件列表框中选定的条目传递到默认邮件应用程序。

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 测试）

---

我的原创博客文章：http://mikejustin.wordpress.com/2009/07/03/how-can-i-simulate-send-to-with-delphi/

Answer 3

您的解决方案非常完美。请问如何自动添加邮件的收件人、主题和正文？

感谢您的回复