tmtony翻譯:
在ACCESS的幫助文件中說明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 ***********