I have problem with authentication LDAP in aps classic application. I found the script for do it but it is not working. Could anyone tell me what I need to have its done? I attach below the authentification which always returns false. I apreciate for the examples for the variables from this function, becose I dont know where I did wrong.
Thank you for your attention.
function AuthenticateUser(Username,Password,Domain)
dim strUser,strPass,strQuery,oConn,cmd,oRS
AuthenticateUser = false
strQuery = "SELECT cn FROM 'LDAP://" & Domain & "' WHERE
objectClass='*'"
set oConn = server.CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOOBJECT"
oConn.properties("User ID") = Username
oConn.properties("Password")=Password
oConn.properties("Encrypt Password") = true
oConn.open "DS Query", Username,Password
set cmd = server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = oConn
cmd.CommandText = strQuery
on error resume next
set oRS = cmd.Execute
if oRS.bof or oRS.eof then
AuthenticateUser = false
else
AuthenticateUser = true
end if
set oRS = nothing
set oConn = nothing
end function
Related
I have built this VBA function but I'm getting the below error (see the next screenshot) in the below portion of the code:
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
Public Sub UserLogoutDetail(UserEmail As String)
Dim MySQL As String
Dim RstUserAccess As New ADODB.Recordset
Dim CmdUserAccess As New ADODB.Command
Dim i As Integer
'Setup the command
Set CmdUserAccess.ActiveConnection = fGetConn
CmdUserAccess.CommandType = adCmdText
MySQL = "UPDATE User_Access_TABLE SET EXIT_DATA = #" & Now & "# WHERE (((ID)=" & GetID_ToUpdate(UserEmail) & "))"
CmdUserAccess.CommandText = MySQL
RstUserAccess.CursorLocation = adUseClient
RstUserAccess.CursorType = adOpenDynamic
RstUserAccess.LockType = adLockOptimistic
'Open the connection
RstUserAccess.Open CmdUserAccess
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
'Cleanup
If CBool(CmdUserAccess.State And adStateOpen) = True Then
Set CmdUserAccess = Nothing
End If
If CBool(fGetConn.State And adStateOpen) = True Then
CloseConn
End If
End Sub
Error message
Do you have any suggestion?
Thanks
I have tried to change my code many times
Have a asp.net(vb.net) login page that I need set up to grant access to users base on EmployeeTypeID. The following code needs to be converted into vb.net from Access vb6 or written in vb.net
If rs!EmployeeTypeID = 2 Then
rs.Close
Me.LoginLabel.Visible = False
DoCmd.OpenForm "DetectIdleTIme", , , , , acHidden
DoCmd.OpenForm "frmProcessTimer", , , , , acHidden
DoCmd.OpenForm "frmCRMControlCenter"
DoCmd.Close acForm, Me.Name
Exit Sub
End If
If rs!EmployeeTypeID = 3 Then
Dim prop As Property
On Error GoTo SetProperty
If MsgBox("Would you like to turn on the ByPass Key?", vbYesNo, "Allow Bypass?") = vbYes Then
CurrentDb.Properties("AllowBypassKey") = True
Else
CurrentDb.Properties("AllowBypassKey") = False
End If
rs.Close
Me.LoginLabel.Visible = False
DoCmd.OpenForm "DetectIdleTIme", , , , , acHidden
DoCmd.OpenForm "frmProcessTimer", , , , , acHidden
DoCmd.OpenForm "frmCRMControlCenter"
DoCmd.Close acForm, Me.Name
Exit Sub
This should help :)
Protected Sub UserLogin()
Dim Username As String = Me.txtUserName.Text
Dim Password As String = Me.txtPassword.Text
Dim Connstr As String = "SERVER:BLAHBALHUID" ' Your connection string <<<<
Dim con As SqlConnection = New SqlConnection(Connstr)
'Query string - using paramters (#User and #Pwd to set the username and password criteria)
Dim qry As String = "SELECT Username, Password, EmployeeTypeID FROM Employees WHERE Username =#User AND Password=#Pwd"
Dim cmd As SqlCommand = New SqlCommand(qry, con)
'Using cmd.paramters means that you wont get any SQL injections
'- definately google SQL injections and check out some of the Youtubes!! :)
cmd.Parameters.Add("#User", SqlDbType.VarChar).Value = Username
cmd.Parameters.Add("#Pwd", SqlDbType.VarChar).Value = Password
con.Open()
Dim rdr As SqlDataReader = cmd.ExecuteReader
Dim Found_A_Record As Boolean = False
Dim EmployeeType As String = Nothing
While rdr.Read
'if there is a row - then we have found the username and password that matches
'Therefore - this must be a user with the username and matching password
Found_A_Record = True
EmployeeType = rdr("EmployeeTypeID")
End While
cmd.Dispose()
con.Close()
If Not Found_A_Record Then
'No records found - exit? or do whatever would be for not correct details
End If
Select Case EmployeeType
Case "1"
Response.Redirect("~/CustomerRelationshipManagement.aspx")
Case "2"
Response.Redirect("~/CRMControlCenter.aspx")
Case "3"
Response.Redirect("~/CRMControlCenter.aspx")
Case Else
Response.Write("<script>alert('Incorrect Username or Password.', 'Login Failed')</script>")
End Select
End Sub
I am trying to send some variables, using a session, to the next page "ProcedureSelectionForm.aspx". As you can see, the sessions have been commented out. The code below will work (without sending the variable of course). However, when you remove the comments the .onclick function reloads the page rather than navigating to "ProcedureSelectionForm.aspx". For this reason, I believe this is where my problem is. The first two columns are "Account" and "Password" in the database. I have not misspelled anything. I am new to VB and ASP.net and would appreciate some explanation as to what is happening and why my desired functionality isn't materializing. Thank you for your help!
If IsValid Then
Try
Dim strSQL = "select * from CreatePatient where Account = #Account and Password = #Password"
Using CCSQL = New SqlConnection(ConfigurationManager.ConnectionStrings("CreatePatientConnectionString").ConnectionString)
Using CCUser = New SqlCommand(strSQL, CCSQL)
CCSQL.Open()
CCUser.Parameters.Add("#Account", Data.SqlDbType.VarChar).Value = PatientAccount.Text
CCUser.Parameters.Add("#Password", Data.SqlDbType.VarChar).Value = PatientPass.Text
CCUser.ExecuteNonQuery()
'Using reader As SqlDataReader = CCUser.ExecuteReader()
'If reader.HasRows Then
'reader.Read()
'Session("user") = reader("Account")
'Session("pass") = reader("Password")
Response.Redirect("ProcedureSelectionForm.aspx")
'End If
'End Using
End Using
End Using
Catch ex As Exception
Label1.Text = ex.Message
End Try
End If
My friend was able to make time to help me out. I am unsure of what he did differently besides closing connections
If IsValid Then
Dim CCSQL As New SqlConnection
Dim CCUser As New SqlCommand
Dim strSQL As String
Dim dtrUser As SqlDataReader
Try
CCSQL.ConnectionString = ConfigurationManager.ConnectionStrings("CreatePatientConnectionString").ConnectionString
strSQL = "Select * from CreatePatient where Account=#user and Password=#pwd"
CCUser.CommandType = Data.CommandType.Text
CCUser.CommandText = strSQL
CCUser.Parameters.Add("#user", Data.SqlDbType.VarChar).Value = PatientAccount.Text
CCUser.Parameters.Add("#pwd", Data.SqlDbType.VarChar).Value = PatientPass.Text
CCSQL.Open()
CCUser.Connection = CCSQL
dtrUser = CCUser.ExecuteReader()
If dtrUser.HasRows Then
dtrUser.Read()
Session("user") = dtrUser("Account")
Session("level") = dtrUser("Password")
Response.Redirect("ProcedureSelectionForm.aspx")
Else
Label1.Text = "Please check your user name and password"
End If
dtrUser.Close()
CCSQL.Close()
Catch ex As Exception
Label1.Text = ex.Message
End Try
End If
I am on a tight deadline but i will get back to those interested with an answer. Thank you for your effort.
You don't want to do .ExecuteNonQuery() when you are actually doing a query (i.e. a SQL "SELECT" statement. You can just do the .ExecuteReader() to read those two values.
Also, I presume you are trying to validate the Account and Password; otherwise you could just set Session("user") = PatientAccount.Text and set Session("pass") = PatientPass.Text.
OK, I am trying to write a Classic ASP function that will call a SQL function and return the output.
I am trying to use a paramaterized ADODB connection but I don't quite know how these work. Trying to learn the correct way.
The SQL function just takes two string input where one is a "salt" and the other the actual text and turnes it into a hex.
Works fine in SQL but I just can not get it to work through classic ASP.
I keep getting,
ADODB.Command error '800a0cc1'
Item cannot be found in the collection corresponding to the requested name or ordinal.
Sub Encrypt(plainString)
strSQL = "SET NOCOUNT ON;SELECT dbo.Encrypt('xx', '?') as keycode"
Set cnnEncrypt = Server.CreateObject("ADODB.Connection")
cnnEncrypt.open CONNSTRING
Dim cmd1
Set cmd1 = Server.CreateObject("ADODB.Command")
cmd1.ActiveConnection = cnnEncrypt
cmd1.CommandText = strSQL
cmd1.CommandType = adCmdText
cmd1.Parameters(0) = plainString (**Original Error Occured Here!!!!**)
Set rsEncrypt = cmd1.Execute()
If not rsEncrypt.EOF Then
Encrypt = rsEncrypt.Fields("keycode").Value
Else
Encrypt = "blank"
End If
' Clean Up
rsEncrypt.Close
Set rsEncrypt = Nothing
cnnEncrypt.Close
Set cnnEncrypt = Nothing
End Sub
New Working Version after reviewing "Cheran Shunmugavel" answer.
Calling on site like this
< % Response.Write Decrypt(Encrypt("test")) % >
You can't print the Encrypted code to the page because it is Binary. You would need a Binary to String function.
I converted from Sub to Function because I wanted the function to return a value.
Function Encrypt(byVal plainString)
strSQL = "SET NOCOUNT ON;SELECT dbo.Encrypt('xx', ?) as keycode"
Set cnnEncrypt = Server.CreateObject("ADODB.Connection")
cnnEncrypt.open CONNSTRING
Dim cmd1
Set cmd1 = Server.CreateObject("ADODB.Command")
cmd1.ActiveConnection = cnnEncrypt
cmd1.CommandText = strSQL
cmd1.CommandType = adCmdText
cmd1.Parameters.Append cmd1.CreateParameter("", adVarChar, adParamInput, Len(plainString)+1, plainString)
Set rsEncrypt = cmd1.Execute()
If not rsEncrypt.EOF Then
Encrypt = rsEncrypt.Fields("keycode").Value
Else
Encrypt = "blank"
End If
' Clean Up
rsEncrypt.Close
Set rsEncrypt = Nothing
cnnEncrypt.Close
Set cnnEncrypt = Nothing
End Function
And here is the decrypt function.
Function Decrypt(byVal plainString)
strSQL = "SET NOCOUNT ON;SELECT dbo.Decrypt('xx', ?) as keycode"
Set cnnDecrypt = Server.CreateObject("ADODB.Connection")
cnnDecrypt.open CONNSTRING
Dim cmd1
Set cmd1 = Server.CreateObject("ADODB.Command")
cmd1.ActiveConnection = cnnDecrypt
cmd1.CommandText = strSQL
cmd1.CommandType = adCmdText
cmd1.Parameters.Append cmd1.CreateParameter("", adVarBinary, adParamInput, LenB(plainString)+1, plainString)
Set rsDecrypt = cmd1.Execute()
If not rsDecrypt.EOF Then
Decrypt = rsDecrypt.Fields("keycode").Value
Else
Decrypt = "blank"
End If
' Clean Up
rsDecrypt.Close
Set rsDecrypt = Nothing
cnnDecrypt.Close
Set cnnDecrypt = Nothing
End Function
First off, you don't need delimiters around the parameter placeholder. SQL Server will handle it appropriately.
strSQL = "SET NOCOUNT ON;SELECT dbo.Encrypt('xx', ?) as keycode"
Secondly, the Parameters collection is initially empty and must be populated before you try to access it (i.e., the line cmd1.Parameters(0) = plainString). There are several ways of doing this, but I prefer creating the parameters manually using the CreateParameter method:
cmd1.Parameters.Append cmd1.CreateParameter("", adVarChar, adParamInput, Len(plainString), plainString)
Also, it's not apparent from your code, but make sure you've got the ADO constants defined, either by referencing the type library, or by including adovbs.inc.
I need to use LDAP to authenticate users for an old ASP website.
I have been using the code found here.
It looks like this:
<%# LANGUAGE=VBSCRIPT %>
<%Option Explicit%>
<%
Function getADUserInfo(strUID)
on error resume next
strGeneralLookupError = false
strBase = "<LDAP://DC=[DOMAIN], DC=[DOMAIN EXETENTION]>"
strFilter = "(sAMAccountName=" & strUID & ")"
strAttributes = "cn, mail, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
'strAttributes = "cn, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
strScope = "subtree"
strFullCommand = strBase & ";" & strFilter & ";" & strAttributes & ";" & strScope
set rsADUserInfo = Server.CreateObject("ADODB.Recordset")
set rsADUserInfo = connAD.Execute(strFullCommand)
if err.number <> 0 then
strGeneralLookupError = true
end if
set getADUserInfo = rsADUserInfo
set rsADUserInfo = Nothing
End Function
Sub getUserData(p_strUserID)
on error resume next
set rsUserData = Server.CreateObject("ADODB.Recordset")
set rsUserData = getADUserInfo(p_strUserID)
if not rsUserData.EOF then
strUserGN = rsUserData("givenName")
strUserSN = rsUserData("sn")
strUserOU = rsUserData("company")
strUserEmail = rsUserData("mail")
strUserPhone = rsUserData("telephoneNumber")
else
strADLookupSuccess = false
end if
rsUserData.Close
set rsUserData = Nothing
End Sub
on error resume next
response.expires = 0
DIM connAD, rsUserData, rsADUserInfo
DIM strUserGN, strUserSN, strUserOU, strUserEmail, strUserPhone
DIM strBase, strFilter,strAttributes, strScope, strFullCommand
DIM strGeneralLookupError, strADLookupSuccess
DIM strUserID
strUserGN = "The user can not be found in the system."
strGeneralLookupError = false
strADLookupSuccess = true
set connAD = Server.CreateObject("ADODB.Connection")
connAD.Provider = "ADsDSOObject"
connAD.Properties("User ID") = "[DOMAIN]\[USERNAME]" ' ### remember to make sure this user has rights to access AD
connAD.Properties("Password") = "[PASSWORD]"
connAD.Properties("Encrypt Password") = true
connAD.Open
strUserID = "[USERNAME YOU WANT INFO FOR]"
call getUserData(strUserID)
connAD.Close
set connAD = Nothing
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>ASP Code to access AD with LDAP Page</title>
</head>
<body>
<%=strUserGN%>
<%=strUserSN%><br />
<%=strUserOU%><br />
<%=strUserEmail%><br />
<%=strUserPhone%><br />
</body>
</html>
I can pull back info using C# so I don't think it's the server that is causing the issue.
All I end up with is a 2147217865 error.
The AD server is Windows Server 2003.
The web server is IIS on XP Pro.
I have tried changing strFullCommand to:
Select cn From 'LDAP://SEVERPATH' where objectClass='user'" & " and objectcategory='person'
No dice there. Any ideas?
This works:
function AuthenticateUser(UserName, Password, Domain)
dim strUser
' assume failure
AuthenticateUser = false
strUser = UserName
strPassword = Password
strQuery = "SELECT cn FROM 'LDAP://" & Domain & "' WHERE objectClass='*' "
set oConn = server.CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOOBJECT"
oConn.Properties("User ID") = strUser
oConn.Properties("Password") = strPassword
oConn.Properties("Encrypt Password") = true
oConn.open "DS Query", strUser, strPassword
set cmd = server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = oConn
cmd.CommandText = strQuery
on error resume next
set oRS = cmd.Execute
if oRS.bof or oRS.eof then
AuthenticateUser = false
else
AuthenticateUser = true
end if
set oRS = nothing
set oConn = nothing
end function
The first thing I'd do to debug this is get rid of those On Error Resume Next statements. They could be hiding a multitude of sins that you're not seeing properly reported.