从X400地址得到SMTP地址

 

The information in this article applies to:

-         Microsoft Outlook 2000,2002,XP,2003

 

对于Outlook邮件中的收件人一栏，如果收件人属于公司内部用户，直接用MailItem.Recipents.Item(nRecipentIndex).Address字段得到的邮件地址是X400地址，要求转换为SMTP邮件地址。

 

我经过试验，有以下两种办法做这种转换：

第一个：使用共享软件Redemption；

第二个：直接用ADO在Active Directory中查询。

 

对于第一种办法，需要像注册普通COM组件一样注册Redemption.DLL。

这个组件可以在

http://www.dimastr.com/redemption/

下载。

但是，这个组件分为两种版本：Developer Version和Distributable Version。前者不允许从事商业行为，后者购买需要199美元。

使用它得到SMTP邮件地址的办法在

http://www.outlookcode.com/d/code/getsenderaddy.htm#redemption

说得很明白了，我下面只是给出一个类似的R_GetSenderAddress方法：

Private Function R_GetSenderAddress(ByRef oSafeMailItem, ByVal nRecipentIndex) As String

  Dim strType

  Dim objSenderAE As Redemption.AddressEntry

 

  Const PR_SENDER_ADDRTYPE = &HC1E001E

  Const PR_EMAIL = &H39FE001E

 

  Set objSenderAE = oSafeMailItem.Recipients.Item(nRecipentIndex).AddressEntry

  If Not objSenderAE Is Nothing Then

    strType = objSenderAE.Type

    If strType = "SMTP" Then

      R_GetSenderAddress = objSenderAE.Address

    ElseIf strType = "EX" Then

      R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)

    End If

   End If

 

   Set objSenderAE = Nothing

End Function

 

对于第二种办法，可能麻烦一点，其运行效率还和Active Directory有关。由于这种ADO Query AD原理非常简单，所以我就直接用代码说明了：

' 方法解释：

' 方法名：R_GetSenderAddress

' 功能：从X400的邮件地址解析出用户的SMTP邮件地址

' 由于Exchange Server User的邮件地址类型是EX，而且展现为

' /O=TOMORROW/OU=TRT/CN=RECIPIENTS/CN=Zhengyun

' 形式。

' 我们需要把这个地址转换为SMTP地址，但是由于OutlookLibrary并没有提供这一功能，

' 所以我必须自己去AD查询了

Private Function R_GetSenderAddress(ByRef strX400Address) As String

    Dim oRootDSE 'As IADs

    Dim objUser  ' As IADsUser

    '

    ' 以下注意，connection,command对象不能用createobject创建，否则查询不出来

    ' 只能new了!

    Dim oConnection As New ADODB.Connection

    Dim oCommand As New ADODB.Command

    '

    Dim RS  ' As ADODB.Recordset

    Dim strQuery As String, strAlias As String

    Dim varDomainNC As Variant

       

    On Error Resume Next

    ' To do: change to the alias for the mailbox you are looking for.

    Dim arrX400

    arrX400 = Split(UCase$(strX400Address), "/CN=")

   

    ' 取到最后的用户的姓名:

    strAlias = arrX400(UBound(arrX400))

   

    If Len(strAlias) > 0 Then

        ' Get the Configuration Naming Context.

        Set oRootDSE = GetObject("LDAP://RootDSE")

        varDomainNC = oRootDSE.Get("defaultNamingContext")

        ' Open the Connection

        oConnection.Provider = "ADsDSOObject"

        oConnection.Open "ADs Provider"

       

        ' Build the query to find the user based on their alias.

        strQuery = ";(mailNickName=" & strAlias & ");adspath;subtree"

       

        oCommand.ActiveConnection = oConnection

        oCommand.CommandText = strQuery

        Set RS = oCommand.Execute

       

        If RS.RecordCount = 0 Then

            R_GetSenderAddress = ""

        Else

            ' Iterate through the results.

            Do

                Set objUser = GetObject(RS.Fields("adspath"))

                ' 拿到了他的真正SMTP邮件地址:

                R_GetSenderAddress = objUser.EmailAddress

                Set objUser = Nothing

                Exit Do

            Loop While RS.EOF

          End If

    Else

        R_GetSenderAddress = ""

    End If

   

    Set oRootDSE = Nothing

    Set oCommand = Nothing

    Set oConnection = Nothing

    Set RS = Nothing

    On Error GoTo 0

End Function

 

 

Writen by zhengyun.NoJunk(at)gmail.dot.com

Disclaimers：

Programmer’s Blog List：

博客堂

小气的神

ASPCOOLBlog

博客园

Don Box's Blog

Eric.Weblog()

The .NET Guy

[e-mail]

 

本文档仅供参考。本文档所包含的信息代表了在发布之日，zhengyun对所讨论问题的当前看法，zhengyun不保证所给信息在发布之日以后的准确性。

用户应清楚本文档的准确性及其使用可能带来的全部风险。可以复制和传播本文档，但须遵守以下条款：

1. 复制时不得修改原文，复制内容须包含所有页 ；
2. 所有副本均须含有 zhengyun的版权声明以及所提供的其它声明 ；
3. 不得以赢利为目的对本文档进行传播 。

 

Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=36393