请问调用默认邮件发送程序，发送指定附件

Question

怎么样才有实现调用默认邮件发送程序，并把指定的文件当成附件发送呢？

Answer 1

function SendEmail(Handle: THandle; Mail: TStrings): Cardinal;
//调用MAPI发送Email
type
  TAttachAccessArray = array [0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage : TMapiMessage;
  Receip : TMapiRecipDesc;
  Attachments : PAttachAccessArray;
  AttachCount : Integer;
  iCount : Integer;
  FileName : string;
begin
  FillChar(MapiMessage, SizeOf(MapiMessage), #0);
  Attachments := nil;
  FillChar(Receip,SizeOf(Receip), #0);
  if Mail.Values['to'] <> '' then begin
    Receip.ulReserved := 0;
    Receip.ulRecipClass := MAPI_TO;
    Receip.lpszName := StrNew(PChar(Mail.Values['to']));
    Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
    Receip.ulEIDSize := 0;
    MapiMessage.nRecipCount := 1;
    MapiMessage.lpRecips := @Receip;
  end;  AttachCount := 0;
  for iCount := 0 to MaxInt do begin
    if Mail.Values['attachment' + IntToStr(iCount)] = '' then Break;
    AttachCount := AttachCount + 1;
  end;  if AttachCount > 0 then begin
    GetMem(Attachments,SizeOf(TMapiFileDesc) * AttachCount);
    for iCount := 0 to (AttachCount - 1) do begin
      FileName := Mail.Values['attachment' + IntToStr(iCount)];
      Attachments[iCount].ulReserved := 0;
      Attachments[iCount].flFlags := 0;
      Attachments[iCount].nPosition := ULONG($FFFFFFFF);
      Attachments[iCount].lpszPathName := StrNew(PChar(FileName));
      Attachments[iCount].lpszFileName := StrNew(PChar(ExtractFileName(FileName)));
      Attachments[iCount].lpFileType := nil;
    end;
    MapiMessage.nFileCount := AttachCount;
    MapiMessage.lpFiles := @Attachments^;
  end;  if Mail.Values['subject'] <> '' then
    MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
  if Mail.Values['body'] <> '' then
    MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));  Result := MapiSendMail(0, Handle, MapiMessage, MAPI_DIALOG*Ord(Handle <> 0) OR MAPI_LOGON_UI OR MAPI_NEW_SESSION, 0);  for iCount := 0 to (AttachCount - 1) do begin
    strDispose(Attachments[iCount].lpszPathName);
    strDispose(Attachments[iCount].lpszFileName);
  end;  if assigned(MapiMessage.lpszSubject) then
    strDispose(MapiMessage.lpszSubject);
  if assigned(MapiMessage.lpszNoteText) then
    strDispose(MapiMessage.lpszNoteText);
  if assigned(Receip.lpszAddress) then
    strDispose(Receip.lpszAddress);
  if assigned(Receip.lpszName) then
    strDispose(Receip.lpszName);
end;
////////////////////////////////////////////////////////////////
procedure TFrmPrintReport.FlatButton3Click(Sender: TObject);
var
  mail : TStringList;
  body : string;
begin
  //邮寄
  EmailAdderss := SYSDM.SysInfo.Fieldbyname('Email').AsString ;  if not FileExists(ReportAllName) then
  begin
    MSShow('Excel报表'+ReportName+'不存在,请重新生成后再发送邮件!');
    exit;
  end;  mail := TStringList.Create;
  try
    //以下邮箱
    mail.Values['to'] := EmailAdderss;
    //以下主题
    mail.Values['subject'] := ReportName;
    //以下内容
    body := '';
    mail.Values['body'] := body;
    //以下附件
    mail.Values['attachment0'] := ReportAllName;    SendEmail(Application.Handle, mail);
  finally
    mail.Free;
  end;end;