vba 在 VB6 中验证 Active Directory 用户
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24115501/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Validate Active Directory users in VB6
提问by vml19
I have an application in Visual Basic(VB6) and I'm trying to authenticate users by Active Directory.
我在 Visual Basic(VB6) 中有一个应用程序，我正在尝试通过 Active Directory 对用户进行身份验证。
Is it possible to validate the user name and password?
是否可以验证用户名和密码？
I am using the following code to validate, but I do not know how to add password also to validate a user.
我正在使用以下代码进行验证，但我不知道如何添加密码来验证用户。
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
回答by Panagiotis Kanavos
You can't use an AD query to authenticate a user. This is done by executing an LDAP Bindon an existing AD connection - essentially you have to to create a connection with the end user's credentials. That's what the various .NET methods do internally.
您不能使用 AD 查询对用户进行身份验证。这是通过在现有 AD 连接上执行 LDAP 绑定来完成的- 本质上，您必须使用最终用户的凭据创建连接。这就是各种 .NET 方法在内部所做的。
You can use the same technique in COM/VB, by setting the end-user's credentials to the ADO connection before opening.
您可以在 COM/VB 中使用相同的技术，方法是在打开之前将最终用户的凭据设置为 ADO 连接。
Incidentally, your current code attempts to execute a query using the current user's credentials. This will fail unless there is trust between the two domains and the remote domain recognizes the current user.
顺便说一下，您当前的代码尝试使用当前用户的凭据执行查询。除非两个域之间存在信任并且远程域识别当前用户，否则这将失败。
回答by Marty Carangelo
Where is says "name=" & LoginName" in the query, you may want to try "sAMAccountName= & LoginName" instead. That worked for me. I found the information in some LDAP format information website.
查询中哪里显示“name="& LoginName”，您可能想尝试使用“sAMAccountName= & LoginName”。这对我有用。我在一些 LDAP 格式信息网站上找到了该信息。
回答by Travis
I found a solution for this. When you query the UserID in Active Directory using the code below, if the user is not found in Active Directory then the query will return a "Given Name" value of "". So all you have to do is validate whether or not the returned value is "".
我为此找到了解决方案。当您使用以下代码在 Active Directory 中查询用户 ID 时，如果在 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
