如何禁止用户使用Shift键跳过启动窗体

来源：网络
适用版本：Access 97、Access 2000、Access 2002、Access 2003

【问题详述】
如果程序设置了启动窗体，程序在打开时都会自动进入启动窗体界面，而不会显示Access的数据库窗体，但有些好奇的用户可能知道按住Shift键来打开程序，然后进入到数据库窗体，修改表或其他Access对象的内容，从而导致程序出错或者数据丢失，有什么办法禁止用户使用Shift键跳过启动窗体呢？
 
【问题处理】
可以通过设置“AllowBypassKey”属性来达到禁止使用Shift键的目的，而在Access数据库和Access项目中禁止Shift键需要使用不同的方法。

1．在Access数据库（MDB）中禁止Shift键的方法
首先创建一个设置数据库属性的通用函数。
Function ChangeProperty(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 ' 如果错误是数据库没有这个属性
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropvalue) ' 创建新的属性,并设置它的默认值
dbs.Properties.Append prp ' 将新的属性对象绑定到数据库
Resume Next ' 继续执行后面的代码
Else
ChangeProperty = False ' 如果是其它错误,则函数值返回假
Resume Change_Bye ' 转到函数退出处理
End If
End Function
然后调用这个通用函数来设置“AllowBypassKey”属性值为False，代码如下。
ChangeProperty "AllowBypassKey", 1, False　'False为禁止Shift键，True为恢复
如果想允许使用Shift键，则同样设置ChangeProperty "AllowBypassKey", 1, True就可以了。
 
2．在Access项目（ADP）中禁止Shift键的方法
首先创建一个检测项目的属性是否存在的函数，如果函数值返回真，则表示属性已经存在。
Private Function PropertyIsExist(MyPropName As String) As Boolean
PropertyIsExist = False '首先初始化返回值为假
Dim i As Integer
With CurrentProject.Properties '循环当前工程项目的所有属性
For i = 0 To .Count - 1 '如果项目属性已经存在,则返回真,否则返回假
If .Item(i).Name = MyPropName Then
PropertyIsExist = True
Exit For
End If
Next i
End With
End Function
然后创建一个设置项目属性的通用函数，根据属性值是否存在而进行不同的处理。
Function SetMyProperty(MyPropName As String, MyPropvalue As Variant) As Boolean
On Error GoTo SetMyProperty_In_Err '如果出错则转到错误处理程序
Dim i As Integer
With CurrentProject.Properties '循环当前工程项目的所有属性
If PropertyIsExist(MyPropName) Then '调用PropertyIsExist函数检查要设置的属性是否已经存在
For i = 0 To .Count - 1
If .Item(i).Name = MyPropName Then
.Item(i).Value = MyPropvalue '如果存在这个属性，则设置属性的值为新值
End If
Next i
Else
.Add MyPropName, MyPropvalue '如果属性不存在，则创建这个属性并设置它的默认值
End If
End With
SetMyProperty = True '设置函数的返回值为真
SetMyProperty_Exit:
Exit Function
SetMyProperty_In_Err: '如果出错则提示错误信息
MsgBox "设置属性出错:", Err, Error$
SetMyProperty = False
Resume SetMyProperty_Exit
End Function
与MDB一样，最后在程序中调用这个设置函数来禁止使用Shift键。
SetMyProperty "AllowBypassKey", False 'False为禁止Shift键，True为恢复
同样，也可以设置ChangeProperty "AllowBypassKey", 1, True来允许使用Shift键。
上述两种方法在设置"AllowBypassKey"属性为“False”之后，如果自己没有保留程序备份或没有留下后门，则自己也无法再使用Shift打开程序进入数据库窗口了。所以，修改这个属性之前请做好程序备份。
 
所谓“道高一尺，魔高一丈”，其实上面的方法还不能保证绝对的安全，通过在另一个数据库文件中运行代码来打开这个数据库并设置“AllowBypassKey”属性为真，就能破解Shift键。代码如下。
Public Function EnablePassKey(ByVal strFileName As String) As Boolean
On Error Resume Next
Dim accApp As Object ‘存储Application对象
Set accApp = CreateObject("Access.Application") ‘创建一个新的Access的Application
accApp.OpenCurrentDatabase strFileName ‘使用新的Application打开要设置的文件
accApp.CurrentProject.Properties.Add "AllowByPassKey", True ‘将AllowByPassKey属性值设置为真
accApp.Quit ‘关闭新的Application
If Err.Number = 0 Then EnablePassKey = True
End Function
其中参数StrFileName表示需要设置的Mdb或Adp文件的完整路径。
不过，对付上面的破解，也可以设置只有管理员才能改变这个属性，从而从根本上禁止普通用户通过其他途径来设置这个属性，方法是在通过CreateProperty (name, type, value, DDL)创建属性时，设置第4个参数DDL为True就可以了。