Question

我已将Microsoft Office从2016版更新到2019版。之后，我的Delphi-Program无法打开新的Outlook邮件窗口。该程序通过Winapi.Mapi使用SimpleMapi来启动Outlook。

Outlook App设置为用于发送邮件的标准应用程序。 Windows注册表不像以前那样在标准中包含MAPI-Key。我试图将以下MAPI密钥添加到Windows注册表中，但是没有成功。

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Messaging Subsystem]
"MAPI"="1"
"MAPIX"="1"
"OLEMessaging"="1"
"CMC"="1"
"MAPIXVER"="1.0.0.1"
"CMCDLLNAME32"="mapi32.dll"

我尝试此操作的原因是Winapi.Mapi在HKLM \ Software \ Microsoft \ Windows Messaging子系统中搜索MAPI密钥以加载设置的标准邮件应用程序的MAPI32.dll。如果Winapi.Mapi尝试加载MAPI，则MAPI可能不可用。备注：“ mailto”功能正常。

因此，我的程序可以与Microsoft Office的较早版本（如2016年及更早版本）一起正常工作，但不适用于2019版本。问题是：失败的原因是什么？是注册表配置的原因还是Embarcadero库被淘汰了？

我希望问题描述足够清楚。希望你能帮助我。

Answer 1

unit uAutomationSendMessage;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

function SendMessageViaOLE(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               Recipients : TStringList = nil;
                               AttachList : TStringList = nil) : Integer;
function AutomationSendMessage(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               recipients : TStringList = nil;
                               AttachList : TStringList = nil) : Integer; OverLoad;
function AutomationSendMessage(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               recipients : String = '';
                               AttachFile : String = '') : Integer; OverLoad;

implementation

uses
  OutlookSecMan,
  Outlook2010,
  ComObj,
  ole;

procedure SleepForXXXMiliSecend(MiliSecunda : Integer);
Var
  CurTime  : Integer;
  UntilMax : Integer;
begin
  UntilMax := Trunc(MiliSecunda / 10);
  if UntilMax < 5 then
    UntilMax := 5;
  For CurTime := 0 to UntilMax Do
  begin
    Sleep(05);  {10 cose it work more then excepted}
    Application.ProcessMessages;
  end;
end;


function SendMessageViaOLE(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               Recipients : TStringList = nil;
                               AttachList : TStringList = nil) : Integer;
const
  olMailItem = 0;
var
  OlSecurityManager: TOlSecurityManager;
  CurItem   : Integer;
  Outlook   : OLEVariant;
  MailItem  : Variant;
  OLCreated : Boolean;
begin
  Try
    OlSecurityManager:= TOlSecurityManager.Create(Application);
    OLCreated := False;
    try
      Outlook := GetActiveOleObject('Outlook.Application') ;
    except
      Outlook := CreateOleObject('Outlook.Application') ;
      OLCreated := True;
    end;
    SleepForXXXMiliSecend(100);
    MailItem := Outlook.CreateItem(olMailItem) ;
    SleepForXXXMiliSecend(100);
    //MailItem.Recipients.Add('johndoe@hotmail.com') ;
    MailItem.Subject := Subject;
    if UseHtml then
      MailItem.HTMLBody := Body
    else
      MailItem.Body := Body;
    if Assigned(Recipients) then
    begin
      for CurItem := 0 to Recipients.Count - 1 do
        if Trim(Recipients.Strings[CurItem]) <> '' then
          MailItem.Recipients.Add(Recipients.Strings[CurItem]);
    end;

    if Assigned(AttachList) then
    begin
      for CurItem := 0 to AttachList.Count - 1 do
        if Trim(AttachList.Strings[CurItem]) <> '' then
          MailItem.Attachments.Add(AttachList.Strings[CurItem]);
    end;
    MailItem.Display(False); //True=Send Immedeate

    SleepForXXXMiliSecend(100);
    If OLCreated Then
      VarClear(Outlook);
  Finally
    OlSecurityManager.DisableOOMWarnings := False;
  End;
end;

function AutomationSendMessage(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               Recipients : TStringList = nil;
                               AttachList : TStringList = nil) : Integer;
const
  olMailItem = 0;
  olByValue = 1;
Var
  CurTest   : Integer;
  CurItem   : Integer;
  //Outlook   : OleVariant;
  Outlook: Outlook2010.TOutlookApplication;
  OlSecurityManager: TOlSecurityManager;
  vMailItem : variant;
  mRecipient, mSubject, mBody, mAttachement: String;
Begin
  Result := -99;
  Try
    OlSecurityManager:= TOlSecurityManager.Create(Application);
    //Try
    //  Outlook := GetActiveOleObject('Outlook.Application');
    //Except;
    //  Outlook := CreateOleObject('Outlook.Application');
    //End;
    Outlook := TOutlookApplication.Create(nil);
    OlSecurityManager.ConnectTo(Outlook.Application);
    OlSecurityManager.DisableOOMWarnings := True;
    vMailItem := Outlook.CreateItem(olMailItem);
    SleepForXXXMiliSecend(20); // avoid Call was rejected by callee.
    //vMailItem.Recipients.Add('test@hanibaal.co.il');
    For CurTest := 0 To 10 Do
    begin
      Try
        vMailItem.Subject := Subject;
        Break;
      Except;
        // wait somw more for prevent - Call was rejected by callee.
        SleepForXXXMiliSecend(20); // avoid Call was rejected by callee.
      End;
    end;

    if UseHtml then
      vMailItem.HTMLBody := Body
    else
      vMailItem.Body := Body;

//MailItem.Recipients.Add('someone@yahoo.com'); // Type=1 olTo
//MailItem.Recipients.Add('joesmoe@yahoo.com').Type := 2; // olCC
//MailItem.Recipients.Add('alice@yahoo.com').Type := 3; // olBCC
    if Assigned(Recipients) then
    begin
      for CurItem := 0 to Recipients.Count - 1 do
        if Trim(Recipients.Strings[CurItem]) <> '' then
          vMailItem.Recipients.Add(Recipients.Strings[CurItem]);
    end;

    if Assigned(AttachList) then
    begin
      for CurItem := 0 to AttachList.Count - 1 do
        if Trim(AttachList.Strings[CurItem]) <> '' then
          vMailItem.Attachments.Add(AttachList.Strings[CurItem]);
    end;

    Try
      IF ShowModal Then
      begin
        IF vMailItem.display(True) Then
        begin
          Result := 0 {Message sent}
        end;
      end
      else
      begin
        //vMailItem.Send;
        IF vMailItem.display(False) Then
        begin
          Result := 0 {Message sent}
        end;
      end;
    Except
      on e : System.SysUtils.Exception do
      begin
        Result := 1; {Message not sent}
        ShowMessage('Sending mail fail - ' + e.Message);
      end;
    End;
  Finally
    OlSecurityManager.DisableOOMWarnings := False;
    Try OlSecurityManager.Free; Except; End;
    VarClear(vMailItem);
    Outlook := nil;
  end;
end;

function AutomationSendMessage(Subject    : WideString;
                               Body       : WideString;
                               UseHtml    : Boolean = False;
                               ShowModal  : Boolean = True;
                               recipients : String = '';
                               AttachFile : String = '') : Integer;
Var
  recipientsList : TStringList;
  AttachListList : TStringList;
begin
  recipientsList := TStringList.Create;
  AttachListList := TStringList.Create;
  Try
    recipientsList.Add(recipients);
    AttachListList.Add(AttachFile);
    result := AutomationSendMessage(Subject,
                                    Body,
                                    UseHtml,
                                    ShowModal,
                                    recipientsList,
                                    AttachListList);
  Finally
    recipientsList.Free;
    AttachListList.Free;
  End;
end;

end.

如何通过Delphi Winapi.Mapi修复“发送电子邮件”？

1 个答案: