User application authentication via Active Directory 1

[mcconmw]

I am looking for any pointers, code samples, and/or documentation on coding Active Directory authentication into an application. I have spent some time on the searching the web, but I haven't been able to locate much of anything that is really applicable.

Scenario:
We are revising an application that is used by multiple users on the same desktop. The desktop is logged onto using a generic account. The application must then be logged onto using a separately maintained account database (Access2000). The users must also enter a username and password to commit all changes so that there is a change log for every transaction. I would like to have the application verify authentication and access against Active Directory rather than have to maintain a separate user database. Thanks in advance.

Mike

 

[vanvb]

I see this has gone unanswered. If you have not already got this figured out, here it is. Some of this is my code but most of it is from others. The code on the cmdAuthenticate button actually authenticates, then checks if the person is a domain admin. You can take out the second part if needed.

Put this on a form:

--------------

Private Sub cmdAuthenticate_Click()
    Dim blnResult As Boolean
    Dim strUserName As String
    Dim strPassword As String
    Dim strDomain As String
On Error Resume Next
    If InStr(1, txtUserName.Text, &quot;@&quot;) <> 0 Then
        strUserName = Left(txtUserName.Text, Len(txtUserName.Text) - (Len(txtUserName) - InStr(1, txtUserName.Text, &quot;@&quot;)) - 1)
    Else
        strUserName = txtUserName.Text
    End If
    strPassword = txtPassword.Text
    If InStr(1, txtUserName.Text, &quot;@&quot;) <> 0 Then
        strDomain = Right(txtUserName.Text, Len(txtUserName.Text) - InStr(1, txtUserName.Text, &quot;@&quot;))
    Else
        strDomain = txtDomain.Text
    End If
    blnResult = LogonUserToAD(strUserName, strPassword, strDomain)
    If blnResult = False Then
        MsgBox &quot;Only Computing Services technicians are authorized to use this program. Click OK to exit.&quot;, vbCritical + vbOKOnly, &quot;Unauthorized User&quot;
        txtPassword.SetFocus
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
    Else
        blnResult = EnumerateUsers(strUserName, &quot;&quot;, &quot;Domain Admins&quot;)
        If blnResult = False Then
            MsgBox &quot;Only Computing Services technicians are authorized to use this program. Click OK to exit.&quot;, vbCritical + vbOKOnly, &quot;Unauthorized User&quot;
            txtPassword.SetFocus
            txtPassword.SelStart = 0
            txtPassword.SelLength = Len(txtPassword.Text)
        Else
            blnAuth = True
            Unload Me
        End If
    End If
End Sub

Private Sub txtUserName_Change()
On Error Resume Next
    If InStr(1, txtUserName.Text, &quot;@&quot;) Then
        txtDomain.Enabled = False
    Else
        txtDomain.Enabled = True
    End If
    
End Sub

------------------
Put this in a module:

Option Explicit

Private Const FILTER_NORMAL_ACCOUNT = &H2

Private Type NETRESOURCE
        dwScope As Long
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        lpLocalName As Long
        lpRemoteName As Long
        lpComment As Long
        lpProvider As Long
End Type

Private Type MungeLong
    X As Long
    dummy As Integer
End Type

Private Type MungeInt
    XLo As Integer
    XHi As Integer
    dummy As Integer
End Type

Private Declare Function NetUserEnum0 Lib "netapi32.dll" Alias "NetUserEnum" (servername As Byte, ByVal level As Long, ByVal lFilter As Long, buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ResumeHandle As Long) As Long
Private Declare Function NetGroupEnumUsers0 Lib "netapi32.dll" Alias "NetGroupGetUsers" (servername As Byte, groupname As Byte, ByVal level As Long, buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ResumeHandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal Ptr As Long) As Long
Private Declare Function NetGetDCName Lib "netapi32.dll" (servername As Byte, DomainName As Byte, buffer As Long) As Long

Private Declare Function PtrToInt Lib "KERNEL32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function PtrToStr Lib "KERNEL32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "KERNEL32" Alias "lstrlenW" (ByVal Ptr As Long) As Long

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" _
      (ByVal lpszUsername As String, _
      ByVal lpszDomain As String, _
      ByVal lpszPassword As String, _
      ByVal dwLogonType As Long, _
      ByVal dwLogonProvider As Long, _
      phToken As Long) As Long

Private Const LOGON32_PROVIDER_DEFAULT As Long = 0&
Private Const LOGON32_PROVIDER_WINNT35 As Long = 1&
Private Const LOGON32_LOGON_INTERACTIVE As Long = 2&
Private Const LOGON32_PROVIDER_WINNT50 As Long = 3&

Private Const LOGON32_LOGON_NETWORK As Long = 3&
Private Const LOGON32_LOGON_BATCH As Long = 4&
Private Const LOGON32_LOGON_SERVICE As Long = 5&
'End AD security declarations

Public Function LogonUserToAD(sUsername As String, sPassword As String, sDomain As String) As Boolean
  On Error Resume Next
  
  Dim p_lngToken As Long
  Dim p_lngRtn As Long
                         
  p_lngRtn = LogonUser(lpszUsername:=sUsername, _
                        lpszDomain:=sDomain, _
                        lpszPassword:=sPassword, _
                        dwLogonType:=LOGON32_LOGON_NETWORK, _
                        dwLogonProvider:=LOGON32_PROVIDER_DEFAULT, _
                        phToken:=p_lngToken)
   
  If p_lngRtn = 0 Then
    LogonUserToAD = False
  Else
    LogonUserToAD = True
  End If
  
End Function



Public Function GetPrimaryDCName(Optional ByVal MachineName As String = "", Optional ByVal DomainName As String = "") As String
    Dim DCName As String, DCNPtr As Long
    Dim DNArray() As Byte
    Dim MNArray() As Byte
    Dim DCNArray(100) As Byte
    Dim Result As Long
    
    MNArray = MachineName & vbNullChar
    DNArray = DomainName & vbNullChar
    Result = NetGetDCName(MNArray(0), DNArray(0), DCNPtr)
    If Result <> 0 Then
        MsgBox &quot;Error: &quot; & Result
        Exit Function
    End If
    Result = PtrToStr(DCNArray(0), DCNPtr)
    Result = NetApiBufferFree(DCNPtr)
    DCName = DCNArray()
    GetPrimaryDCName = DCName
End Function

Public Function EnumerateUsers(strUserName As String, Optional ByVal SName As String = &quot;&quot;, Optional ByVal GName As String = &quot;&quot;) As Long

    ' If a group name is specified, it must be a global group
    ' and not a local group.
    
    ' SName should be &quot;\\servername&quot;

    Dim Result As Long
    Dim bufptr As Long
    Dim entriesread As Long
    Dim totalentries As Long
    Dim ResumeHandle As Long
    Dim buflen As Long
    Dim SNArray() As Byte
    Dim GNArray() As Byte
    Dim UNArray(99) As Byte
    Dim UName As String
    Dim lp As Integer
    Dim TempPtr As MungeLong
    Dim TempStr As MungeInt
    
    EnumerateUsers = 0
    If SName = &quot;&quot; Then SName = GetPrimaryDCName(&quot;&quot;, &quot;&quot;) 'Work from PDC if no machine name provided

    SNArray = SName & vbNullChar       ' Move to byte array
    GNArray = GName & vbNullChar       ' Move to Byte array
    buflen = 1023                      ' Buffer size
    ResumeHandle = 0                   ' Start with the first entry

    ' Keep reading until we've done all entries
    Do
        If GName = &quot;&quot; Then
            Result = NetUserEnum0(SNArray(0), 0, FILTER_NORMAL_ACCOUNT, bufptr, buflen, entriesread, totalentries, ResumeHandle)
        Else
            Result = NetGroupEnumUsers0(SNArray(0), GNArray(0), 0, bufptr, buflen, entriesread, totalentries, ResumeHandle)
        End If
        EnumerateUsers = Result
        If Result <> 0 And Result <> 234 Then    ' 234 means multiple reads                                        ' required
            Debug.Print &quot;Error &quot; & Result & &quot; enumerating user &quot; & entriesread & &quot; of &quot; & totalentries
            If Result = 2220 Then Debug.Print &quot;There is no **GLOBAL** group '&quot; & GName & &quot;'&quot;
            Exit Function
        End If
        
        For lp = 1 To entriesread
            ' Get pointer to string from beginning of buffer
            ' Copy 4-byte block of memory in 2 steps
            Result = PtrToInt(TempStr.XLo, bufptr + (lp - 1) * 4, 2)
            Result = PtrToInt(TempStr.XHi, bufptr + (lp - 1) * 4 + 2, 2)
            LSet TempPtr = TempStr ' munge 2 integers into a Long
            ' Copy string to array
            Result = PtrToStr(UNArray(0), TempPtr.X)
            UName = Left(UNArray, StrLen(TempPtr.X))
            If UName <> &quot;&quot; Then
                If Trim(UCase(UName)) = Trim(UCase(strUserName)) Then
                    EnumerateUsers = 1
                    Exit Do
                End If
            End If
        Next lp
        
     Loop Until entriesread = totalentries

     Result = NetApiBufferFree(bufptr)         ' Don't leak memory

End Function

Hope this helps!