I use Facebook login for website currently it doesn't retrieves email address I have update to Facebook Graph API endpoint version from v9.0 to v11.0 also I requested for both email and public_profile permissions in App Review section like below image but it still retrieve just (id,name,first_name,last_name ) and email is empty here is the VB.NET code to handle the Facebook Graph API
Public Sub GetUserData(ByVal FacebookAppId As String, ByVal FacebookAppSecret As String, ByVal RedirectURL As String, ByVal Code As String)
Dim targetUri As Uri = New Uri("https://graph.facebook.com/v11.0/oauth/access_token?client_id=" & FacebookAppId & "&client_secret=" & FacebookAppSecret & "&redirect_uri=" & RedirectURL & "&code=" & Code)
Dim at As HttpWebRequest = CType(HttpWebRequest.Create(targetUri), HttpWebRequest)
Dim str As System.IO.StreamReader = New System.IO.StreamReader(at.GetResponse().GetResponseStream())
Dim token As String = str.ReadToEnd().ToString().Replace("access_token=", "")
Dim combined As String() = token.Split(""""c)
Dim accessToken As String = combined(3)
Dim url As String = "https://graph.facebook.com/v11.0/me?fields=id%2Cname%2Cemail%2Cfirst_name%2Clast_name&access_token=" & accessToken.Trim(""""c) & ""
Dim request As WebRequest = WebRequest.Create(url)
request.ContentType = "application/json"
request.Method = "GET"
Dim userInfo As StreamReader = New StreamReader(request.GetResponse().GetResponseStream())
Dim jsonResponse As String = String.Empty
jsonResponse = userInfo.ReadToEnd()
Dim sr As JavaScriptSerializer = New JavaScriptSerializer()
Dim jsondata As String = jsonResponse
Dim converted As FacebookUserData = sr.Deserialize(Of FacebookUserData)(jsondata)
userId = converted.id
userName = converted.name
userFirstName = converted.first_name
userLastName = converted.last_name
userEmail = converted.email
End Sub
Permissions and Features image
Here is the login button
Protected Sub btnFBSignIn_Click(sender As Object, e As EventArgs) Handles btnFBSignIn.Click
Dim fbAppId As String = "AppID"
Dim fbUrllRedirect = "https://mywebsite.com/Login"
Dim fbApiUrl As String = "https://www.facebook.com/v11.0/dialog/oauth/?client_id=" & fbAppId & "&redirect_uri=" & fbUrllRedirect & "&response_type=code&state=1"
Response.Redirect(fbApiUrl)
End Sub
Related
I am trying to send emails through gmail host by using google oauth 2.0, I am confused where to use the access code instead of user password to send emails,
this code is used to open up the consent screen and ask for permissions,
Dim Googleurl = "https://accounts.google.com/o/oauth2/auth?response_type=code&redirect_uri=" & googleplus_redirect_url & "&scope=https://www.googleapis.com/auth/userinfo.email%20https://www.googleapis.com/auth/userinfo.profile%20https://mail.google.com/%20https://www.googleapis.com/auth/gmail.send&client_id=" + googleplus_client_id
Session("loginWith") = "google"
Response.Redirect(Googleurl)
after getting permissions, this is how I obtained access code,
If url <> "" Then
Dim queryString As String = url.ToString()
Dim delimiterChars As Char() = {"="c}
Dim words As String() = queryString.Split(delimiterChars)
Dim code As String = words(1)
If code IsNot Nothing Then
Dim webRequest As HttpWebRequest = CType(webRequest.Create("https://accounts.google.com/o/oauth2/token"), HttpWebRequest)
webRequest.Method = "POST"
Parameters = "code=" & code & "&client_id=" & googleplus_client_id & "&client_secret=" + googleplus_client_secret & "&redirect_uri=" + googleplus_redirect_url & "&grant_type=authorization_code"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(Parameters)
webRequest.ContentType = "application/x-www-form-urlencoded"
webRequest.ContentLength = byteArray.Length
Dim postStream As Stream = webRequest.GetRequestStream()
postStream.Write(byteArray, 0, byteArray.Length)
postStream.Close()
Dim response As WebResponse = webRequest.GetResponse()
postStream = response.GetResponseStream()
Dim reader As StreamReader = New StreamReader(postStream)
Dim responseFromServer As String = reader.ReadToEnd()
Dim serStatus As GooglePlusAccessToken = JsonConvert.DeserializeObject(Of GooglePlusAccessToken)(responseFromServer)
If serStatus IsNot Nothing Then
Dim accessToken As String = String.Empty
accessToken = serStatus.access_token
If Not String.IsNullOrEmpty(accessToken) Then
getgoogleplususerdataSer(accessToken)
End If
End If
End If
End If
and using the below code to send emails:
mm.Subject = LetterSubject.Text
Dim body As String
body = LetterBody.Text
mm.Body = body
Dim smtp As New Mail.SmtpClient()
smtp.Host = "smtp.gmail.com"
smtp.EnableSsl = True
smtp.Port = 587
smtp.UseDefaultCredentials = False
Dim service = New GmailService(New BaseClientService.Initializer With {.HttpClientInitializer = cred})
Dim NetworkCred As New NetworkCredential(SenderEmailAddress.Text, SenderPassword.Text)
smtp.Credentials = NetworkCred
smtp.Send(mm)
Can someone please help me how to use token here to send emails without using the user gmail password?
Imports System
Imports System.Threading.Tasks
Imports Google.Apis.Discovery.v1
Imports Google.Apis.Discovery.v1.Data
Imports Google.Apis.Services
Class Program
<STAThread>
Private Shared Sub Main(ByVal args As String())
Console.WriteLine("Discovery API Sample")
Console.WriteLine("====================")
Try
New Program().Run().Wait()
Catch ex As AggregateException
For Each e In ex.InnerExceptions
Console.WriteLine("ERROR: " & e.Message)
Next
End Try
Console.WriteLine("Press any key to continue...")
Console.ReadKey()
End Sub
Private Async Function Run() As Task
Dim service = New DiscoveryService(New BaseClientService.Initializer With {
.ApplicationName = "Discovery Sample",
.ApiKey = "[YOUR_API_KEY_HERE]"
})
Console.WriteLine("Executing a list request...")
Dim result = Await service.Apis.List().ExecuteAsync()
If result.Items IsNot Nothing Then
For Each api As DirectoryList.ItemsData In result.Items
Console.WriteLine(api.Id & " - " + api.Title)
Next
End If
End Function
End Class
''Your Authentication key should be static
''Dim NetworkUserName As String= "apikey"
' Dim YOUR_API_KEY_HERE As String = "SG.EEyBZDVAS622C6Rt7yu1sw.jwRdfkjJddfsJfgfsyuJuyuHutytr876RuQsffhghdf1d"
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
I have this code. It returns an error 400 bad request and I cannot find why.
The error at line 31 (which is where it's supposed to get the response...
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not Page.Request.QueryString("code") Is Nothing Then
Dim Token As String = GetToken("code=" & Server.UrlEncode(Page.Request.QueryString("code")) & "&client_id=xxx&client_secret=xxx&grant_type=authorization_code&redirect_uri=" & Server.UrlEncode("http://localhost:61163/Testing/YoutubeAPI.aspx"))
'do something with the magical and elusive access_token from this point forward....
End If
End Sub
Public Shared Function GetToken(code As String) As String
Dim apiResponse As String
Dim postData As String = code
Dim request As HttpWebRequest = DirectCast(WebRequest.Create("https://accounts.google.com/o/oauth2/token"), HttpWebRequest)
request.Method = "POST"
request.ContentType = "application/x-www-form-urlencoded"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
Dim dataStream As Stream = request.GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
Dim response As WebResponse = request.GetResponse()
apiResponse = DirectCast(response, HttpWebResponse).StatusDescription.ToString()
dataStream = response.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
reader.Close()
dataStream.Close()
response.Close()
Return responseFromServer
End Function
I am not sure about your code but you can always use YouTube Dotnet client libraries.
Here's a sample application using it.
well am not sure if the etiquette is correct here in answering my own question but you may find it useful nonetheless.
The answer lay in the URL encoding of content string...
so now slightly amended the awesomeness of OAuth2 is unleashed and I can get pretty much whatever I want from the youtube API :) (although NO thanks to the black hole rabbit-hole of google documentation...
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not Page.Request.QueryString("code") Is Nothing Then
Dim Token As String = CodeTrade("code=" & Server.UrlEncode(Page.Request.QueryString("code")) & "&redirect_uri=" & Server.UrlEncode("http://localhost:61163/Testing/YoutubeAPI.aspx") & "&client_id=xxx=&client_secret=xxx&grant_type=authorization_code")
'now i CAN do something with the magical and elusive access_token from this point forward....
End If
End Sub
Public Shared Function CodeTrade(code As String) As String
Dim apiResponse As String
Dim postData As String = code
Dim request As HttpWebRequest = DirectCast(WebRequest.Create("https://accounts.google.com/o/oauth2/token"), HttpWebRequest)
request.Method = "POST"
request.ContentType = "application/x-www-form-urlencoded"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
Dim dataStream As Stream = request.GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
Dim response As WebResponse = request.GetResponse()
apiResponse = DirectCast(response, HttpWebResponse).StatusDescription.ToString()
dataStream = response.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
reader.Close()
dataStream.Close()
response.Close()
Return responseFromServer
End Function
I am using VS2012 with ASP.NET 4.5 and MySQL as my database provider.
I am getting a specified cast error now on code that was working fine at one point.
It is from my Register.aspx page for registration verification and the code is adapted from an asp.net website tutorial.
Here is the code, the error is on the Dim newUser as Guid line
Protected Sub RegisterUser_CreatedUser(ByVal sender As Object, ByVal e As EventArgs) Handles RegisterUser.CreatedUser
FormsAuthentication.SetAuthCookie(RegisterUser.UserName, False)
Dim newUser As MembershipUser = Membership.GetUser(RegisterUser.UserName)
Dim newUserID As Guid = DirectCast(newUser.ProviderUserKey, Guid)
Dim urlBase As String = Request.Url.GetLeftPart(UriPartial.Authority) & Request.ApplicationPath
Dim verifyUrl As String = "VerifyNewUser.aspx?ID=" & newUserID.ToString()
Dim fullPath As String = urlBase & verifyUrl
Dim appPath As String = Request.PhysicalApplicationPath
Dim sr As New StreamReader(appPath & "EmailTemplates/VerifyUserAccount.txt")
Dim mailMessage As New MailMessage()
mailMessage.IsBodyHtml = True
mailMessage.From = New MailAddress("myacct#gmail.com")
mailMessage.To.Add(New MailAddress(RegisterUser.Email))
mailMessage.CC.Add(New MailAddress("myacct#gmail.com"))
mailMessage.Subject = "New User Registration"
mailMessage.Body = sr.ReadToEnd
sr.Close()
mailMessage.Body = mailMessage.Body.Replace("<%UserName%>", RegisterUser.UserName)
mailMessage.Body = mailMessage.Body.Replace("<%VerificationUrl%>", fullPath)
//Set up the smtp for gmail to send the email
Dim mailClient As New SmtpClient()
With mailClient
.Port = 587 'try 465 if this doesn't work
.EnableSsl = True
.DeliveryMethod = SmtpDeliveryMethod.Network
.UseDefaultCredentials = False
.Credentials = New NetworkCredential(mailMessage.From.ToString(), "password")
.Host = "smtp.gmail.com"
End With
mailClient.Send(mailMessage)
Dim continueUrl As String = RegisterUser.ContinueDestinationPageUrl
If String.IsNullOrEmpty(continueUrl) Then
continueUrl = "~/"
End If
Response.Redirect(continueUrl)
End Sub
When you, or anyone, creates a MembershipProvider you need to specify whether the ProviderUserKey is going to be an integer or a Guid. The default SqlMembershipProvider implements it a a Guid while the default MySqlMembershipProvider implements it as an int.
You could always implement your own provider by inheriting from one of the defaults and implementing your own version of the ProviderUserKey
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.