Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

禁止SHIFT键使用(设置启动选项框)

时 间:2009-03-03 17:55:00
作 者:沈军   ID:2469  城市:东莞
摘 要:ACCESS应用程序编制完成后,封装自己的应用程序非常重要。一般我采取的方法如下:
    1、设置VB密码;
    2、通过程序禁止或允许“SHIFT”键的使用;
    3、建立后台带有密码的数据库文件,利用自制的程序在前台程序中建立这个联接。
    通过以上方法操作,基本上可以防止一般用户进入到自己数据库文件内部。
正 文:

'以下代码中介绍如何禁止和允许“SHIFT”键的使用,这些代码都是控制ACCESS应用程序中菜单栏-工具-启动子菜单选项中的值,在启动选项窗口中我们虽看不到这一项,但仍然是有效的。

'Me.UserPassWord1是建立在一个特别窗体上的控制(复选框),在这个特别窗体打开的时候需要输入自制的密码方可打开。当访问密码正确时,显示这个控件并由自己控制设置。当选定它时,允许SHIFT键使用;相反,禁止SHIFT键使用

Sub SetStartupProperties()
    Const DB_Text As Long = 10
    Const DB_Boolean As Long = 1
    If Me.UserPassWord1 = -1 Then
        ChangeProperty "StartUpMenuBar", DB_Text, ""
        ChangeProperty "AppTitle", DB_Text, ""
        ChangeProperty "StartupShowDBWindow", DB_Boolean, True
        ChangeProperty "StartupShowStatusBar", DB_Boolean, True
        ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True
        ChangeProperty "AllowFullMenus", DB_Boolean, True
        ChangeProperty "AllowBreakIntoCode", DB_Boolean, True
        ChangeProperty "AllowSpecialKeys", DB_Boolean, True ‘允许SHIFT键使用 有效
        ChangeProperty "AllowToolbarchanges", DB_Boolean, True
        ChangeProperty "Allowshortcutmenus", DB_Boolean, True
        ChangeProperty "AppIcon", DB_Text, ""

        ChangeProperty "AllowBypassKey", DB_Boolean, True
    Else
        ChangeProperty "StartUpMenuBar", DB_Text, "主控菜单"
        ChangeProperty "AppTitle", DB_Text, "集运管理"
        ChangeProperty "StartupShowDBWindow", DB_Boolean, False
        ChangeProperty "StartupShowStatusBar", DB_Boolean, False
        ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False
        ChangeProperty "AllowFullMenus", DB_Boolean, False
        ChangeProperty "AllowBreakIntoCode", DB_Boolean, False
        ChangeProperty "AllowSpecialKeys", DB_Boolean, False  ’禁止SHIFT键使用 无效
        ChangeProperty "AllowToolbarchanges", DB_Boolean, False
        ChangeProperty "Allowshortcutmenus", DB_Boolean, False
        ChangeProperty "AppIcon", DB_Text, Application.CurrentProject.Path & "\coth.ico"    '"e:\contwork\coth.ico"

        ChangeProperty "AllowBypassKey", DB_Boolean, False
    End If
End Sub


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



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助