验证VB6中的Active Directory用户

我在Visual Basic（VB6）中有一个应用程序，我试图通过Active Directory对用户进行身份验证。验证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

来源

2014-06-09 Roshe

它与其他任何语言一样GE。要么调用适当的Win32 API函数，要么进行AD查询。你甚至可以检查Technet的Scriptomatic是否已准备好制作'vbs'脚本。你有没有尝试过这些东西？ –

谢谢，请参阅我编辑的问题。 – Roshe

顺便说一句，**为什么**你想验证用户？登录的域用户已经通过AD验证，您的应用程序知道它以及您的应用程序试图执行的任何操作使用该用户的凭据。你想模仿另一个域用户吗？ –

您不能使用AD查询来认证用户。这是通过现有的AD连接上的executing an LDAP Bind完成的 - 实质上，您必须创建与最终用户凭据的连接。这就是各种.NET方法在内部执行的操作。

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

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

来源

2014-06-09 08:20:10

但这段代码在同一个域上工作，并验证用户的用户名。你能修改我的代码，以适应我的代码，我对VB 6很新颖吗？ – Roshe

哪里是说“NAME =” &的LoginName”在查询中，你可能想尝试‘sAMAccountName赋= &的LoginName’代替。这为我工作。我发现，在一些LDAP格式信息网站的信息。

来源

2014-08-08 20:24:28

我找到了一个解决方案，当你使用下面的代码在Active Directory中查询UserID时，如果在Active Directory中找不到用户，那么查询将返回“Given Name”值为“”。 do是验证返回的值是否为“”。

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

来源

2016-02-29 19:21:32 Travis

验证VB6中的Active Directory用户

回答

相关问题