Чайникову - чайниково, разработчику - разработчиково.

Программист-Любитель
Дата: 09.09.2005 13:37:23
Наконец-то сделал себе, что бы один и тот же проект имел "защиту от шифта" и открывался с куцыми меню для обычного пользователя и с полными меню и безо всякой защиты для меня, любимого.

Сии 2 функции повешены на Load и Unload формы dlgStartup, которая загружается в скрытом виде при старте приложения. Ничего хитрого, но достаточно плезно.

Инджёй, диар френдс! :)

Public Function AutoExec()

    Dim rs As ADODB.Recordset
    'если у вас MDB файл а не проект ADP, подставьте другу. функцию, дающее имя пользователя
    Set rs = CurrentProject.Connection.Execute("SELECT SYSTEM_USER AS sUserName")
    If rs!sUserName = "dbo" Or InStr(1, rs!sUserName, "МоёФамилиё") > 0 Then
        Dim prop As Object
        For Each prop In CurrentProject.Properties
            If prop.Name = "AllowBypassKey" Then
                MsgBox _
                    "[AllowBypassKey] property enabled", _
                    vbApplicationModal + vbOKOnly + vbExclamation, _
                    "AutoExec system message"
                CurrentProject.Properties("AllowBypassKey") = True
                CurrentProject.Properties.Remove ("AllowBypassKey")
                GoTo Property_Found1
            End If
        Next prop
        MsgBox _
            "[AllowBypassKey] property not found", _
            vbApplicationModal + vbOKOnly + vbExclamation, _
            "AutoExec system message"
Property_Found1:
        CurrentProject.Properties("StartupShortcutMenuBar") = ""
        CurrentProject.Properties("AllowSpecialKeys") = 1
        CurrentProject.Properties("AllowBuiltInToolbars") = 1
        CurrentProject.Properties("AllowShortcutMenus") = 1
        CurrentProject.Properties("StartUpShowStatusBar") = 1
        CurrentProject.Properties("StartUpForm") = ""
        CurrentProject.Properties("StartUpShowDBWindow") = 0
        CurrentProject.Properties("StartUpMenuBar") = ""
        CurrentProject.Properties("AllowFullMenus") = 1
        CurrentProject.Properties("AllowToolbarChanges") = 1
    Else
        For Each prop In CurrentProject.Properties
            If prop.Name = "AllowBypassKey" Then
                CurrentProject.Properties("AllowBypassKey") = False
                GoTo Property_Found2
            End If
        Next prop
        CurrentProject.Properties.Add "AllowBypassKey", False
        CurrentProject.Properties("AllowBypassKey") = False
Property_Found2:
        CurrentProject.Properties("StartupShortcutMenuBar") = ""
        CurrentProject.Properties("AllowSpecialKeys") = 0
        CurrentProject.Properties("AllowBuiltInToolbars") = 0
        CurrentProject.Properties("AllowShortcutMenus") = 0
        CurrentProject.Properties("StartUpShowStatusBar") = 1
        CurrentProject.Properties("StartUpForm") = "Form.tblDeal"
        CurrentProject.Properties("StartUpShowDBWindow") = 0
        CurrentProject.Properties("StartUpMenuBar") = ""
        CurrentProject.Properties("AllowFullMenus") = 0
        CurrentProject.Properties("AllowToolbarChanges") = 0
    End If
    rs.Close

    Dim ctl As Office.CommandBarControl
    Dim pop As Office.CommandBarPopup
    Dim btn As Office.CommandBarButton

    For Each ctl In Application.CommandBars("Menu bar").Controls
        If ctl.Caption = "ПользовательскоеПодменюВГлавномМеню" Then
            ctl.Delete
        End If
    Next ctl
    
    Set pop = Application.CommandBars.Item("Menu bar").Controls.Add(msoControlPopup)
    With pop
        .Caption = "ПользовательскоеПодменюВГлавномМеню"
        .BeginGroup = True
    End With
    
    Set btn = pop.Controls.Add(msoControlButton)
    With btn
        .Caption = "ПользовательскийПункт1"
        .Tag = "ПользовательскийПункт1"
        .OnAction = "Menu.UserForm1"
    End With
    Set btn = pop.Controls.Add(msoControlButton)
    With btn
        .Caption = "ПользовательскийПункт2"
        .Tag = "ПользовательскийПункт2"
        .OnAction = "Menu.UserForm2"
    End With
    Set btn = pop.Controls.Add(msoControlButton)
    With btn
        .Caption = "ПользовательскийПункт3"
        .Tag = "ПользовательскийПункт3"
        .OnAction = "Menu.UserForm3"
    End With
    
End Function

Public Function AutoExit()

    Dim ctl As Office.CommandBarControl
    Dim pop As Office.CommandBarPopup
    Dim btn As Office.CommandBarButton

    For Each ctl In Application.CommandBars("Menu bar").Controls
        If ctl.Caption = "ПользовательскоеПодменюВГлавномМеню" Then
            ctl.Delete
        End If
    Next ctl
    
End Function
msdatabase
Дата: 09.09.2005 14:05:42
у меня юзеры запускают приложения в рантайм режиме -
встроенные меню убираются автоматом

+ в зависимости от роли меняется список доступных меню и функционал форм
(давно уже сделал так по совету латука)

 if cnn.Execute("SELECT CAST(IS_MEMBER('KA_Admin') + IS_MEMBER('db_owner') AS  
 
 Bit)").Fields(0)=1 then  
msflm
Дата: 09.09.2005 14:19:20
я себе тоже самое немного по другому замутил.
сделал базу с формой и из нее отключаю все эти дела на других базах.
Баз у меня тут много -запаришься в каждую формы вставлять. Картинка с другого сайта.
плюс сделал еще форму -которая показывает мне юзверей подконнектенных к базе - осталось еще прикрутить фичу, чтобы можно было их из баз выкидывать Картинка с другого сайта.