设置只有管理员才能改变AllowBypassKey属性

设置只有管理员才能改变AllowBypassKey属性

tmtony翻译:

在的帮助文件中说明CreateProperty 方法的语法:

Set property = object.CreateProperty (name, type, value, DDL)

其实最后一个参数是这个解释的(部分描述):

DDL 可选. 一个变量(逻辑子类型) 指定这个属性是否为DDL对象. 缺少值为False. 如果设置为TRUE,除非他有 dbSecWriteDef 权限,用户就不能改变或删除这个属性

CreateProperty 是用来创建或设置 AllowBypassKey 属性如果这个属性设为TRUE, 那就可以禁用户近SHIFT键来禁止启动属性和AutoExec 宏. 然而,ACCESS帮助中提供的例子没有使用第四个 DDL 参数. 这意味着任何人都可以打开数据据然后用程序复位AllowBypassKey 属性.

所以,为了限制普通用户去改变这个属性,所以我们设置第四个参数为TRUE 。

为了对比,我们也同时列出了ACCESS本身的例子以便参照

' *********** Code Start ***********

Function ChangePropertyDdl(stPropName As String, _

PropType As DAO.DataTypeEnum, vPropVal As Variant) _

As Boolean

' Uses the DDL argument to create a property

' that only Admins can change.

'

' Current CreateProperty listing in Access help

' is flawed in that anyone who can open the db

' can reset properties, such as AllowBypassKey

'

On Error GoTo ChangePropertyDdl_Err

Dim db As DAO.Database

Dim prp As DAO.Property

Const conPropNotFoundError = 3270

Set db = CurrentDb

' Assuming the current property was created without

' using the DDL argument. Delete it so we can

' recreate it properly

db.Properties.Delete stPropName

Set prp = db.CreateProperty(stPropName, _

PropType, vPropVal, True)

db.Properties.Append prp

' If we made it this far, it worked!

ChangePropertyDdl = True

ChangePropertyDdl_Exit:

Set prp = Nothing

Set db = Nothing

Exit Function

ChangePropertyDdl_Err:

If Err.Number = conPropNotFoundError Then

' We can ignore when the prop does not exist

Resume Next

End If

Resume ChangePropertyDdl_Exit

End Function

帮助本身的例子

Function ChangeProperty(strPropName As String, _

varPropType As Variant, varPropValue As Variant) As Integer

' The current listing in Access help file which will

' let anyone who can open the db delete/reset any

' property created by using this function, since

' the call to CraeteProperty doesn't use the DDL

' argument

'

Dim dbs As Database, prp As Property

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.

ChangeProperty = False

Resume Change_Bye

End If

End Function

' *********** Code End ***********