驗證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用戶

回答

相關問題