الوصول الى Exchange Server

يعطيكم العافيه هذا الحل

Imports System.DirectoryServices

Public Class LoginForm1

Dim blnAuthenticated As Boolean

Private Sub OK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK.Click

'Me.Close()

blnAuthenticated = AuthenticateUser(GetDomainName(), UsernameTextBox.Text.Trim, PasswordTextBox.Text.Trim)

If blnAuthenticated Then

MsgBox("True")

Else

MsgBox("False")

End If

End Sub

Private Sub Cancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cancel.Click

MsgBox(GetComputerName())

Me.Close()

End Sub

Public Function AuthenticateUser(ByVal strDomain As String, ByVal strLoginName As String, ByVal strPassword As String) As Boolean

Dim blnAuthenticated As Boolean = False

Try

Dim dsDirectoryEntry As New DirectoryEntry("LDAP://" & strDomain, strLoginName, strPassword)

Dim dsSearch As DirectorySearcher = New DirectorySearcher(dsDirectoryEntry)

Dim dsResults As SearchResult

dsResults = dsSearch.FindOne

blnAuthenticated = True

Catch ex As Exception

'Exception is thrown if user login or password is invalid

'MessageBox.Show(ex.Message)

blnAuthenticated = False

End Try

Return blnAuthenticated

End Function

Public Function GetDomainName() As String

Dim strDomain As String

strDomain = System.Security.Principal.WindowsIdentity.GetCurrent.Name

strDomain = Mid(strDomain, 1, InStr(strDomain, "\") - 1)

Return strDomain

End Function

Public Function GetComputerName() As String

Return System.Environment.MachineName

End Function

End Class