Question

我在Visual Basic（VB6）中有一个应用程序，我正在尝试通过Active Directory对用户进行身份验证。

是否可以验证用户名和密码？

我使用以下代码进行验证，但我不知道如何添加密码以验证用户。

Public Function FindUserGroupInfo(LoginName As String, GroupName As String) As Boolean
' Searches for a user within a specified group in Active Directory.
' Returns TRUE if the user is found in the specified group.
' Returns FALSE if the user is not found in the group.

    ' LDAP Search Query Properties
    Dim conn As New ADODB.Connection    ' ADO Connection
    Dim rs As ADODB.Recordset           ' ADO Recordset
    Dim oRoot As IADs
    Dim oDomain As IADs
    Dim sBase As String
    Dim sFilter As String
    Dim sDomain As String
    Dim sAttribs As String
    Dim sDepth As String
    Dim sQuery As String
    Dim sAns As String

    ' Search Results
    Dim user As IADsUser
    Dim group As Variant
    Dim usergroup As String
    Dim userGroupFound As Boolean

    On Error GoTo ErrHandler:

    userGroupFound = False

    'Set root to LDAP/ADO.
    'LDAP://skb_ii.com/DC=skb_ii,DC=com
    Set oRoot = GetObject("LDAP://rootDSE")

    'Create the Default Domain for the LDAP Search Query
    sDomain = oRoot.Get("defaultNamingContext")
    Set oDomain = GetObject("LDAP://" & sDomain)
    sBase = "<" & oDomain.ADsPath & ">"

    ' Set the LDAP Search Query properties
    sFilter = "(&(objectCategory=person)(objectClass=user)(name=" & LoginName & "))"
    sAttribs = "adsPath"
    sDepth = "subTree"
    sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

    ' Open the ADO connection and execute the LDAP Search query
    conn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
    Set rs = conn.Execute(sQuery)   ' Store the query results in recordset

    ' Display the user details
    If Not rs.EOF Then
        Set user = GetObject(rs("adsPath"))

        ' Display the groups memberships
        For Each group In user.Groups
            usergroup = group.Name

            If (InStr(usergroup, GroupName) > 0) Then
                FindUserGroupInfo = True
                Exit Function
            End If
        Next
    End If
    FindUserGroupInfo = userGroupFound
ErrHandler:

    On Error Resume Next
    If Not rs Is Nothing Then
        If rs.State <> 0 Then rs.Close
        Set rs = Nothing
    End If

    If Not conn Is Nothing Then
        If conn.State <> 0 Then conn.Close
        Set conn = Nothing
    End If

    Set oRoot = Nothing
    Set oDomain = Nothing
End Function

Answer 1

您无法使用AD查询对用户进行身份验证。这是由executing an LDAP Bind在现有AD连接上完成的 - 基本上您必须使用最终用户的凭据创建连接。这就是各种.NET方法在内部的作用。

您可以在COM / VB中使用相同的技术，方法是在打开之前将最终用户的凭据设置为ADO连接。

顺便提一下，您当前的代码尝试使用当前用户的凭据执行查询。除非两个域之间存在信任且远程域识别当前用户，否则这将失败。

Answer 2

在哪里说＆＃34; name =＆＃34; ＆安培; LoginName将＆＃34;在查询中，您可能想尝试＆＃34; sAMAccountName =＆amp; LoginName将＆＃34;代替。这对我有用。我在一些LDAP格式信息网站上找到了这些信息。

Answer 3

我找到了解决方案。使用下面的代码在Active Directory中查询UserID时，如果在Active Directory中找不到该用户，则查询将返回“给定名称”值“”。因此，您所要做的就是验证返回值是否为“”。

Public Sub TestSub()
Dim strMyUser As String

strMyUser = "AB66851"

If Validation.GetName(strMyUser) <> "" Then
    MsgBox GetName(strMyUser)
Else
    MsgBox strMyUser & " Is not a valid Active Directory ID"
End If

End Sub



Function GetName(strMgrID As String) As String

Dim objRoot, strDomain, objConn, objComm, objRecordset
Dim sFilter, sAttribs, sDepth, sBase, sQuery

Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objConn = CreateObject("ADODB.Connection")
Set objComm = CreateObject("ADODB.Command")

'sFilter = "(&(objectClass=person)(sn=" & InputBox("Enter Last Name") & ")(givenName=" & InputBox("Enter First Name") & "))"
sFilter = "(&(objectClass=person)(sAMAccountName=" & strMgrID & "))"

sAttribs = "sn,givenname,sAMAccountName"
sDepth = "SubTree"
sBase = "<LDAP://" & strDomain & ">"
sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

objConn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
Set objComm.ActiveConnection = objConn
objComm.Properties("Page Size") = 10000
objComm.CommandText = sQuery
Set objRecordset = objComm.Execute

If Not objRecordset.EOF Then
    GetName = objRecordset("givenName") & " " & objRecordset("sn")
End If
End Function

在VB6中验证Active Directory用户

3 个答案: