Disable Shift Key - Using Code But Can't Figure Out Problem 3

swaggel1 · Feb 10, 2004

Using Access 2000, I am trying to disable the shift key on my database so that my users can't bypass my startup procedures.

I found a good example on this site, in FAQ 181-1172 (Disable Design View Through VB Coding). Since I have security set up, I thought this would be a good approach, since it will enable/disable the startup options based on the login ID of the user. When I tried the code, it worked the first time I opened the database, in that the options were restricted. However, when I changed login IDs, the options weren't reset and stayed the same as the previous user's. The submitter stated that the code would need to be modified for Access 2000, but I didn't get any error messages. It just didn't work.

Has anyone else used this method in Access 2000, or would know why the options are not being reset? I am a beginner at VBA, so I am only to the point of being able to copy and paste the code, with minor modifications.

Thanks for your help! (For ease of reference, I have pasted the Access 97 code from FAQ 181-1172 below)

Option Compare Database
Option Explicit
Global sLogon As String

Public Function StartUp()
Dim Designer As String
Dim Restart As Boolean
Dim stAppName As String

Designer = "yourlogonhere"
FIND_USER

If sLogon = Designer Then
Restart = UnlockStartup
Else
Restart = LockStartup
End If

If Restart Then
'Close database and re-open
stAppName = "MSAccess.exe " & CurrentDb.Name
Call Shell(stAppName, 1)
DoCmd.Quit
Else
If sLogon <> Designer Then DoCmd.OpenForm "TitleForm"
End If

End Function
-----------------------------------
Sub FIND_USER()

On Error GoTo ERR_FIND_USER

Dim UserParam$
Dim sChk As String
Dim CurrentAuditor As String

UserParam$ = Environ("S_USER&quot

If UserParam$ = "" Then UserParam$ = Environ("USERNAME&quot

sLogon = UCase$(UserParam$)

EXIT_FIND_USER:
Exit Sub

ERR_FIND_USER:
MsgBox Error$
Resume EXIT_FIND_USER
End Sub
---------------------------------------------
Function LockStartup() As Boolean
Dim Restart As Boolean

Restart = False
ChangeProperty "StartupShowDBWindow", dbBoolean, False, Restart
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False, Restart
ChangeProperty "AllowFullMenus", dbBoolean, False, Restart
ChangeProperty "AllowToolbarChanges", dbBoolean, False, Restart
ChangeProperty "AllowBreakIntoCode", dbBoolean, False, Restart
ChangeProperty "AllowSpecialKeys", dbBoolean, False, Restart
ChangeProperty "AllowBypassKey", dbBoolean, False, Restart
Application.SetOption "Show Hidden Objects", False
LockStartup = Restart
End Function
-----------------------------------------------
Function UnlockStartup() As Boolean
Dim Restart As Boolean

Restart = False
ChangeProperty "StartupMenuBar", dbText, "(default)", Restart
ChangeProperty "StartupShowDBWindow", dbBoolean, True, Restart
ChangeProperty "StartupShowStatusBar", dbBoolean, True, Restart
ChangeProperty "AllowBuiltinToolbars", dbBoolean, True, Restart
ChangeProperty "AllowFullMenus", dbBoolean, True, Restart
ChangeProperty "AllowToolbarChanges", dbBoolean, True, Restart
ChangeProperty "AllowBreakIntoCode", dbBoolean, True, Restart
ChangeProperty "AllowSpecialKeys", dbBoolean, True, Restart
ChangeProperty "AllowBypassKey", dbBoolean, True, Restart
UnlockStartup = Restart
End Function
-------------------------------------------
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant, Restart As Boolean) As Integer
Dim dbs As Database, prp As Property
Dim CurrentPropVal As Variant
Const conPropNotFoundError = 3270

Set dbs = CurrentDb
On Error GoTo Change_Err

CurrentPropVal = dbs.Properties(strPropName)
If CurrentPropVal <> varPropValue Then
dbs.Properties(strPropName) = varPropValue
Restart = True 'need to restart database
End If
ChangeProperty = True
Change_Bye:
Exit Function

Change_Err:
If Err = conPropNotFoundError Then 'Property not found.
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function

To get it working just follow these steps:
1. Put the above code in a module in your db.
2. Create a macro called autoexec and put RunCode StartUp() in it.
3. In the StartUp function change the "Designer = " line to your logon id, or change the designer variable to an array of names which can access the database design.
4. In the StartUp function change the docmd.openform command to reference your start up form.

ESquared · Feb 10, 2004

>>However, when I changed login IDs, the options weren't reset and stayed the same as the previous user's.

Do you mean you closed Access, and started it up again? If you simply changed login IDs while it was running then it would not "lock" the database because your locking code is in the startup and not in the logout/login code. I suspect you didn't do this, though.

I am looking at doing somethng similar for a database I am designing, and I will be glad to try it out for you when I get there. I'll try to remember to get back to you.

You might consider a better method to specify the username. A clever person could change his environment variable and this would fool your database. Better to use a windows API call to retrieve the current username, if you are not going to be authenticating based on data in your database.

If you are truly concerned about security on your database, you might like to use Access's built-in security, although it can be a real hassle to get working (I tried).

Also, another security issue is "SQL Injection" and you should read up on this if you have any desire for a truly secure database and your database will be reporting complex error messages.

Please note that while you may prevent access to your database's Access front end (no pun intended), if someone can get ahold of the physical .mdb file they may be able to get full table dumps from it, even if it is password protected. I remember reading about methods to "crack" an Access password-protected database.

So the only remaining truly secure method is to host your database on an SQL server and prevent physical access to said server. The server should be running Unix, too:

http://story.news.yahoo.com/news?tm...u=/ap/20040210/ap_on_hi_te/microsoft_security

swaggel1 · Feb 11, 2004

When changing users, I did completely close Access. I have a shortcut set up to the database that accesses the associated workgroup. Each time I change users I close Access completely and restart it with the shortcut. So far all of the security and code I have added to the database is working, just not the piece mentioned above.

Thank you for your comments. As a beginner at VBA, I'm not sure what it all means, but I will try to look into it further.

SiJP · Feb 11, 2004

Create a new module and dump this code:

Code:

Option Compare Database
'Following functions are to set the bypass to
'either true or false.  This allows the designer
'to say who gets to see the tables or not :)
'(asuming that the database window is hidden)

'disallow letting the shift key be pushed when opening
'the database to access the db window
Sub SetBypassPropertyFalse()
Const DB_Boolean As Long = 1
    ChangePropertyFalse &quot;AllowBypassKey&quot;, DB_Boolean, False
End Sub

Function ChangePropertyFalse(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then    ' Property not found.
        Set prp = dbs.CreateProperty(strPropName, _
            varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        ChangePropertyFalse = False
        Resume Change_Bye
    End If
End Function

Sub SetBypassPropertyTrue()
Const DB_Boolean As Long = 1
    ChangePropertyTrue &quot;AllowBypassKey&quot;, DB_Boolean, True
End Sub

Function ChangePropertyTrue(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangePropertyTrue = False

Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then    ' Property not found.
        Set prp = dbs.CreateProperty(strPropName, _
            varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        ChangePropertyTrue = True
        Resume Change_Bye
    End If
End Function

On the background of a lock/unlock button, you can lock the database by calling SetBypassPropertyFalse or SetBypassPropertyTrue

(Not my code, can't remember where credits are due for this).

jbento · Feb 11, 2004

This thread helped me:
thread181-323160

Jerome Benton
JERPAT Web Designs

http://www.jerpat.org

GOD Is Good All The Time!!!

swaggel1 · Feb 12, 2004

Thanks, jbento - that was helpful information. I'm trying to figure out the best scenario for my purpose.

SiJP - To try your code, I created a new test database containing only a form with a lock and unlock button. I created a new module and pasted your code into it. My problem is this: I don't know how to call the SetBypassPropertyFalse and True using the buttons. I tried creating an On Click macro - I used the Run Code action, then entered SetBypassPropertyFalse() as the function name. I know this isn't the function, but I don't know how to create a function to call SetBypassPropertyFalse().

I'm sure there's an easy way to do this, but I've never done it before. Could you provide this information? Thanks!

mondoray · Feb 12, 2004

swaggel1,

I believe in doing things as simple as possible. Some of the experts believe they are a joke but they work and that's all that matters to me. Anyway for all its worth.

The method I use to disable/enable the shift key is via the use of two invisible command buttons placed on the startup form or switch board. The command buttons are very small (smaller than the size of the arrow head)and are placed on the form in a position that you know. If the arrow head is not in the exact position you wont get them to operate. It would take somebody for every to find their location if they were looking but most operators would have no idea.

I found this code on the net somwhere.

The first command button has the following:

Public Sub Command?_Click()
'This code disables shift key'
Dim db As Database
Dim prp As Property
Set db = CurrentDb
Set prp = db.CreateProperty("allowbypasskey", dbBoolean, False)
db.Properties.Append prp
End Sub

The other command button has the following:

Public Sub Command?_Click()
'This code re-enables shift key'
Dim db As Database
Set db = CurrentDb
db.Properties.Delete "allowbypasskey"
db.Properties.Refresh
End Sub

This procedure works very well. To enable/disable the shift key first you start the application then click on the location of the appropriate command button, close the application then restart, ie hold down the shift key, etc.

Hope this helps.

PS You also need to Microsoft DAO 3.6 Object Library set in your code references.

Mondoray

ESquared · Feb 12, 2004

Make sure you set the tab stop to no for those buttons.

And if you want even more security, only accept the click if ctrl is held down at the same time, or something like that.

You could even ask for a hardcoded password at this point. Or better, don't ask for one, just secretly and silently wait for the keystrokes that make it up. This way you could unlock your database even when someone was watching.

mondoray · Feb 12, 2004

ESquared,

Exactly. You also make sure that the control tip text is removed.

mondoray [ponder]

swaggel1 · Feb 17, 2004

With all of your suggestions, I was able to set up two buttons that are working just fine. Thanks everybody!!!!!

cooldisk2005 · Aug 11, 2005

Here is a site that will definitely help. It explains step by step and I did it last night and it works!!!!

http://www.microsoft-accesssolutions.co.uk/disable_shift_bypass.htm

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Disable Shift Key - Using Code But Can't Figure Out Problem 3

swaggel1

Technical User

ESquared

Programmer

swaggel1

Technical User

SiJP

Programmer

jbento

Technical User

swaggel1

Technical User

mondoray

Technical User

ESquared

Programmer

mondoray

Technical User

swaggel1

Technical User

cooldisk2005

Technical User

Similar threads

Part and Inventory Search

Sponsor