Get password of current VBA file via VBA

[LadyMarmalade]

Hi everybody,
I want certain functions of my database to be password protected. It's not a very high risk situation which warrants high security, it's just been decided that people shouldn't be allowed to delete things without awareness of knock on consequences etc...

Seeing as I wish to password protect the VBA anyway, I was hoping if perhaps I could just use the same password for other password-protected actions i.e. have the VBA code check if an entered password matches the password of its own protection.

I would also logically need to be able to programattically alter the password, so if that's doable...

If this is not a sensible way of going about it, then I'd appreciate a link perhaps to some sensible advice (I'm sure there's a more standard way of password protecting things, this just feels like a convenient way to kill two birds with one stone.)

 

[Ranman256]

I grab the userID when they open the main menu. Then enable the data or buttons if it is correct.
gvUser = Environ("Username")

Then lookup their password in the tUsers table

vPass = Inputbox("Enter Password","Security")
if vPass = Dlookup("[passwd]","tUsers","[userID]='" & gvUser & "'") then
   EnableBtns true
else
   EnableBtns false
endif

 

[arnelgp]

as what i know, you cannot determine the vbe password using code.

 

[LadyMarmalade]

as what i know, you cannot determine the vbe password using code.

Damn. That's a shame. I supposed it'd be a major security flaw.

I grab the userID when they open the main menu. Then enable the data or buttons if it is correct.
gvUser = Environ("Username")

Then lookup their password in the tUsers table

vPass = Inputbox("Enter Password","Security")
if vPass = Dlookup("[passwd]","tUsers","[userID]='" & gvUser & "'") then
   EnableBtns true
else
   EnableBtns false
endif

Hi,
I considered using something like this, but it feels very easy to mess about with...

 

[Ranman256]

OR you can use the exisiting window login to check against, eliminating the need for a tUser table.
Check against the windows authentication...

SUB btnLogin_Click()
Dim sUser As String, sPass As String, sDom As String

sUser = txtUser
sPass = txtPass
sDom = txtDom

If WindowsLogin(sUser, sPass, sDom) Then
   mbSafe = True
   DoCmd.OpenForm "frmMainMenu"
   DoCmd.OpenForm "frmLogin"
   DoCmd.Close
Else
   MsgBox "LOGIN INCORRECT", vbCritical, "Bad userid or password"
End If


'-----------------
Public Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
'-----------------

        'Authenticates user and password entered with Active Directory.

        On Error GoTo IncorrectPassword
        
        Dim oADsObject, oADsNamespace As Object
        Dim strADsPath As String
        
        strADsPath = "WinNT://" & strDomain
        Set oADsObject = GetObject(strADsPath)
        Set oADsNamespace = GetObject("WinNT:")
        Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)
        
        WindowsLogin = True    'ACCESS GRANTED
        
ExitSub:
        Exit Function
        
IncorrectPassword:
        WindowsLogin = False   'ACCESS DENIED
        Resume ExitSub
End Function

 

[LadyMarmalade]

OR you can use the exisiting window login to check against, eliminating the need for a tUser table.
Check against the windows authentication...

SUB btnLogin_Click()
Dim sUser As String, sPass As String, sDom As String

sUser = txtUser
sPass = txtPass
sDom = txtDom

If WindowsLogin(sUser, sPass, sDom) Then
   mbSafe = True
   DoCmd.OpenForm "frmMainMenu"
   DoCmd.OpenForm "frmLogin"
   DoCmd.Close
Else
   MsgBox "LOGIN INCORRECT", vbCritical, "Bad userid or password"
End If


'-----------------
Public Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
'-----------------

        'Authenticates user and password entered with Active Directory.

        On Error GoTo IncorrectPassword
        
        Dim oADsObject, oADsNamespace As Object
        Dim strADsPath As String
        
        strADsPath = "WinNT://" & strDomain
        Set oADsObject = GetObject(strADsPath)
        Set oADsNamespace = GetObject("WinNT:")
        Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)
        
        WindowsLogin = True    'ACCESS GRANTED
        
ExitSub:
        Exit Function
        
IncorrectPassword:
        WindowsLogin = False   'ACCESS DENIED
        Resume ExitSub
End Function

Thank you,
I'm also aware of this - however, that would mean anybody correctly logged into their PC would be able to do what they wanted...All it does it stops one person from using another person's PC to mess about.