delphi – 使用简单MAPI TEmail组件进行日志记录时的死锁

我们正在使用免费软件 MAPI/SMAPI实现间歇性死锁.我怀疑实现是否有问题但是可能将登录标志更改为MapiLogon或Exchange上的配置设置可以解决此问题.

Result := MapiLogon(0,LogonProfile,LogonPassword,flLogonFlags,@hSession);

为@J添加了cudo

不鼓励使用Simple MAPI.正确的操作是开始使用扩展MAPI或Outlook对象模型.虽然我同意这一说法,但我没有任何影响力来实现这一点.

当前设置的解决方案或理解为什么会发生死锁的解决方案仍然很难实现.

简而言之

>线程0b60调用MapiLogof
>在logof期间,它等待线程0894
>线程0894等待临界区036c
>临界区036c被线程0b60锁定

僵局

内核转储显示以下关键部分被线程b60锁定并拥有

    CritSec EMSMDB32!ScStatClose+17ac7 at 354650d0
    WaiterWoken        No
    LockCount          1
    RecursionCount     1
    OwningThread       b60
    EntryCount         0
    ContentionCount    1
    *** Locked

线程的0b60调用堆栈

内核线程对象88a53758
注意带参数87fc3c68的KeWaitForSingleObject是线程0894

    b8b4fcec 8093b2e4 87fc3c68 00000006 00000001 nt!KeWaitForSingleObject+0x346 (FPO: [Non-Fpo])
    b8b4fd50 8088b658 00000184 00000000 00000000 nt!NtWaitForSingleObject+0x9a (FPO: [Non-Fpo])
    b8b4fd50 7c82845c 00000184 00000000 00000000 nt!KiSystemServicePostCall (FPO: [0,0] TrapFrame @ b8b4fd64)
    0012f618 7c827b79 77e61d06 00000184 00000000 ntdll!KiFastSystemCallRet (FPO: [0,0])
    0012f61c 77e61d06 00000184 00000000 00000000 ntdll!NtWaitForSingleObject+0xc (FPO: [3,0])
    0012f68c 77e61c75 00000184 ffffffff 00000000 kernel32!WaitForSingleObjectEx+0xac (FPO: [Non-Fpo])
    0012f6a0 3540fc13 00000184 ffffffff 02102150 kernel32!WaitForSingleObject+0x12 (FPO: [Non-Fpo])
    0012f6b4 3540a226 7c81a1a8 3540546f 02102108 EMSMDB32!XPProviderInit+0x58d5
    0012f6bc 3540546f 02102108 00db29c0 0012f6f0 EMSMDB32!MSProviderInit+0x16af6
    0012f6d0 3553ce40 02102108 35411e97 02102108 EMSMDB32!MSProviderInit+0x11d3f
    00000000 00000000 00000000 00000000 00000000 MSMAPI32!UlRelease+0xe
    /* Reconstructed from MAP file */
    0012f878  00422b81 21B81      mailrequestserver+0x22b81      0001:00021B70       MapiLogoff
    0012f894  00423dde 22DDE      mailrequestserver+0x23dde      0001:00022DB0       TEmail.Logoff

线程的0894调用堆栈是

内核线程对象87fc3c68
注意EMSMDB32！ScStatClose调用导致RtlpWaitOnCriticalSection,参数0000036c是线程0b60拥有的关键部分

    0231ff80 7c83d0f7 0000036c 00000004 00000000 ntdll!RtlpWaitOnCriticalSection+0x1a3 (FPO: [Non-Fpo])
    0231ffa0 3544d394 354650d0 00000000 00000001 ntdll!RtlEnterCriticalSection+0xa8 (FPO: [Non-Fpo])
    0231ff98 354650d0                            EMSMDB32!ScStatClose+0x17ac7
    0231ffa4 3544d394                            EMSMDB32!EcUnregisterPushNotification+0x12033
    0231ffa8 354650d0                            EMSMDB32!ScStatClose+0x17ac7
    0231ffb4 3544d114                            EMSMDB32!EcUnregisterPushNotification+0x11db3

题

>调用堆栈显示涉及UnregisterPushNotifications.搜索推送通知,我找不到任何理由为什么我们需要它(我们只是登录,发送邮件和日志)但是,因为这完全发生在MAPI中,我不知道如何阻止呼叫发生.
>如果不能以某种方式忽略/禁用推送通知,那么非常欢迎任何可能导致/解决此问题的指针.

一些额外的信息

>两个线程都属于同一个进程
> MSMAPI32.dll是版本10.0.6861.0
> EMSMDB32.dll是版本10.0.6742.0

来自SMapi.pas的相关代码

function MapiLogoff(lhSession  : LHANDLE;
                    ulUIParam  : ULONG;
                    flFlags    : ULONG;
                    ulReserved : ULONG): ULONG;

function MapiLogon(ulUIParam   : ULONG;
                   lpszName    : PChar;
                   lpszPassword: PChar;
                   flFlags     : ULONG;
                   ulReserved  : ULONG;
                   lplhSession : LPLHANDLE): ULONG;

function MapiSendMail(lhSession  : LHANDLE;
                      ulUIParam  : ULONG;
                      lpMessage  : lpMapiMessage;
                      flFlags    : ULONG;
                      ulReserved : ULONG): ULONG;

procedure InitializeSMAPI;
var
  OldErrorMode: Word;
  OSVersionInfo: TOSVersionInfo;
  RegHandle: HKEY;
  MapiDetectBuf: array[0..8] of Char;
  MapiDetectBufSize: Windows.DWORD;
  RegValueType: Windows.DWORD;
begin
  { first check wether MAPI is available on the system; this is done
    as described in the MS MAPI docs }

  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if (OSVersionInfo.dwMajorVersion > 3) or { NT 4.0 and later }
     { earlier than NT 3.51 }
     ((OSVersionInfo.dwMajorVersion = 3) and (OSVersionInfo.dwMinorVersion > 51)) then
  begin
    if RegOpenKeyEx( HKEY_LOCAL_MACHINE,'SOFTWAREMicrosoftWindows Messaging Subsystem',KEY_READ,RegHandle) <> ERROR_SUCCESS then
    begin
      exit;
    end;

    MAPIDetectBufSize := SizeOf(MAPIDetectBuf);
    if RegQueryValueEx( RegHandle,'MAPI',nil,@RegValueType,PByte(@MAPIDetectBuf),@MAPIDetectBufSize) <> ERROR_SUCCESS then
    begin
      exit;
    end;

    RegCloseKey(RegHandle);

    { "boolean" integer --> is == "1"? }
    if not ((MAPIDetectBuf[0] = '1') and (MAPIDetectBuf[1] = #0)) then
      exit;
  end
  else
    if GetProfileInt('Mail',0) = 0 then { 16 bit and NT 3.51 detection logic }
      Exit;

  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
    DLLHandle := LoadLibrary(DLLName32); { start without .DLL attached }
  { OldErrorMode := } SetErrorMode(OldErrorMode);

  if DLLHandle = 0 then { got an error }
  begin
    OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
    try
      DLLHandle := LoadLibrary(DLLName32DLL);

      if DLLHandle = 0 then
      begin
        exit; { second attempt did not work out either }
      end;

    finally
      { OldErrorMode := } SetErrorMode(OldErrorMode);
    end;
  end;
  begin
    DllInitialized := true;

    @FnMapiFindNext :=    GetProcAddress(DLLHandle,'MAPIFindNext');
    @FnMapiLogoff :=      GetProcAddress(DLLHandle,'MAPILogoff');
    @FnMapiLogon :=       GetProcAddress(DLLHandle,'MAPILogon');
    @FnMapiSendMail :=    GetProcAddress(DLLHandle,'MAPISendMail');
    @FnMapiReadMail :=    GetProcAddress(DLLHandle,'MAPIReadMail');
    @FnMapiDeleteMail :=  GetProcAddress(DLLHandle,'MAPIDeleteMail');
    @FnMapiResolveName := GetProcAddress(DLLHandle,'MAPIResolveName');
    @FnMapiFreeBuffer :=  GetProcAddress(DLLHandle,'MAPIFreeBuffer');
    @FnMapiAddress :=     GetProcAddress(DLLHandle,'MAPIAddress');
    @FnMapiSaveMail :=    GetProcAddress(DLLHandle,'MAPISaveMail');

    if    (@FnMapiAddress     = nil)
       or (@FnMapiFreeBuffer  = nil)
       or (@FnMapiResolveName = nil)
       or (@FnMapiDeleteMail  = nil)
       or (@FnMapiReadMail    = nil)
       or (@FnMapiSendMail    = nil)
       or (@FnMapiLogon       = nil)
       or (@FnMapiLogoff      = nil)
       or (@FnMapiFindNext    = nil)
       or (@FnMapiSaveMail    = nil) then
    begin
      raise EMAPIdllerror.Create(SMapiGetProcAdressFailed);
    end;
  end;
end;

来自Email.pas的相关代码

destructor TEmail.Destroy;
begin
  ...
  try
    if hSession <> 0 then
      Logoff;
  except
  end;
end;
function TEmail.Logon: Integer;
const
  ProfileKey95 = 'SoftwareMicrosoftWindows Messaging SubsystemProfiles';
  ProfileKeyNT = 'SoftwareMicrosoftWindows NTCurrentVersionWindows Messaging SubsystemProfiles';
var
  LogonProfile : PChar;
  LogonPassword: PChar;

  ProfileKey   : PChar;

  Reg : TRegistry;
begin
  CheckMapi;
  Result := SUCCESS_SUCCESS;
  { Check if already logged in. }
  if hSession = 0 then
  begin
    if FUseDefProfile then
    begin
      Reg := TRegistry.Create;
      try
        { get platform (Win95/NT) dependent profile key                }
        {  code added by Ulrik Schoth schoth@krohne.mhs.compuserve.com }
        if Reg.KeyExists(ProfileKeyNT) then
        begin
          ProfileKey := ProfileKeyNT;
        end
        else
        begin
          ProfileKey := ProfileKey95;
        end;

        Reg.Rootkey := HKEY_CURRENT_USER;
        if Reg.OpenKey(ProfileKey,False) then
        begin
          try
            FProfile := Reg.Readstring('DefaultProfile');
          except
            FProfile := '';
          end;
        end;
      finally
        Reg.Free;
      end;
    end;

    LogonProfile := nil;
    LogonPassword := nil;

    try
      if Length(FProfile) > 0 then
      begin
        LogonProfile := StrPCopy(StrAlloc(Length(FProfile)+1),FProfile);
      end;

      if Length(FPassword) > 0 then
      begin
        LogonPassword := StrPCopy(StrAlloc(Length(FPassword)+1),FPassword);
      end;

      DoBeforeLogon;

      Result := MapiLogon(0,@hSession);
      if Result <> SUCCESS_SUCCESS then
        Result := MapiLogon(0,flLogonFlags or MAPI_Logon_UI,@hSession);

      if Result = SUCCESS_SUCCESS then
        DoAfterLogon
      else
        DoMapiError(Result);

    finally
      StrDispose(LogonProfile);
      StrDispose(LogonPassword);
    end;
  end;
end;

function TEmail.SendMailEx(DoSave: boolean): Integer;
var
  MapiMessage   : TMapiMessage;
  MapiRecipDesc : TMapiRecipDesc;
  MapiFileDesc  : TMapiFileDesc;
  lpRecipArray  : TlpRecipArray;
  lpAttachArray : TlpAttachArray;
  lpszPathname  : TlpszPathname;
  lpszFileName  : TlpszFileName;

  szSubject     : PChar;
  szText        : PChar;
  szMessageId   : PChar;
  szMessageType : PChar;

  Attachment    : SString;
  flFlags       : ULONG;
  flLogoff      : Boolean;

  i             : Integer;
  nRecipients   : Integer;
  nAttachments  : Integer;

begin
  CheckMapi;

  {make sure the cleanup does not free garbage }
  lpRecipArray  := nil;
  lpAttachArray := nil;

  flLogoff      := False;

  {check our built-in limits - which have effectively been removed }
  nRecipients := Frecip.Count + FCC.Count + FBCC.Count;
  if nRecipients > RECIP_MAX then
  begin
    Result := MAPI_E_TOO_MANY_RECIPIENTS;

    DoMapiError(Result);

    exit;
  end;

  nAttachments := FAttachment.Count;
  if nAttachments > ATTACH_MAX then
  begin
    Result := MAPI_E_TOO_MANY_FILES;

    DoMapiError(Result);

    exit;
  end;

  { begin the work }
  try

    flLogoff := (hSession = 0);

    { Logon to mail server if not already logged on. }

    if Logon <> SUCCESS_SUCCESS then
    begin
      Result := MAPI_E_LOGIN_FAILURE;

      DoMapiError(Result);

      exit;
    end;


    { Initialise MAPI structures and local arrays. }

    FillChar(MapiMessage,SizeOf(TMapiMessage),0);
    FillChar(MapiRecipDesc,SizeOf(TMapiRecipDesc),0);
    FillChar(MapiFileDesc,SizeOf(TMapiFileDesc),0);

    lpRecipArray  := TlpRecipArray(StrAlloc(nRecipients*SizeOf(TMapiRecipDesc)));
    FillChar(lpRecipArray^,StrBufSize(PChar(lpRecipArray)),0);

    lpAttachArray := TlpAttachArray(StrAlloc(nAttachments*SizeOf(TMapiFileDesc)));
    FillChar(lpAttachArray^,StrBufSize(PChar(lpAttachArray)),0);

    { Fill in subject & message text. }

    szSubject      := nil;
    szText         := nil;
    szMessageId    := nil;
    szMessageType  := nil;

    try
      if Length(FSubject) > 0 then
      begin
        szSubject := StrAlloc(length(FSubject) + 1);
        StrPCopy(szSubject,FSubject);
      end;
      MapiMessage.lpszSubject  := szSubject;

      if Length(FText) > 0 then
      begin
        szText := StrAlloc(length(FText) + 1);
        StrPCopy(szText,FText);
      end;
      MapiMessage.lpszNoteText := szText;

      { for non-IPM messages }
      if Length(FMessageType) > 0 then
      begin
        szMessageType := StrAlloc(Length(FMessageType) + 1);
        StrPCopy(szMessageType,FMessageType);
      end;
      MapiMessage.lpszMessageType := szMessageType;

      if FpLongText <> nil then
        MapiMessage.lpszNoteText := FpLongText;

      { check and fill in recipients if any}
      nRecipients := 0;
      ListToRecipArray(FRecip,MAPI_TO,lpRecipArray,nRecipients);
      ListToRecipArray(FCC,MAPI_CC,nRecipients);
      ListToRecipArray(FBcc,MAPI_BCC,nRecipients);


      MapiMessage.nRecipCount := nRecipients;

      flFlags := 0; { Don't display MAPI Dialog if recipient specified. }

        MapiMessage.lpRecips := @lpRecipArray^;

      { Process file attachments. }

      nAttachments := 0;

      for i := 0 to (Fattachment.Count - 1) do
      begin
        Attachment := CheckAttachment(Fattachment.Strings[i]);
        if Length(Attachment) = 0 then
        begin
          Result := MAPI_E_ATTACHMENT_NOT_FOUND;

          DoMapiError(Result);

          exit;
        end;
        lpAttachArray^[i].nPosition    := Integer($FFFFFFFF);  {Top of message. }
        lpszPathname                   := new(TlpszPathname);
        lpAttachArray^[i].lpszPathName := StrPcopy(lpszPathname^,Attachment);


      { begin code added by MJK }
        lpszFileName                   := new(TlpszFileName);

        { truncate attachment filename if desired }
        if FTruncAttFN then
        begin
          { truncate }
          lpAttachArray^[i].lpszFileName :=
            StrPCopy(lpszFileName^,TruncAttachmentFN(ExtractFileName(Attachment)))
        end
        else
        begin
          { leave alone }
          lpAttachArray^[i].lpszFileName :=
            StrPCopy(lpszFileName^,ExtractFileName(Attachment));
        end;
      {end code added by MJK}

        Inc(nAttachments);
      end;

      MapiMessage.nFileCount := nAttachments;
      if nAttachments > 0 then
      begin
        MapiMessage.lpFiles := @lpAttachArray^;
      end
      else
      begin
        MapiMessage.lpFiles := nil;
      end;

      { receipt requested ? }
      if FAcknowledge then
        MapiMessage.flFlags := MapiMessage.flFlags or MAPI_RECEIPT_REQUESTED;

      { finally send the email message }

      DoBeforeSendMail;

      Result := MapiSendMail(hSession,@MapiMessage,flFlags,0);
      if Result = SUCCESS_SUCCESS then
        DoAfterSendMail
      else
        DoMapiError(Result);


    finally
      StrDispose(szSubject);
      StrDispose(szText);
      StrDispose(szMessageID);
      StrDispose(szMessageType);
    end;

  finally
    { dispose of the recipient & CC name strings }
    if Assigned(lpRecipArray) then
      for i := 0 to (nRecipients - 1) do
      begin
        if Assigned(lpRecipArray^[i].lpszName) then
          Dispose(lpRecipArray^[i].lpszName);

        if Assigned(lpRecipArray^[i].lpszAddress) then
          Dispose(lpRecipArray^[i].lpszAddress);
      end;

    { dispose of the recipient/CC/BCC array }
    StrDispose(PChar(lpRecipArray));

    { dispose of the attachment file name strings }
    if Assigned(lpAttachArray) then
      for i := 0 to (nAttachments - 1) do
      begin
        Dispose(lpAttachArray^[i].lpszPathname);
        Dispose(lpAttachArray^[i].lpszFileName);
      end;

    { dispose of the attachment array }
    StrDispose(PChar(lpAttachArray));

    { Auto logoff,if no session was active. }
    if flLogoff = True then
      Logoff;
  end;

end;

PS.我无法发布转储,它是4GB,但随时可以询问我可能遗漏的任何其他所需细节