Re: Administer users via code
- From: "AzzA" <azadi@xxxxxxxxxxxxx>
- Date: 4 Oct 2005 03:29:11 -0700
> Can someone point me to some code snippits or similar which detail how to
> manage users via code. We dont want users to have to go through the normal
> workgroup interface simply to manage users.
Here are two more code snippets:
And once again sorry for no references to original authors....
----------------------------------------------------------------------
Change User Password in MDW from Form
-----------------------------------------------------------------------
Private Sub OK_Click()
On Error GoTo Err_OK_Click
Dim strUser As String
Dim strOldPW1 As String
Dim strNewPW1 As String
Dim strNewPW2 As String
Dim strMsg As String
Dim strTitle As String
Dim intType As Integer
Dim wrk As Object
Dim usrLocal As Object
strUser = CurrentUser()
If strUser = "Admin" Then
strMsg = "Password for Admin can't be changed. Please contact
system administrator."
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
End If
If IsNull(Forms![yourform]![youroldpasswordfield]) Then
' strMsg = "No Old Password entered"
' strTitle = "Password"
' intType = 16
' MsgBox strMsg, intType, strTitle
' Exit Sub
strOldPW1 = ""
Else
strOldPW1 = Forms![yourfrom]![youroldpasswordfield]
End If
If IsNull(Forms![yourfrom]![yournewpasswordfield]) Then
strMsg = "No New Password entered"
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
End If
If IsNull(Forms![yourform]![yournewpasswordconfirmfield]) Then
strMsg = "No verify entered"
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
End If
strNewPW1 = Forms![yourfrom]![yournewpasswordfield]
strNewPW2 = Forms![yourfrom]![yournewpasswordfieldconfirm]
Set wrk = DBEngine.Workspaces(0)
Set usrLocal = wrk.Users(strUser)
'* Check if New password and verify are the same
If strNewPW1 = strNewPW2 Then
'* Check Length of new password
If Len(strNewPW1) <= 14 Then
usrLocal.NewPassword strOldPW1, strNewPW1
Else
strMsg = "Password can have a length of maximum 14
characters."
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
End If
Else
strMsg = "Please verify the new password by entering it in the"
strMsg = strMsg + Chr$(13) & Chr$(10)
strMsg = strMsg + "verify box."
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
End If
DoCmd.Close
Exit_OK_Click:
Exit Sub
Err_OK_Click:
If Err = 3033 Then
strMsg = "Old Password not correct for this user profile."
strTitle = "Password"
intType = 16
MsgBox strMsg, intType, strTitle
Exit Sub
Else
MsgBox Error$
Resume Exit_OK_Click
End If
End Sub
--------------------------------------------------------------
CreateUser Method and Password and PID Properties Example
--------------------------------------------------------------
This example uses the CreateUser method and Password and PID properties
to create a new User object; it then makes the new User object a member
of different Group objects and lists its properties and groups.
Sub CreateUserX(ByRef strPassword As String)
Dim wrkDefault As Workspace
Dim usrNew As User
Dim grpNew As Group
Dim usrTemp As User
Dim prpLoop As Property
Dim grpLoop As Group
Set wrkDefault = DBEngine.Workspaces(0)
With wrkDefault
' Create and append new User.
Set usrNew = .CreateUser("NewUser")
usrNew.PID = "AAA123456789"
usrNew.Password = strPassword
.Users.Append usrNew
' Create and append new Group.
Set grpNew = .CreateGroup("NewGroup", _
"AAA123456789")
.Groups.Append grpNew
' Make the user "NewUser" a member of the
' group "NewGroup" by creating and adding the
' appropriate User object to the group's Users
' collection.
Set usrTemp = _
.Groups("NewGroup").CreateUser("NewUser")
.Groups("NewGroup").Users.Append usrTemp
Debug.Print "Properties of " & usrNew.Name
' Enumerate the Properties collection of NewUser. The
' PID property is not readable.
For Each prpLoop In usrNew.Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
Debug.Print "Groups collection of " & usrNew.Name
' Enumerate the Groups collection of NewUser.
For Each grpLoop In usrNew.Groups
Debug.Print " " & _
grpLoop.Name
Next grpLoop
' Delete the new User and Group objects because this
' is a demonstration.
.Users.Delete "NewUser"
.Groups.Delete "NewGroup"
End With
End Sub
------------------------------------------------------------------
And just dug up anothe piece:
Programmatically Managing Access Security
------------------------------------------------------------------
Access security can be programatically managed with just a little
up-front knowledge and a lot of caution.
The first thing required is to create an admin workspace. To do this we
use the poorly documented and little known PrivDBEngine object. This
function does this handily...
Code:
Public Function GetAdminWorkspace() As Workspace
On Error GoTo Proc_Err
Dim dbe As PrivDBEngine
Dim strPathToMDW As String
Dim strUser As String
Dim strPWD As String
Set dbe = New PrivDBEngine
strPathToMDW = "c:\SomePath\MyApp.mdw"
strUser = "AppAdmin"
strPWD = "gomer"
dbe.SystemDB = strPathToMDW
dbe.DefaultUser = strUser
dbe.DefaultPassword = strPWD
Set GetAdminWorkspace = dbe.Workspaces(0)
Proc_Exit:
Set dbe = Nothing
Exit Function
Proc_Err:
' Add Error Handling
Resume Proc_Exit
End Function
Notice that I've hard coded the path, user and password. I don't
typically do this or recommend it. You could pass those strings to the
function or have the function fetch them from a table.
Here's a function showing how to use this to change a user's password.
Notice that you don't need to know the old password.
Code:
Public Function ChangePWD(strUser As String, strNewPassword As String)
As Boolean
On Error GoTo Proc_Err
Dim usrChange As User
Dim strPassword As String
Set usrChange = GetAdminWorkspace().Users(strUser)
usrChange.NewPassword "", strNewPassword
ChangePWD = True
Proc_Exit:
GetAdminWorkspace().Users.Refresh
GetAdminWorkspace().Close
Exit Function
Proc_Err:
' Add Error handling
ChangePWD = False
Resume Proc_Exit
End Function
The Workspace object has several pretty handy methods. Take a look.
Note: Using code to manage security can be very tricky and unforgiving.
Test your code offline on a copy of your app and MDW.
Have fun!
Here is a function I have used to add a user:
Code:
Public Function sCreateUser(ByVal strUser As String, ByVal _
strPID As String, Optional varPwd As Variant) As Integer
'-----------------------------------------------------------
' Create a new user and add them to the Users group
' Returns True on success, False if user already exists
'================================================= ==========
Dim db As DATABASE
Dim ws As Workspace
Dim usr As User
Dim grpUsers As GROUP
Dim strSQL As String
' if the password isn't supplied, make sure you
' pass an empty string for the password argument
If IsMissing(varPwd) Then varPwd = ""
Set ws = DBEngine.Workspaces(0)
ws.Users.Refresh
On Error Resume Next
' check to see if user already exists by using inline
' error handling to trap any errors caused by setting
' a reference to a possibly non-existent user
strUser = ws.Users(strUser).Name
If Err.Number = 0 Then
MsgBox "The user you are trying to add already exists.", _
vbInformation, "Can't Add User"
sCreateUser = False
Else
' go ahead and create the user account
Set usr = ws.CreateUser(strUser, strPID, varPwd)
ws.Users.Append usr
ws.Users.Refresh
' now add the user to the Users group
Set grpUsers = ws.Groups("Users")
Set usr = grpUsers.CreateUser(strUser)
grpUsers.Users.Append usr
grpUsers.Users.Refresh
sCreateUser = True
End If
End Function
You may have to use an Admin Workspace for this to work, I have only
used this code as is while logged in as the owner of the DB.
Add the reference for DAO Library 3.6
If you want to clear the admin password then you would use this code:
ChangePWD "Admin", ""
The Call command is not really appropriate for Functions, only for
Subroutines.
-----------------------------------------------------------------------------
PS: All the code was found in various Access Forums while searching for
"programmatically manage secutiry" or similar search terms.
www.mvps.org/access/ comes highly recommended, as well as UtterAccess
Google Groups.
-----------------------------------------------------------------------------
.
- References:
- Administer users via code
- From: A C
- Administer users via code
- Prev by Date: Re: Administer users via code
- Next by Date: Re: Free Trial Protection
- Previous by thread: Re: Administer users via code
- Next by thread: RE: Who is logged in?
- Index(es):
Relevant Pages
|
