Check User Password exists in MSAccess

[dorourke]

Hi

Can anyone tell me what the VBA scripting is to check if a current user has set a password or the password is blank.

We set up new users with a "blank" password and ask them to enter a password (using change password scripting) but this is uncontrolled and want to forse them to replace their "blank" password with a real password when they log on

Thanks

 

[JerryKlmns]

You could use a fuction to open a new connection with his UserName and a blank password. If it is succesfull then force them to change it.

 

[dorourke]

Thanks, but i was thinking more along the lines of a

"if user password exists then...."

that way it it doesn't exist we can force them to open the change password routine we have already installed

Any ideas?

 

[JerryKlmns]

If bUserHasBlankPassword Then
   DoCmd.OpenForm "frmChangePassword" ,,,,,acDialog
Else

End If

Function bUserHasBlankPassword()
Dim Adm_Cnn As ADODB.Connection
On Error Resume Next

Set Adm_Cnn = New ADODB.Connection
With Adm_Cnn
   .Provider = "Microsoft.Jet.OLEDB.4.0"
   .Properties("Data Source") = CurrentProject.FullName
   .Properties("Jet OLEDB:System database") = SysCmd(13)
   .Properties("User ID") = CurrentUser
   .Properties("Password") = ""
   .Properties("Mode") = 16
   .Open
   If Err = -2147217843 Then
       bUserHasBlankPassword = False

   Else
       bUserHasBlankPassword = True
       .Close
   End If
End With
Set Adm_Cnn = Nothing
End Function

You could also read the table MSysAccounts which resides in the mdw (database) file, for records where FGroup=0, and while looping the records call function bUserHasBlankPassword. That would be an automated process that could also be generalized to check for all users of any secured mdb file you use.

 

[dorourke]

Thanks

Ideally what I wanted to do was, when a user logs onto the system the program checks if tat user has a password set (and if not runs a change password form)

I was thinking along the lines of checking the MSysAccounts file for the esistance of a password for the CurrentUser.

Is there an inbuilt function that already does this (we are using old 2002 verison of access)

is there something along the lines of
..OpenRecordset (from MSysAccounts where user = CurrentUser & password isnotnull)
.. if recordset =0 then....

I have to apologise as my VB is self taught and a little rusty

Thanks

 

[JerryKlmns]

dorourke

Even for a user with blank password the field holding it in MSysAccounts table is not null!

I think the only way to check it is my function bUserHasBlankPassword

You might use a startup form to open in hidden mode and run the function. Use the checking code above my fuction.

A generaized version would need a table with all mdbs and its associated mdws and a table of users in mdws(include a True/False field=BlnkPsswrd). You might run an update query of

UPDATE tblMDB_MDW As A INNER JOIN tblUsersInMDWs As B ON
     A.TheMDW = B.TheMDW
SET BlnkPsswrd = bUserHasBlankPassword (TheMDB, TheMDW, TheUser);

And the function would be

Function bUserHasBlankPassword(strMDB As String, strMDW As String, strUser As String)
Dim Adm_Cnn As ADODB.Connection
On Error Resume Next

Set Adm_Cnn = New ADODB.Connection
With Adm_Cnn
   .Provider = "Microsoft.Jet.OLEDB.4.0"
   .Properties("Data Source") = strMDB 
   .Properties("Jet OLEDB:System database") = strMDW 
   .Properties("User ID") = strUser 
   .Properties("Password") = ""
   .Properties("Mode") = 16
   .Open
   If Err = -2147217843 Then
       bUserHasBlankPassword = False

   Else
       bUserHasBlankPassword = True
       .Close
   End If
End With
Set Adm_Cnn = Nothing
End Function

 

[dorourke]

Thansk for the info

 

[Revolution1200]

Hi dorourke,

Not sure if this helps you - I default my new user passwords to "password", then when a user logs in i use the following code

Dim cat As ADOX.Catalog
Dim usr As ADOX.User
Dim strPassword As String

Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Set usr = cat.Users(CurrentUser)

On Error Resume Next
usr.ChangePassword "password", ""

If Err.Number = 0 Then
'no error occurred so the old password must have = "Password"
'which is the default so prompt user to change
usr.ChangePassword "", "password"
DoCmd.OpenForm "frmchangePassword", , , , , acDialog

End If

this code just checks to see if an error occurs when i call the changepassword function of adox.usr, if the error number is zero then the default is set, i then pop up a box prompting the user to change the password.

Hope this helps.

Stuart

 

[JerryKlmns]

Stuart your code needs a reference to a library (ADOX) that is never selected by default and needs to be added. Versioning problems should also be dealt.

The notion of this approach could be accomplished with the connection object like

Adm_Cnn.Execute "Alter User " & strUser & " Password " & "" & "'Test'"

 

[dorourke]

Stuart

Your Defalut "Password" would have worked well but I found a "work around"

Although the password in MSysAccounts is encrypted and, as you correctly stated even a nul value is not null. What i did find is that all null passwords have the same encryption and therefore set up a query to find names that matched the encryption (i.e. all names with a null password)

Then, on loading the program, I run code to check if the CurrentUser marched the query list and if so forced them to enter a new passord.

A tad "dirty" in my approach but it seems to be doing the job


Thanks for all your help though, it is appreciated.
Regards
David