sender.pas

邮件发送

{ this is the other part of my simple MAPI example. I just want to give
  the user the general understanding of how to send MAPI mail with an
  attachment. In the real world this program would have multiple To's,
  multiple CC's, multiple BCC's, and multiple Attachments. I did not add
  MAPI components, I just used what came with Delphi 4. I believe this code
  should work with Delphi 3, 4, and 5. Some of the ideas are also from
  Danny's TEmail component. Again, thank you Danny.
  You can do whatever you please with the code. Just let me know if it is
  useful.
  I wrote this code in a none efficient way to show the intricate details
  of sending MAPI mail.
  Note: This program only accepts one To, one CC, one BCC, and one
  attachment. I have to leave some things for you to experiment!
}

unit sender;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, mapi;

type
  TfrmMain = class(TForm)
    lblTo: TLabel;
    lblCC: TLabel;
    lblBCC: TLabel;
    txtSubject: TEdit;
    moBody: TMemo;
    lblSubject: TLabel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    lblMessageBody: TLabel;
    lblAttachment: TLabel;
    statSend: TStatusBar;
    btnBrowse: TButton;
    txtTo: TEdit;
    txtCC: TEdit;
    txtBCC: TEdit;
    txtAttachment: TEdit;
    AttachmentDlg: TOpenDialog;
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  RECIP_MAX       = MaxInt div SizeOf(TMapiRecipDesc);
  ATTACH_MAX      = MaxInt div SizeOf(TMapiFileDesc);

type
  { array of structures for TO, CC, and BCC }
  TRecipAccessArray     = array [0 .. (RECIP_MAX - 1)] of TMapiRecipDesc;
  TlpRecipArray         = ^TRecipAccessArray;
  { array of structures for attachments }
  TAttachAccessArray    = array [0 .. (ATTACH_MAX - 1)] of TMapiFileDesc;
  TlpAttachArray        = ^TAttachAccessArray;

var
  frmMain: TfrmMain;
  lppMapiMessage: MapiMessage; // main message info pointer
  hSession: ULONG;
  lppMapiFileDesc: MapiFileDesc; // attachment info pointer
  flFlags: ULONG;
  lparrayRecips: TlpRecipArray;
  lppMapiRecipDesc: TMapiRecipDesc; // recipient info pointer
  lparrayAttachments: TlpAttachArray;


implementation

{$R *.DFM}

procedure TfrmMain.btnOKClick(Sender: TObject);
var
    err: ULONG;
    AnyStr: PChar;
    nAttachments,
    nRecipients: Cardinal;
begin
     { This routine is going to simply make sure
       that all information are properly entered
       subject, to, and message body }
     if (txtTo.Text <> '') and (txtSubject.Text <> '') and
        (moBody.Lines.Count > 0) then
     begin
          nAttachments := 1;
          nRecipients := 0;
          if txtTo.Text <> '' then
             Inc(nRecipients);
          if txtCC.Text <> '' then
             Inc(nRecipients);
          if txtBCC.Text <> '' then
             Inc(nRecipients);

          { assign 0 to all structure options }
          FillChar(lppMapiRecipDesc, SizeOf(TMapiRecipDesc), 0);
          lparrayRecips  := TlpRecipArray(StrAlloc(nRecipients*SizeOf(TMapiRecipDesc)));
          FillChar(lparrayRecips^, StrBufSize(PChar(lparrayRecips)), 0);
          lparrayAttachments := TlpAttachArray(StrAlloc(nAttachments*SizeOf(TMapiFileDesc)));
          FillChar(lparrayAttachments^, StrBufSize(PChar(lparrayAttachments)), 0);

          { check to see if there is file to attach }

          if txtAttachment.Text <> '' then
          begin
          { info about Attachment}
               lparrayAttachments^[0].ulReserved := 0;
               lparrayAttachments^[0].flFlags := 0;
               lparrayAttachments^[0].nPosition := ULONG($FFFFFFFF);
               AnyStr := StrAlloc(length(txtAttachment.Text)+1);
               StrPCopy(AnyStr,txtAttachment.Text);
               lparrayAttachments^[0].lpszPathName := AnyStr;
               AnyStr := nil;
               StrDispose(AnyStr);
               AnyStr := StrAlloc(length(ExtractFileName(txtAttachment.Text))+1);
               StrPCopy(AnyStr,ExtractFileName(txtAttachment.Text));
               lparrayAttachments^[0].lpszFileName := AnyStr;
               AnyStr := nil;
               StrDispose(AnyStr);
               lparrayAttachments^[0].lpFileType := nil;
          end;
          
          { info about recipient }
          lparrayRecips^[0].ulReserved := 0;
          lparrayRecips^[0].ulRecipClass := MAPI_TO;
          AnyStr := StrAlloc(length(txtTo.Text)+1);
          StrPCopy(AnyStr,txtTo.Text);
          lparrayRecips^[0].lpszName := AnyStr;
          lparrayRecips^[0].lpszAddress := nil;
          lparrayRecips^[0].ulEIDSize := 0;
          lparrayRecips^[0].lpEntryID := nil;
          AnyStr := nil;
          StrDispose(AnyStr);

          { info about CC }
          if txtCC.Text <> '' then
          begin
               AnyStr := StrAlloc(length(txtCC.Text)+1);
               StrPCopy(AnyStr,txtCC.Text);
               lparrayRecips^[1].ulReserved := 0;
               lparrayRecips^[1].ulRecipClass := MAPI_CC;
               lparrayRecips^[1].lpszName := AnyStr;
               lparrayRecips^[1].lpszAddress := nil;
               lparrayRecips^[1].ulEIDSize := 0;
               lparrayRecips^[1].lpEntryID := nil;
               AnyStr := nil;
               StrDispose(AnyStr);
          end;

          { info about BCC }
          if txtBCC.Text <> '' then
          begin
               AnyStr := StrAlloc(length(txtBCC.Text)+1);
               StrPCopy(AnyStr,txtBCC.Text);
               lparrayRecips^[2].ulReserved := 0;
               lparrayRecips^[2].ulRecipClass := MAPI_BCC;
               lparrayRecips^[2].lpszName := AnyStr;
               lparrayRecips^[2].lpszAddress := nil;
               lparrayRecips^[2].ulEIDSize := 0;
               lparrayRecips^[2].lpEntryID := nil;
               AnyStr := nil;
               StrDispose(AnyStr);
          end;

          { main structure that is used to send the message }
          lppMapiMessage.ulReserved := ULONG(0);
          lppMapiMessage.lpszSubject := PChar(txtSubject.Text);
          lppMapiMessage.lpszNoteText := PChar(moBody.Lines.Text);
          lppMapiMessage.lpszMessageType := nil;
          lppMapiMessage.lpszDateReceived := nil;
          lppMapiMessage.lpszConversationID := nil;
          lppMapiMessage.flFlags := ULONG(0);
          lppMapiMessage.lpOriginator := nil;
          lppMapiMessage.nRecipCount := nRecipients;
          lppMapiMessage.lpRecips := @lparrayRecips^;
          lppMapiMessage.nFileCount := nAttachments;
          lppMapiMessage.lpFiles := @lparrayAttachments^;
          { drops the mail in the outbox
            Make sure you check the option to send mail
            immediately in your Exchange or Outlook }
          err := MAPISendMail(0,0,lppMapiMessage,0,0);
          if err <> SUCCESS_SUCCESS then
             ShowMessage('Error');
     end;
end;

procedure TfrmMain.btnCancelClick(Sender: TObject);
begin
     Close;
end;

procedure TfrmMain.btnBrowseClick(Sender: TObject);
begin
     txtAttachment.Text := '';
     if AttachmentDlg.Execute then
        txtAttachment.Text := AttachmentDlg.FileName;
end;

end.