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


					

Imports System.Web.Security
Imports System.Security.Principal
					

Sub Application_AuthenticateRequest(ByVal sender As Object, ByVal e As EventArgs)
        ' Fires upon attempting to authenticate the use
        Dim cookieName As String = FormsAuthentication.FormsCookieName
        Dim authCookie As HttpCookie = Context.Request.Cookies(cookieName)

        If (authCookie Is Nothing) Then
            'There is no authentication cookie.
            Return
        End If

        Dim authTicket As FormsAuthenticationTicket = Nothing

        Try
            authTicket = FormsAuthentication.Decrypt(authCookie.Value)
        Catch ex As Exception
            'Write the exception to the Event Log.
            Return
        End Try

        If (authTicket Is Nothing) Then
            'Cookie failed to decrypt.
            Return
        End If

        'When the ticket was created, the UserData property was assigned a
        'pipe-delimited string of group names.
        Dim groups As String() = authTicket.UserData.Split(New Char() {"|"})

        'Create an Identity.
        Dim id As GenericIdentity = New GenericIdentity(authTicket.Name, "LdapAuthentication")

        'This principal flows throughout the request.
        Dim principal As GenericPrincipal = New GenericPrincipal(id, groups)

        Context.User = principal

    End Sub
					

<%@ Page language="vb" AutoEventWireup="true" %>
<%@ Import Namespace="FormsAuthAd.FormsAuth" %>
<html>
	<body>
		<form id="Login" method="post" runat="server">
			<asp:Label ID="Label1" Runat="server">Domain:</asp:Label>
			<asp:TextBox ID="txtDomain" Runat="server"></asp:TextBox><br>
			<asp:Label ID="Label2" Runat="server">Username:</asp:Label>
			<asp:TextBox ID="txtUsername" Runat="server"></asp:TextBox><br>
			<asp:Label ID="Label3" Runat="server">Password:</asp:Label>
			<asp:TextBox ID="txtPassword" Runat="server" TextMode="Password"></asp:TextBox><br>
			<asp:Button ID="btnLogin" Runat="server" Text="Login" OnClick="Login_Click"></asp:Button><br>
			<asp:Label ID="errorLabel" Runat="server" ForeColor="#ff3300"></asp:Label><br>
			<asp:CheckBox ID="chkPersist" Runat="server" Text="Persist Cookie" />
		</form>
	</body>
</html>
<script runat="server">
sub Login_Click(sender as object,e as EventArgs)
  Dim adPath as String = "LDAP://DC=..,DC=.." 'Path to your LDAP directory server
  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
</script>
					

<%@ Page language="vb" AutoEventWireup="true" %>
<%@ Import Namespace="System.Security.Principal" %>
<html>
	<body>
		<form id="Form1" method="post" runat="server">
			<asp:Label ID="lblName" Runat="server" /><br>
			<asp:Label ID="lblAuthType" Runat="server" />
		</form>
	</body>
</html>
<script runat="server">
sub Page_Load(sender as object, e as EventArgs)
  lblName.Text = "Hello " + Context.User.Identity.Name & "."
  lblAuthType.Text = "You were authenticated using " &   Context.User.Identity.AuthenticationType & "."
end sub
</script>