How can a Delphi Program send an Email with Attachments via the DEFAULT E-mail Client?

前端 未结 5 910
醉梦人生
醉梦人生 2020-12-24 15:31

Within my program, I am composing an email to send using the default e-mail client software installed on a user\'s machine.

I have composed the mailto address, the

5条回答
  •  情歌与酒
    2020-12-24 15:48

    Do not complicate, just use the JCL MAPI code. It is in the unit JclMapi.pas. I think they also have the example for it. The code is very powerfull and you can do anything that MAPI allows you.

    With ShellExecute you cannot send the attachment and you are also limited to 255 characters for the mail body.

    As long as MAPI goes, with old windows it is always installed (2000, XP). It comes together with Outlook Express and Outlook Express is almost always installed. With newer windows (Vista, 7) there is no Outlook Express and so no MAPI. But MAPI is automatically installed if you install MS Outlook or Mozzila Thunderbird. So you are pretty safe. This is basic MAPI and not extended MAPI. But it covers all you need.

    You can also check in your code (JCL) if MAPI is installed and act acordingly. I have done a similar thing not so long ago and it works ok. I have not found a popular windows mail client that does not support simple MAPI. This is a simple wrapper around JCL code and the sample usage 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.
    

    Sample usage:

    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.
    

提交回复
热议问题