I have this code at the moment that authenticates a user and tries to retrieve the current authenticated users playlist but the request is inavlid and the error is as so
Execution of request failed:
http://gdata.youtube.com/feeds/api/users/xx_xxx_x#hotmail.com/playlists
Public Function GetRequest(ByVal username As String, ByVal password As String) As YouTubeRequest
Dim youtubeSettings = New YouTubeRequestSettings("test", DeveloperKey, username, password)
Dim youtubeRequest As New YouTubeRequest(youtubeSettings)
Return youtubeRequest
End Function
Public Function GetUserPlaylists(ByVal username As String, ByVal password As String)
Dim youtubeRequest As YouTubeRequest = Me.GetRequest(username, password)
Try
Dim userPlaylists As Feed(Of Playlist) = youtubeRequest.GetPlaylistsFeed(username)
If True Then
End If
Catch ex As Exception
End Try
End Function
Dim youtubeRequest As YouTubeRequest = Me.GetRequest(username, password)
Dim url As String = "https://gdata.youtube.com/feeds/api/users/default/playlists?v=2"
Try
Dim feedQuery As New FeedQuery(url)
Dim userPlaylists As Feed(Of Playlist) = youtubeRequest.Get(Of Playlist)(feedQuery)
If True Then
End If
Catch ex As Exception
End Try
End Function
Related
I have a website that is designed to multi-tiered. My code works, but I have noticed that the larger my app becomes, the more SQL database connections start to stack up and remain open. This eventually causes this error:
System.InvalidOperationException: 'Timeout expired. The timeout
period elapsed prior to obtaining a connection from the pool. This
may have occurred because all pooled connections were in use and max
pool size was reached.'
My code is split into 3 layers. They are:
Application layer. Every time it wants to CRUD, is calls the Business Layer.
Business Layer - does business logic. When it wants to interface with the MS SQL db, it connects via ConnectionAdapter layer.
The ConnectionAdapter inherits from a SqlConnectionAdapter class and does the actual db interactions.
The following is pseudo code for each:
Application
My application may call the business layer multiple times. Particularly when doing AJAX requests. An example would be like:
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
Dim dp As New DataProxy
Dim listOfObs As New List(Of MyObject)
dim someId as integer = 1
Try
If Not Page.IsPostBack Then
listOfObs = dp.ExampleReadFuncion(someId)
End If
Catch ex As Exception
Throw
Finally
dp.dispose()
dp = Nothing
SetMenue()
End Try
End Sub
DatatProxy (business layer)
Public Class DataProxy
Dim scConAdapter As New ConnectionAdapter
Public Sub New()
Try
scConAdapter.Connect()
Catch ex As Exception
Throw
End Try
End Sub
Public Sub dispose()
scConAdapter.Dispose()
End Sub
Private Shared Sub Main()
End Sub
Public Function ExampleReadFuncion(ByVal someId As Integer) As List(Of MyObject)
Dim successFactor As LogStatusEnum = LogStatusEnum.INFO
Dim newEx As Exception = Nothing
Dim conn As New ConnectionAdapter
Dim myObj As ActivityMarker
Dim listOfObs As New List(Of MyObject)
Dim dr As SqlDataReader = Nothing
Try
successFactor = LogStatusEnum.INFO
conn.Connect()
dr = conn.ExampleReadFuncion(someId)
Using dr
If (dr.HasRows = True) Then
While dr.Read
myObj = New myObj
myObj.Marker_Id = dr.Item("id")
myObj.Acitvity_Id = dr.Item("someValue")
listOfObs.Add(myObj)
End While
End If
End Using
Return listOfObs
Catch ex As Exception
successFactor = LogStatusEnum.ERRORS
Throw
Finally
dr.Close()
dr = Nothing
conn.Dispose()
conn = Nothing
End Try
End Function
End class
ConnectionAdapter
Public Class ConnectionAdapter
Inherits SqlConnectionAdapter
Public Sub New()
End Sub
Public Function ExampleReadFuncion(ByVal someId As Integer) As SqlDataReader
Try
Dim dr As SqlDataReader = Nothing
Dim selectString As New StringBuilder
Dim cmd As SqlCommand = Nothing
Try
cmd = CreateCommand()
selectString.Append("SELECT * " & vbCrLf)
selectString.Append("FROM " & vbCrLf)
selectString.Append("dbo.mytable " & vbCrLf)
selectString.Append("WHERE " & vbCrLf)
selectString.Append("id = #SOME_ID " & vbCrLf)
With cmd
.CommandType = CommandType.Text
.CommandText = selectString.ToString
.Parameters.Add("#SOME_ID", SqlDbType.Int).Value = someId
dr = .ExecuteReader
End With
Catch ex As Exception
Throw
Finally
cmd.Dispose()
End Try
Return dr
Catch ex As Exception
Throw ex
End Try
End Function
end class
SqlConnectionAdapter
Public MustInherit Class SqlConnectionAdapter
Protected CurrentTransaction As SqlTransaction
Public Property db As SqlConnection
Public Property Password As String
Public Property TNSName As String
Public Property User As String
Public Property DBName As String
Public Property PortNumber As Integer
Public Overridable Sub Dispose()
Try
If Not CurrentTransaction Is Nothing Then
CurrentTransaction.Commit()
End If
Catch ex As Exception
Throw
Finally
If Not db Is Nothing Then
db.Close()
db.Dispose()
db = Nothing
End If
End Try
End Sub
Public Overridable Sub Connect()
Try
Dim appSettings = ConfigurationManager.AppSettings
If (appSettings("releaseVersion") = "DEBUG") Then
Connect(appSettings("db_sqlHost"), appSettings("db_sqlDb"))
Else
Connect(appSettings("db_sqlHost"), appSettings("db_sqlPort"), appSettings("db_sqlDb"), appSettings("db_sqlUser"), appSettings("db_sqlPassword"))
End If
Catch ex As Exception
Throw
End Try
End Sub
Public Sub Connect(ByVal GetServername As String, ByVal GetDatabaseName As String)
Try
TNSName = GetServername
DBName = GetDatabaseName
db = New SqlConnection
db = SqlConnectionUtilities.GetConnection(GetServername, GetDatabaseName)
Catch ex As Exception
Throw
End Try
End Sub
Public Sub Connect(ByVal GetServerName As String, ByVal GetPort As Long, ByVal GetDatabase As String, ByVal GetUsername As String, ByVal Getpassword As String)
Try
User = GetUsername
Password = Getpassword
PortNumber = GetPort
DBName = GetDatabase
TNSName = GetServerName
db = New SqlConnection
db = SqlConnectionUtilities.GetConnection(GetServerName, GetPort, GetDatabase, GetUsername, Getpassword)
Catch ex As Exception
Throw
End Try
End Sub
Protected Function CreateCommand() As SqlCommand
Dim ret As SqlCommand = Nothing
Try
ret = db.CreateCommand
If Not CurrentTransaction Is Nothing Then
ret.Transaction = CurrentTransaction
End If
Catch ex As Exception
Throw
Finally
End Try
Return ret
End Function
Public Sub BeginTransaction()
If CurrentTransaction Is Nothing Then
CurrentTransaction = db.BeginTransaction
End If
End Sub
Public Sub CommitTransaction()
If Not CurrentTransaction Is Nothing Then
CurrentTransaction.Commit()
CurrentTransaction.Dispose()
CurrentTransaction = Nothing
End If
End Sub
Public Sub RollbackTransaction()
If Not CurrentTransaction Is Nothing Then
CurrentTransaction.Rollback()
CurrentTransaction.Dispose()
CurrentTransaction = Nothing
End If
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
End Class
Utilities class
Public Class SqlConnectionUtilities
Public Shared Property connectionString As String
Public Shared Function GetConnection(ByVal ServerName As String, ByVal Port As String, ByVal Database As String, ByVal username As String, ByVal password As String) As SqlConnection
Dim connString As New StringBuilder
Dim con As SqlConnection
Try
connString.Append("Server=tcp:" & ServerName & "," & Port & ";")
connString.Append("Initial Catalog = " & Database & "; Persist Security Info=False;")
connString.Append("User ID = " & username & ";")
connString.Append("Password = " & password & ";")
connString.Append("MultipleActiveResultSets = False;")
connString.Append("Encrypt = True;TrustServerCertificate=False;Connection Timeout=30;")
connectionString = connString.ToString
con = New SqlConnection(connString.ToString)
con.Open()
Return con
Catch ex As Exception
Throw
End Try
End Function
Public Shared Function GetConnection(ByVal Servername As String, ByVal DatabaseName As String) As SqlConnection
Dim ConnectString As String
Dim con As SqlConnection
Try
ConnectString = "Data Source=" & Servername & ";Initial Catalog=" & DatabaseName & ";Integrated Security=True"
connectionString = ConnectString
con = New SqlConnection(ConnectString)
con.Open()
Return con
Catch ex As Exception
Throw
End Try
End Function
End class
I can tell that connections are remaining open by running this SQL statement:
SELECT
DB_NAME(dbid) as DBName,
COUNT(dbid) as NumberOfConnections,
loginame as LoginName
FROM
sys.sysprocesses
WHERE
dbid > 0
GROUP BY
dbid, loginame
I set up break points when my DataProxy class is called. I run the SQL code and can see a new connection is opened. Then, I run the code again when I dispose of the DataProxy class and I can see the connection remains. This will build up until it hits 101 connections, then it causes the above error. How am I not handling the connections correctly?
System.InvalidOperationException: 'Timeout expired. The timeout period elapsed prior to obtaining a connection from the pool. This may have occurred because all pooled connections were in use and max pool size was reached.'
How am I not handling the connections correctly?
You are "leaking" connections. IE you have some code path that opens a SqlConnection, and doesn't Close/Dispose it. The SqlConnection remains open and is sitting on the managed heap. Eventually it will be GC'd and its Finalizer will close the connection. But if you leak 100 connections before that happens, you get this error.
So you need to ensure that your SqlConnections are always closed using a USING block, or are managed by some other object that's closed with a USING block.
Note that if you are returning a SqlDataReader from a function, there's a special CommandBehavior that will close the SqlConnection when the SqlDataReader is closed.
No, even this code not work and it wait a few minutes to remove sql connection from sql server.
using (var conn = new SqlConnection(connStr))
{
conn.Open();
conn.Close();
}
GC.Collect();
GC.WaitForPendingFinalizers();
I'm using WebForms with forms authentication. I'm connecting my application with an rest api token mechanism.
My problem is that I want to ask for my new access token using my refreshtoken.
I currently do this job in Global.asax Application_AuthenticateRequest method.
When I obtain the accesstoken i update the ticket but i am redirected to the login page.
I've try to use Response.Redirect and i am redirected to the original url but i lost the state of the page. It's as if I has reloaded the page. Somebody know what i'm doing wrong?
Below is my global.asax code in VB.net:
Thanks!
Sub Application_AuthenticateRequest(ByVal sender As Object, ByVal e As EventArgs)
Try
If Request.Cookies(FormsAuthentication.FormsCookieName) IsNot Nothing Then
Dim authCookie As HttpCookie = (Request.Cookies(FormsAuthentication.FormsCookieName))
If Not String.IsNullOrEmpty(authCookie.Value) Then
Dim ticket = FormsAuthentication.Decrypt(authCookie.Value)
If ticket.Expired Then
'reauth cookie Is My refreshtoken
If Request.Cookies("reAuthCookie") IsNot Nothing Then
Dim funciones As New Funciones.Usuarios
Dim reAuthCookie As HttpCookie = Request.Cookies("reAuthCookie")
If Not String.IsNullOrEmpty(reAuthCookie.Value) Then
Dim refreshToken As String = reAuthCookie.Value(0).ToString
Dim login As Entidades.Login = funciones.renovarAccessToken(refreshToken)
Dim ticketExpiration As Date
ticketExpiration = Date.Now.AddSeconds(CDbl(login.Expires_in) - 20)
Dim userData As String = Newtonsoft.Json.JsonConvert.SerializeObject(login)
ticket = New FormsAuthenticationTicket(1, login.Username, DateTime.Now,
ticketExpiration, True,
userData, FormsAuthentication.FormsCookiePath)
Dim encTicket As String = FormsAuthentication.Encrypt(ticket)
HttpContext.Current.Response.Cookies.Add(New HttpCookie(FormsAuthentication.FormsCookieName, encTicket))
Response.Cookies.Remove("reAuthCookie")
reAuthCookie.Expires = Now.AddMonths(2)
reAuthCookie.Path = "/"
reAuthCookie.Value = login.Refresh_token
Response.Cookies.Add(reAuthCookie)
End If
End If
End If
End If
Else
If Request.Cookies("reAuthCookie") IsNot Nothing Then
Dim funciones As New Funciones.Usuarios
Dim reAuthCookie As HttpCookie = Request.Cookies("reAuthCookie")
If Not String.IsNullOrEmpty(reAuthCookie.Value) Then
Dim refreshToken As String = reAuthCookie.Value.ToString
Dim login As Entidades.Login = funciones.renovarAccessToken(refreshToken)
Dim ticketExpiration As Date
ticketExpiration = Date.Now.AddSeconds(CDbl(login.Expires_in) - 20)
Dim userData As String = Newtonsoft.Json.JsonConvert.SerializeObject(login)
Dim ticket = New FormsAuthenticationTicket(1, login.Username, DateTime.Now,
ticketExpiration, True,
userData, FormsAuthentication.FormsCookiePath)
Dim encTicket As String = FormsAuthentication.Encrypt(ticket)
Response.Cookies.Add(New HttpCookie(FormsAuthentication.FormsCookieName, encTicket))
Response.Cookies.Remove("reAuthCookie")
reAuthCookie.Expires = Now.AddMonths(2)
reAuthCookie.Path = "/"
reAuthCookie.Value = login.Refresh_token
Response.Cookies.Add(reAuthCookie)
End If
End If
End If
Catch ex As Exception
Throw ex
End Try
End Sub
the code I have below works, but it doesn't use the password that is passed from the client. After I find the correct user in the AD, is there a way to match the password that is passed from the client with the password in the AD?
Thanks!
Public Class FordLoginController
Inherits ApiController
Public Class StoreCredentials
Public Property UsernameAX As String
Public Property PasswordAX As String
End Class
Public Function PostValue(<FromBody()> ByVal creds As StoreCredentials) As HttpResponseMessage
Dim username As String = creds.UsernameAX
Dim password As String = creds.PasswordAX
Dim ctx As New PrincipalContext(ContextType.Domain, "ford", "dc=biz,dc=ford,dc=com")
Dim user As UserPrincipal = UserPrincipal.FindByIdentity(ctx, username)
Dim response As HttpResponseMessage
If user IsNot Nothing Then
response = Request.CreateResponse(HttpStatusCode.Found)
response.Headers.Location = New Uri("/loginAndContinue/login.aspx")
Return response
End If
response = Request.CreateResponse(HttpStatusCode.Forbidden)
Return response
End Function
End Class
From VBForums
http://www.vbforums.com/showthread.php?352349-Validate-Login-against-Active-Directory
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
usage
If ValidateActiveDirectoryLogin("VBForums", "Woof", "Mouse") Then
'do something
End If
As its well known that membership create user functionality lacks a lot of user details that someone might need to store. I am presenting my work around it and I need your expert opinion, ( I am using web method)
I m currently using this code (Ref Microsoft)
Public Function GetErrorMessage(status As MembershipCreateStatus) As String
Select Case status
Case MembershipCreateStatus.DuplicateUserName
Return "Username already exists. Please enter a different user name."
Case MembershipCreateStatus.DuplicateEmail
Return "A username for that e-mail address already exists. Please enter a different e-mail address."
Case MembershipCreateStatus.InvalidPassword
Return "The password provided is invalid. Please enter a valid password value."
Case MembershipCreateStatus.InvalidEmail
Return "The e-mail address provided is invalid. Please check the value and try again."
Case MembershipCreateStatus.InvalidAnswer
Return "The password retrieval answer provided is invalid. Please check the value and try again."
Case MembershipCreateStatus.InvalidQuestion
Return "The password retrieval question provided is invalid. Please check the value and try again."
Case MembershipCreateStatus.InvalidUserName
Return "The user name provided is invalid. Please check the value and try again."
Case MembershipCreateStatus.ProviderError
Return "The authentication provider Returned an error. Please verify your entry and try again. If the problem persists, please contact your system administrator."
Case MembershipCreateStatus.UserRejected
Return "The user creation request has been canceled. Please verify your entry and try again. If the problem persists, please contact your system administrator."
Case Else
Return "An unknown error occurred. Please verify your entry and try again. If the problem persists, please contact your system administrator."
End Select
End Function
Public Function GetUsrID(UserName) As String
Dim sql As String = "SELECT UserId FROM aspnet_Users WHERE UserName= #UserName"
Using cn As New SqlConnection(ARTSQLDBCOM), _
cmd As New SqlCommand(sql, cn)
cmd.Parameters.Add("#UserName", SqlDbType.VarChar, 256).Value = UserName
cn.Open()
Dim val As String = String.Empty
Dim getVal As Object = cmd.ExecuteScalar()
cn.Close()
If Not IsNothing(getVal) Then
val = getVal.ToString
Return val
Else
Return Nothing
End If
End Using
End Function
Public Function CreateUser_AugmentedUpdate(ByVal UserName As String, ByVal JobTitleID As String, ByVal Prfx As String, ByVal fname As String, ByVal Mname As String, ByVal Lname As String, ByVal Initial As String, _
ByVal disname As String, ByVal UsrDOB As String, ByVal TelNum As String, ByVal UsrSignature As String, ByVal UsrImg_aURL As String, ByVal UsrImg_rURL As String)
Try
Dim UserID As String = GetUsrID(UserName)
Dim SQLCmd As New SqlCommand()
SQLCmd.CommandType = CommandType.StoredProcedure
SQLCmd.CommandText = "aspnet_Users_CreateUser_AugmentedUpdate"
SQLCmd.Parameters.Add("#UserId", SqlDbType.NVarChar).Value = UserID.ToString
If (String.IsNullOrEmpty(JobTitleID)) Then
SQLCmd.Parameters.Add("#JobTitleID", SqlDbType.Int).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#JobTitleID", SqlDbType.Int).Value = Convert.ToInt32(JobTitleID)
End If
If (String.IsNullOrEmpty(Initial)) Then
SQLCmd.Parameters.Add("#Initial", SqlDbType.Int).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#Initial", SqlDbType.Int).Value = Convert.ToInt32(Initial)
End If
If (String.IsNullOrEmpty(Prfx)) Then
SQLCmd.Parameters.Add("#Prfx", SqlDbType.Int).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#Prfx", SqlDbType.Int).Value = Convert.ToInt32(Prfx)
End If
If (String.IsNullOrEmpty(fname)) Then
SQLCmd.Parameters.Add("#fname", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#fname", SqlDbType.NVarChar).Value = fname.ToString
End If
If (String.IsNullOrEmpty(Mname)) Then
SQLCmd.Parameters.Add("#Mname", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#Mname", SqlDbType.NVarChar).Value = Mname.ToString
End If
If (String.IsNullOrEmpty(Lname)) Then
SQLCmd.Parameters.Add("#Lname", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#Lname", SqlDbType.NVarChar).Value = Lname.ToString
End If
If (String.IsNullOrEmpty(disname)) Then
SQLCmd.Parameters.Add("#disname", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#disname", SqlDbType.NVarChar).Value = disname.ToString
End If
Dim dateValue As Date
If String.IsNullOrWhiteSpace(UsrDOB) Then
SQLCmd.Parameters.Add("#UsrDOB", SqlDbType.Date).Value = DBNull.Value
ElseIf Date.TryParse(UsrDOB, dateValue) Then
SQLCmd.Parameters.Add("#UsrDOB", SqlDbType.Date).Value = dateValue
Else
SQLCmd.Parameters.Add("#UsrDOB", SqlDbType.Date).Value = DBNull.Value
End If
If (String.IsNullOrEmpty(TelNum)) Then
SQLCmd.Parameters.Add("#TelNum", SqlDbType.NChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#TelNum", SqlDbType.NChar).Value = TelNum.ToString
End If
If (String.IsNullOrEmpty(UsrSignature)) Then
SQLCmd.Parameters.Add("#UsrSignature", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#UsrSignature", SqlDbType.NVarChar).Value = UsrSignature.ToString
End If
If (String.IsNullOrEmpty(UsrImg_aURL)) Then
SQLCmd.Parameters.Add("#UsrImg_aURL", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#UsrImg_aURL", SqlDbType.NVarChar).Value = UsrImg_aURL.ToString
End If
If (String.IsNullOrEmpty(UsrImg_rURL)) Then
SQLCmd.Parameters.Add("#UsrImg_rURL", SqlDbType.NVarChar).Value = DBNull.Value
Else
SQLCmd.Parameters.Add("#UsrImg_rURL", SqlDbType.NVarChar).Value = UsrImg_rURL.ToString
End If
SQLCmd.Connection = ARTSQLCON
ARTSQLCON.Open()
SQLCmd.ExecuteNonQuery()
ARTSQLCON.Close()
Return "User has been Created Successfully"
Catch
Return "Create User Phase 2 Error. Please refer to your database developer"
End Try
End Function
<WebMethod()> _
Public Function RegNewUser(ByVal Username As String, ByVal Password As String, ByVal Email As String, ByVal JobTitleID As String, ByVal Prfx As String, ByVal fname As String, ByVal Mname As String, ByVal Lname As String, ByVal Initial As String, _
ByVal disname As String, ByVal UsrDOB As String, ByVal TelNum As String, ByVal UsrSignature As String, ByVal UsrImg_aURL As String, ByVal UsrImg_rURL As String) As String
Dim status As MembershipCreateStatus
'Dim passwordQuestion As String = ""
'Dim passwordAnswer As String = ""
'If Membership.RequiresQuestionAndAnswer Then
' passwordQuestion = PasswordQuestionDDl.Text.Trim()
' passwordAnswer = PasswordAnswerTextbox.Text
'End If
Try
Dim newUser As MembershipUser = Membership.CreateUser(Username, Password, Email, Nothing, Nothing, False, status)
If newUser Is Nothing Then
Return GetErrorMessage(status)
Else
CreateUser_AugmentedUpdate(Username, JobTitleID, Prfx, fname, Mname, Lname, Initial, _
disname, UsrDOB, TelNum, UsrSignature, UsrImg_aURL, UsrImg_rURL)
Return "User has been Created Successfully" + JobTitleID
End If
Catch
Return "Create User Phase 1 Error. Please refer to your database developer"
End Try
End Function
Now behind this code, I put a trigger on the asp users table to insert the new userID in a different table. My SQL stored procedure (aspnet_Users_CreateUser_AugmentedUpdate) run a record update on the new table,
The code works beautifully but is it a good practice?
Thanks
Your implementation is correct, since we could not use Transaction in Membership Provider.
You will need to make sure user enters valid data before calling Membership.CreateUser. So I'll do some type of validations before that line. Otherwise, you will end up with dangling data.
Just a minor improvement which is not related to Membership. If you pass more than 3 arguments to a method, you might want to consider using object. You can read more at Clean Code by Robert C. Martin.
Public Function CreateUser_AugmentedUpdate(ByVal user As UserModel)
You can use ternary operator to shorten if statement.
SQLCmd.Parameters.Add("#TelNum", SqlDbType.NChar).Value =
If(String.IsNullOrEmpty(TelNum), DBNull.Value, TelNum.ToString)
I am trying to write some code to check the AD password age during a user login and notify them of the 15 remaining days. I am using the ASP.Net code that I found on the Microsoft MSDN site and I managed to add a function that checks the if the account is set to change password at next login. The login and the change password at next login works great but I am having some problems with the check for the password age.
This is the VB.Net code for the DLL file:
Imports System
Imports System.Text
Imports System.Collections
Imports System.DirectoryServices
Imports System.DirectoryServices.AccountManagement
Imports System.Reflection 'Needed by the Password Expiration Class Only -Vince
Namespace FormsAuth
Public Class LdapAuthentication
Dim _path As String
Dim _filterAttribute As String
'Code added for the password expiration added by Vince
Private _domain As DirectoryEntry
Private _passwordAge As TimeSpan = TimeSpan.MinValue
Const UF_DONT_EXPIRE_PASSWD As Integer = &H10000
'Function added by Vince
Public Sub New()
Dim root As New DirectoryEntry("LDAP://rootDSE")
root.AuthenticationType = AuthenticationTypes.Secure
_domain = New DirectoryEntry("LDAP://" & root.Properties("defaultNamingContext")(0).ToString())
_domain.AuthenticationType = AuthenticationTypes.Secure
End Sub
'Function added by Vince
Public ReadOnly Property PasswordAge() As TimeSpan
Get
If _passwordAge = TimeSpan.MinValue Then
Dim ldate As Long = LongFromLargeInteger(_domain.Properties("maxPwdAge")(0))
_passwordAge = TimeSpan.FromTicks(ldate)
End If
Return _passwordAge
End Get
End Property
Public Sub New(ByVal path As String)
_path = path
End Sub
'Function added by Vince
Public Function DoesUserHaveToChangePassword(ByVal userName As String) As Boolean
Dim ctx As PrincipalContext = New PrincipalContext(System.DirectoryServices.AccountManagement.ContextType.Domain)
Dim up = UserPrincipal.FindByIdentity(ctx, userName)
Return (Not up.LastPasswordSet.HasValue)
'returns true if last password set has no value.
End Function
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
'Function added by Vince
Public Function WhenExpires(ByVal username As String) As TimeSpan
Dim ds As New DirectorySearcher(_domain)
ds.Filter = [String].Format("(&(objectClass=user)(objectCategory=person)(sAMAccountName={0}))", username)
Dim sr As SearchResult = FindOne(ds)
Dim user As DirectoryEntry = sr.GetDirectoryEntry()
Dim flags As Integer = CInt(user.Properties("userAccountControl").Value)
If Convert.ToBoolean(flags And UF_DONT_EXPIRE_PASSWD) Then
'password never expires
Return TimeSpan.MaxValue
End If
'get when they last set their password
Dim pwdLastSet As DateTime = DateTime.FromFileTime(LongFromLargeInteger(user.Properties("pwdLastSet").Value))
' return pwdLastSet.Add(PasswordAge).Subtract(DateTime.Now);
If pwdLastSet.Subtract(PasswordAge).CompareTo(DateTime.Now) > 0 Then
Return pwdLastSet.Subtract(PasswordAge).Subtract(DateTime.Now)
Else
Return TimeSpan.MinValue
'already expired
End If
End Function
'Function added by Vince
Private Function LongFromLargeInteger(ByVal largeInteger As Object) As Long
Dim type As System.Type = largeInteger.[GetType]()
Dim highPart As Integer = CInt(type.InvokeMember("HighPart", BindingFlags.GetProperty, Nothing, largeInteger, Nothing))
Dim lowPart As Integer = CInt(type.InvokeMember("LowPart", BindingFlags.GetProperty, Nothing, largeInteger, Nothing))
Return CLng(highPart) << 32 Or CUInt(lowPart)
End Function
'Function added by Vince
Private Function FindOne(ByVal searcher As DirectorySearcher) As SearchResult
Dim sr As SearchResult = Nothing
Dim src As SearchResultCollection = searcher.FindAll()
If src.Count > 0 Then
sr = src(0)
End If
src.Dispose()
Return sr
End Function
End Class
End Namespace
And this is the Login.aspx page:
sub Login_Click(sender as object,e as EventArgs)
Dim adPath As String = "LDAP://DC=xxx,DC=com" 'Path to your LDAP directory server
Dim adAuth As LdapAuthentication = New LdapAuthentication(adPath)
Try
If (True = adAuth.DoesUserHaveToChangePassword(txtUsername.Text)) Then
Response.Redirect("passchange.htm")
ElseIf (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)
'Retrieve the password life
Dim t As TimeSpan = adAuth.WhenExpires(txtUsername.Text)
'You can redirect now.
If (passAge.Days = 90) Then
errorLabel.Text = "Your password will expire in " & DateTime.Now.Subtract(t)
'errorLabel.Text = "This is"
'System.Threading.Thread.Sleep(5000)
Response.Redirect("http://somepage.aspx")
Else
Response.Redirect(FormsAuthentication.GetRedirectUrl(txtUsername.Text, False))
End If
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
`
Every time I have this Dim t As TimeSpan = adAuth.WhenExpires(txtUsername.Text) enabled, I receive "Arithmetic operation resulted in an overflow." during the login and won't continue.
What am I doing wrong? How can I correct this? Please help!!
Thank you very much for any help in advance.
Vince
Ok I tried to use a different approach.
Here are the functions converted from C#:
Public Function PassAboutToExpire(ByVal userName As String) As Integer
Dim passwordAge As TimeSpan
Dim currentDate As DateTime
Dim ctx As PrincipalContext = New PrincipalContext(System.DirectoryServices.AccountManagement.ContextType.Domain)
Dim up = UserPrincipal.FindByIdentity(ctx, userName)
'Return (Not up.LastPasswordSet.HasValue)
'returns true if last password set has no value.
Dim pwdLastSet As DateTime = DateTime.FromFileTime(LongFromLargeInteger(up.LastPasswordSet))
currentDate = Now
passwordAge = currentDate.Subtract(pwdLastSet)
If passwordAge.Days > 75 Then
'If pwdLastSet.Subtract(passwordAge).CompareTo(DateTime.Now) > 0 Then
'Dim value As TimeSpan = pwdLastSet.Subtract(passwordAge).Subtract(DateTime.Now)
'If (value.Days > 75) Then
Return passwordAge.Days
'End If
Else
Return False
'already expired
End If
End Function
Private Function LongFromLargeInteger(ByVal largeInteger As Object) As Long
Dim type As System.Type = largeInteger.[GetType]()
Dim highPart As Integer = CInt(type.InvokeMember("HighPart", BindingFlags.GetProperty, Nothing, largeInteger, Nothing))
Dim lowPart As Integer = CInt(type.InvokeMember("LowPart", BindingFlags.GetProperty, Nothing, largeInteger, Nothing))
Return CLng(highPart) << 32 Or CUInt(lowPart)
End Function
And here is the code snippet from the logon.aspx page:
sub Login_Click(sender as object,e as EventArgs)
Dim adPath As String = "LDAP://DC=xzone,DC=com" 'Path to your LDAP directory server
Dim adAuth As LdapAuthentication = New LdapAuthentication(adPath)
Try
If (True = adAuth.DoesUserHaveToChangePassword(txtUsername.Text)) Then
Response.Redirect("http://mypass.nsu.edu")
ElseIf (adAuth.PassAboutToExpire(txtUsername.Text) > 0) Then
Response.Redirect("http://www.yahoo.com")
Now when I try to login I receive the exception error: Error authenticating. Method 'System.DateTime.HighPart' not found.
and I don't know why. Anyone has any idea?
I would use the DateDiff function to determine the remaining number of days rather than using currentDate.Subtract
Dim passwordAge As Integer = (CInt)DateDiff(DateInterval.Day, Now, up.LastPasswordSet))
That will return an integer representing the number of days between now and when the password will need to be set.