Code:
Imports System.DirectoryServices
Imports System.Net.Mail
Public Class Authenticate_With_Active_Directory
Private Sub OK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK.Click
Dim isauthenticated As Boolean = AuthenticateUser()
If isauthenticated Then
ProgressBar1.Value = 1
Timer1.Enabled = True
'MsgBox("YOU HAVE BEEN AUTHENTICATED")
Dim frm As New Main_Menu
frm.Show()
Me.Close()
Else
ProgressBar1.Value = 1
Timer1.Enabled = True
MessageBox.Show("YOU HAVE NOT BEEN AUTHENTICATED" & _
Environment.NewLine & Environment.NewLine & "PLEASE CONTACT THE LONDON SYSTEMS TEAM. THIS LOGON ATTEMPT HAS BEEN RECORDED", "Alert - PLEASE READ , PLEASE READ", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
ProgressBar1.Value = ProgressBar1.Value + 1
If ProgressBar1.Value = 50 Then
Timer1.Enabled = False
'MsgBox(" progressbar at the end")
End If
End Sub
Private Function ValidateActiveDirectoryLogin(ByVal Domain As String, ByVal Username As String, ByVal Password As String) As Boolean
Dim Success As Boolean = False
Dim Entry As New System.DirectoryServices.DirectoryEntry("LDAP://" & Domain, Username, Password)
Dim Searcher As New System.DirectoryServices.DirectorySearcher(Entry)
Searcher.SearchScope = DirectoryServices.SearchScope.OneLevel
Try
Dim Results As System.DirectoryServices.SearchResult = Searcher.FindOne
Success = Not (Results Is Nothing)
Catch
Success = False
End Try
Return Success
End Function
Private Function AuthenticateUser() As Boolean
Dim username As String = UsernameTextBox.Text
Dim password As String = PasswordTextBox.Text
'Dim domain As String = 'this can be in a config file, hard coded (I wouldnt do that), or inputed from the UI
Dim domain As String = "WITHERS.NET"
Dim isAuthenticated As Boolean = ValidateActiveDirectoryLogin(domain, username, password)
Return isAuthenticated
End Function
Private Sub Cancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cancel.Click
Me.Close()
End Sub
Private Sub AuthenticateWithAD_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim screenSize As Rectangle = Screen.PrimaryScreen.Bounds
If screenSize.Width < 1024 Or screenSize.Height < 768 Then
MessageBox.Show("Incorrect Screen Size" & _
Environment.NewLine & Environment.NewLine & "This Application requires a Screen Resolution of 1024 x 768 and above. Please change", "Alert - PLEASE READ , PLEASE READ", MessageBoxButtons.OK, MessageBoxIcon.Information)
Me.Close()
Else
End If
'You grab the current logon username from environment object
Dim userID As String = Environment.UserName
'Then pass it into the function like this
If IsMemberOf(userID, "GROUP NAME YOU WANT TO CHECK") Then
'MessageBox.Show("Yes")
Else
MessageBox.Show("Unauthorised Access, You do not have permission to use this application" & _
Environment.NewLine & Environment.NewLine & "Please contact the London Systems Team", "Alert - UNAUTHORISED ACCESS , UNAUTHORISED ACCESS", MessageBoxButtons.OK, MessageBoxIcon.Information)
Me.Close()
End If
End Sub
Public Shared Function IsMemberOf(ByVal userName As String, ByVal groupName As String) As Boolean
' Uncomment if using at Withers
Dim answer As Boolean = False
Dim dirEntry As DirectoryEntry = Nothing
Dim serverName As String = "SERVER NAME" 'example "server1"
Dim domainName As String = "DOMAIN NAME" 'example "yahoo", "msn", "google"...
Dim domain As String = "NET" 'example "com", "org", "net"...
Dim ldapPath As String = "LDAP://" & serverName & "/DC=" & domainName & ",DC=" & domain
Dim dirSearcher As DirectorySearcher = Nothing
Dim result As SearchResult = Nothing
Try
'dirEntry = New DirectoryEntry(ldapPath)
'If you run into security permission issue, try this overload with supplied credentials
dirEntry = New DirectoryEntry(ldapPath, "USERNAME", "PASSWORD", AuthenticationTypes.Secure)
dirSearcher = New DirectorySearcher(dirEntry)
With dirSearcher
.Filter = "(SAMAccountName=" & userName & ")"
.PropertiesToLoad.Add("memberOf")
result = .FindOne()
End With
If Not result Is Nothing Then
Dim propertyCount As Integer = result.Properties("memberOf").Count
Dim dn As String = String.Empty
Dim group As String = String.Empty
Dim equalsIndex, commaIndex As Integer
Dim propertyCounter As Integer = 0
While propertyCounter < propertyCount
dn = CType(result.Properties("memberOf").Item(propertyCounter), String)
equalsIndex = dn.IndexOf("=", 1)
commaIndex = dn.IndexOf(",", 1)
If -1 = equalsIndex Then
Return False
End If
group = dn.Substring((equalsIndex + 1), (commaIndex - equalsIndex) - 1).ToUpper
If group = groupName.ToUpper Then
answer = True
Exit While
End If
propertyCounter += 1
End While
End If
Catch ex As Exception
Throw New Exception(ex.Message)
Finally
'Release unmanaged COM objects
dirEntry = Nothing
dirSearcher = Nothing
End Try
Return answer
End Function
End Class