我過去的設計都是走獨立SQL帳號密碼管理
但這次的需求是要利用走現有的AD認證，方便使用者不需要記多組帳號密碼
以下直接列出我的實作方式
1.先加入參考
2.直接開一個檔案為LdapAuthentication.vb
完整程式碼如下:
Imports System
Imports System.Text
Imports System.Collections
Imports System.DirectoryServices
Namespace FormsAuth
Public Class LdapAuthentication
Dim _path As String
Dim _filterAttribute As String
Public Sub New(ByVal path As String)
_path = path
End Sub
Public Function IsAuthenticated(ByVal domain As String, ByVal username As String, ByVal pwd As String) As Boolean
Dim domainAndUsername As String = domain & "\" & username
Dim entry As DirectoryEntry = New DirectoryEntry(_path, domainAndUsername, pwd)
Try
'Bind to the native AdsObject to force authentication.
Dim obj As Object = entry.NativeObject
Dim search As DirectorySearcher = New DirectorySearcher(entry)
search.Filter = "(SAMAccountName=" & username & ")"
search.PropertiesToLoad.Add("cn")
Dim result As SearchResult = search.FindOne()
If (result Is Nothing) Then
Return False
End If
'Update the new path to the user in the directory.
_path = result.Path
_filterAttribute = CType(result.Properties("cn")(0), String)
Catch ex As Exception
Throw New Exception("Error authenticating user. " & ex.Message)
End Try
Return True
End Function
Public Function GetGroups() As String
Dim search As DirectorySearcher = New DirectorySearcher(_path)
search.Filter = "(cn=" & _filterAttribute & ")"
search.PropertiesToLoad.Add("memberOf")
Dim groupNames As StringBuilder = New StringBuilder()
Try
Dim result As SearchResult = search.FindOne()
Dim propertyCount As Integer = result.Properties("memberOf").Count
Dim dn As String
Dim equalsIndex, commaIndex
Dim propertyCounter As Integer
For propertyCounter = 0 To propertyCount - 1
dn = CType(result.Properties("memberOf")(propertyCounter), String)
equalsIndex = dn.IndexOf("=", 1)
commaIndex = dn.IndexOf(",", 1)
If (equalsIndex = -1) Then
Return Nothing
End If
groupNames.Append(dn.Substring((equalsIndex + 1), (commaIndex - equalsIndex) - 1))
groupNames.Append("|")
Next
Catch ex As Exception
Throw New Exception("Error obtaining group names. " & ex.Message)
End Try
Return groupNames.ToString()
End Function
End Class
End Namespace
3.Login按鈕
Sub Login_Click(sender as object,e as EventArgs) Handles btnLogin.Click
Dim adPath as String = "LDAP://DC=..,DC=.." 'Path to your LDAP directory server
'LDAP 輸入方式再請另外自己GOOGLE填寫方式
Dim adAuth as LdapAuthentication = new LdapAuthentication(adPath)
try
if(true = adAuth.IsAuthenticated(txtDomain.Text, txtUsername.Text, txtPassword.Text)) then
Dim groups as string = adAuth.GetGroups()
'Create the ticket, and add the groups.
Dim isCookiePersistent as boolean = chkPersist.Checked
Dim authTicket as FormsAuthenticationTicket = new FormsAuthenticationTicket(1, _
txtUsername.Text,DateTime.Now, DateTime.Now.AddMinutes(60), isCookiePersistent, groups)
'Encrypt the ticket.
Dim encryptedTicket as String = FormsAuthentication.Encrypt(authTicket)
'Create a cookie, and then add the encrypted ticket to the cookie as data.
Dim authCookie as HttpCookie = new HttpCookie(FormsAuthentication.FormsCookieName, encryptedTicket)
if(isCookiePersistent = true) then
authCookie.Expires = authTicket.Expiration
end if
'Add the cookie to the outgoing cookies collection.
Response.Cookies.Add(authCookie)
'You can redirect now.
Response.Redirect(FormsAuthentication.GetRedirectUrl(txtUsername.Text, false))
else
errorLabel.Text = "Authentication did not succeed. Check user name and password."
end if
catch ex as Exception
errorLabel.Text = "Error authenticating. " & ex.Message
end try
End sub
文章參考
vb.net開發的login程式(win form),帳號要如何與AD帳號整合?
https://social.msdn.microsoft.com/Forums/zh-TW/5fe87afe-340a-41eb-bab4-a8707400a9a3/vbnetloginwin-formad?forum=232
如何使用表單驗證及 Visual Basic .NET 通過 Active Directory 驗證
https://support.microsoft.com/zh-tw/help/326340/how-to-authenticate-against-the-active-directory-by-using-forms-authen