frmaclmanage.frm

vb开发的连接mysql的工作流设置程序,图形化工作流自定义工具,原先是连接到Domino上的工作流自定义工具,现修改至mysql上,后台管理员设置工作流,前台读取数据库调用.

    LevelChange
End Sub

Private Sub cmd_Click(Index As Integer)
'    Dim strNames() As String, strRole As String
'    Dim i As Long
'    On Error GoTo ErrHandler
'    Select Case Index
'    Case 0, 1 '确定、取消
'        If Index = 0 Then SaveACL
'        Unload Me
'    Case 2 '添加人员
'        ReDim strNames(0)
'        strNames = frmSetPeople2.Display(strNames)
'        For i = LBound(strNames) To UBound(strNames)
'            If strNames(i) <> "" Then
'                'Set mCurrentAclEntry = mCurrentAcl.CreateACLEntry(strNames(i), 6)
'                AddSelect strNames(i)
'                'Me.LstAclList.ListIndex = Me.LstAclList.ListCount - 1
'            End If
'        Next i
'    Case 3 '删除人员
'        i = Me.LstAclList.ListIndex
'        mCurrentAcl.RemoveACLEntry Me.LstAclList.List(i)
'        Me.LstAclList.RemoveItem i
'    Case 4 '添加角色
'        strRole = "[" & InputBox("请输入角色名：", "添加角色") & "]"
'        mCurrentAcl.AddRole strRole
'        AddRoles strRole
'    Case 5 '删除角色
'        strRole = "[" & InputBox("请输入要删除的角色名：", "删除角色") & "]"
'        For i = 0 To Me.LstRole.ListCount - 1
'            If strRole = Me.LstRole.List(i) Then
'                mCurrentAcl.DeleteRole strRole
'                Me.LstRole.RemoveItem i
'                Exit Sub
'            End If
'        Next i
'    Case Else
'    End Select
'    Exit Sub
'ErrHandler:

End Sub

Public Sub Display()
    Dim v() As String
    Set mDBAcls = New Collection
'    Set mDBAclEntry = New Collection
    Dim i As Long
    v = MNotes.getDBNames
    For i = LBound(v) To UBound(v)
        If v(i) <> "" Then
            Me.cmbDBName.AddItem v(i)
        End If
    Next i
    Me.CmbUserType.ListIndex = 0
'    DBChange
    Me.Icon = frmMain.Icon
    Me.cmbDBName.ListIndex = 0
'    LstAclList_Click
    Me.Show vbModal
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Set mDBAcls = Nothing
    'Set mCurrentAcl = Nothing
    LastEntry = 0
End Sub

Private Sub DBChange()
'    Dim lngEntry As Long
'    lngEntry = Me.LstAclList.ListIndex
'    If lngEntry <> -1 Then SaveEntry lngEntry
'    Dim i As Long
'    Dim strdbName As String
'    i = Me.CmbDBName.ListIndex
'    strdbName = Me.CmbDBName.List(i)
'    Me.LstAclList.Clear
'    Me.LstRole.Clear
'    On Error GoTo ErrHandler
'    Set mCurrentAcl = mDBAcls.Item(strdbName)
'    Dim clsEntry As NotesACLEntry
'    Set clsEntry = mCurrentAcl.GetFirstEntry
'    Do While Not (clsEntry Is Nothing)
'        Me.LstAclList.AddItem MNotes.getNotesName(clsEntry.name)
'        Set clsEntry = mCurrentAcl.GetNextEntry(clsEntry)
'    Loop
'    Dim v As Variant
'    v = mCurrentAcl.Roles
'    For i = LBound(v) To UBound(v)
'        If v(i) <> "" Then
'            AddRoles CStr(v(i))
'        End If
'    Next i
'    Me.LstAclList.ListIndex = 0
'    'LstAclList_Click
''    AclEntryChange
'    Exit Sub
'ErrHandler:
'    Dim clsdb As NotesDatabase
'    Set clsdb = MNotes.getDatabase(strdbName)
'    If Not (clsdb Is Nothing) Then
'    If clsdb.IsOpen Then
'        Set mCurrentAcl = clsdb.ACL
'        mDBAcls.Add mCurrentAcl, strdbName
'        Resume Next
'    Else
'        MsgBox "不能打开数据库 " & strdbName & _
'            " ，请确认系统配置库中数据库路径是否正确！"
'        Set mCurrentAcl = Nothing
'    End If
'    Else
'        MsgBox "不能打开数据库 " & strdbName & _
'            " ，请确认系统配置库中数据库路径是否正确！"
'        Set mCurrentAcl = Nothing
'    End If
'    Set clsdb = Nothing
End Sub

Private Sub AclEntryChange()
'    Dim i As Long, j As Long
'    Dim strAclName As String
'    i = Me.LstAclList.ListIndex
'    strAclName = Me.LstAclList.List(i)
'    'Set mCurrentAclEntry = mCurrentAcl.GetEntry(strAclName)
'    Me.CmbUserType.ListIndex = mCurrentAclEntry.UserType
'    Me.CmbUserType.Enabled = (strAclName <> "-Default-")
'    Dim v As Variant
'    For i = 0 To Me.LstRole.ListCount - 1
'        Me.LstRole.Selected(i) = False
'    Next i
'    v = mCurrentAclEntry.Roles
'    For i = LBound(v) To UBound(v)
'        For j = 0 To Me.LstRole.ListCount - 1
'            If v(i) = Me.LstRole.List(j) Then
'                Me.LstRole.Selected(j) = True
'                GoTo Continue
'            End If
'        Next j
'Continue:
'    Next i
'    Me.CmbOptLevel.ListIndex = 6 - mCurrentAclEntry.level
'    'LevelChange
End Sub

Private Sub LevelChange()
    '
'    Dim clsTmpEntry As NotesACLEntry
'    Dim lngtemp As Long
'    lngtemp = 6 - Me.CmbOptLevel.ListIndex
'    If lngtemp <> mCurrentAclEntry.level Then
'        Set clsTmpEntry = mCurrentAcl.CreateACLEntry("Temp", lngtemp)
'    Else
'        Set clsTmpEntry = mCurrentAclEntry
'    End If
'    Me.ChkEntry(0).value = Abs(clsTmpEntry.CanCreateDocuments)
'    Me.ChkEntry(1).value = Abs(clsTmpEntry.CanDeleteDocuments)
'    Me.ChkEntry(2).value = Abs(clsTmpEntry.CanCreatePersonalAgent)
'    Me.ChkEntry(3).value = Abs(clsTmpEntry.CanCreatePersonalFolder)
'    Me.ChkEntry(4).value = Abs(clsTmpEntry.CanCreateSharedFolder)
'    Me.ChkEntry(5).value = Abs(clsTmpEntry.CanCreateLSOrJavaAgent)
'    Me.ChkEntry(6).value = Abs(clsTmpEntry.IsPublicReader)
'    Me.ChkEntry(7).value = Abs(clsTmpEntry.IsPublicWriter)
'    Dim i As Long, j As Long
'    For i = 0 To 7
'        Me.ChkEntry(i).Enabled = False
'    Next i
'    i = Me.CmbOptLevel.ListIndex
'    Select Case i
'    Case 0  '管理者
'        Me.ChkEntry(1).Enabled = True
'    Case 1  '设计者
'        Me.ChkEntry(1).Enabled = True
'        Me.ChkEntry(5).Enabled = True
'    Case 2  '编辑者
'        For j = 1 To 5
'            Me.ChkEntry(j).Enabled = True
'        Next j
'    Case 3  '作者
'        Me.ChkEntry(0).Enabled = True
'        Me.ChkEntry(1).Enabled = True
'        Me.ChkEntry(2).Enabled = True
'        Me.ChkEntry(3).Enabled = True
'        Me.ChkEntry(5).Enabled = True
'        Me.ChkEntry(7).Enabled = True
'    Case 4  '读者
'        Me.ChkEntry(2).Enabled = True
'        Me.ChkEntry(3).Enabled = True
'        Me.ChkEntry(5).Enabled = True
'        Me.ChkEntry(7).Enabled = True
'    Case 5, 6    '存放者、不能读取者
'        Me.ChkEntry(6).Enabled = True
'        Me.ChkEntry(7).Enabled = True
'    Case Else
'    End Select
'    On Error Resume Next
'    mCurrentAcl.RemoveACLEntry "Temp"
End Sub

Private Sub AclChange()
    '
End Sub

Private Sub SaveACL()
'    On Error Resume Next
'    SaveEntry Me.LstAclList.ListIndex
'    Dim clsACL As NotesACL
'    For Each clsACL In mDBAcls
'        clsACL.Save
'    Next clsACL
'ErrHandler:
End Sub

Private Sub AddRoles(Role As String)
    Dim i As Long
    For i = 0 To Me.LstRole.ListCount - 1
        If Me.LstRole.List(i) = Role Then Exit Sub
    Next i
    Me.LstRole.AddItem Role
End Sub

Private Sub SaveEntry(ByVal Entry As Long)
'    If Not mNotIsFirst Then
'        mNotIsFirst = True
'        Exit Sub
'    End If
'    Dim i As Long, strAcl As String, clsEntry As NotesACLEntry
'    strAcl = Me.LstAclList.List(Entry)
'    Set clsEntry = mCurrentAcl.GetEntry(strAcl)
'    clsEntry.UserType = Me.CmbUserType.ListIndex
'    Dim level As Long
'    level = Me.CmbOptLevel.ListIndex
'    If level = -1 Then level = 6
'    clsEntry.level = 6 - level
'    clsEntry.CanCreateDocuments = (Me.ChkEntry(0) = 1)
'    clsEntry.CanDeleteDocuments = (Me.ChkEntry(1) = 1)
'    clsEntry.CanCreatePersonalAgent = (Me.ChkEntry(2).value = 1)
'    clsEntry.CanCreatePersonalFolder = (Me.ChkEntry(3).value = 1)
'    clsEntry.CanCreateSharedFolder = (Me.ChkEntry(4).value = 1)
'    clsEntry.CanCreateLSOrJavaAgent = (Me.ChkEntry(5).value = 1)
'    clsEntry.IsPublicReader = (Me.ChkEntry(6).value = 1)
'    clsEntry.IsPublicWriter = (Me.ChkEntry(7).value = 1)
'    On Error Resume Next
'    For i = 0 To Me.LstRole.ListCount - 1
'        If Me.LstRole.Selected(i) Then
'            clsEntry.EnableRole Me.LstRole.List(i)
'        Else
'            clsEntry.DisableRole Me.LstRole.List(i)
'        End If
'    Next i
End Sub
'
''06-04-24Private Property Get mCurrentAclEntry() As NotesACLEntry
'    Dim i As Long, j As Long
'    Dim clsEntry As NotesACLEntry
'    Dim strAcl As String
'    i = Me.LstAclList.ListIndex
'    If i = -1 Then i = 0
'    strAcl = Me.LstAclList.List(i)
'    Set clsEntry = mCurrentAcl.GetEntry(strAcl)
'    If clsEntry Is Nothing Then
'        Set clsEntry = mCurrentAcl.CreateACLEntry(strAcl, 6)
'    End If
'    Set mCurrentAclEntry = clsEntry 'mCurrentAcl.GetEntry(strAcl)
'End Property

Private Sub LstAclList_Click()
    Dim i As Long
    i = Me.LstAclList.ListIndex
    If i <> LastEntry Then
        SaveEntry LastEntry
    End If
    LastEntry = i
    AclEntryChange
    LevelChange
End Sub

Private Sub AddSelect(AName As String)
    Dim i As Integer
    For i = 0 To Me.LstAclList.ListCount - 1
        If AName = Me.LstAclList.List(i) Then
            MsgBox AName & "已经存在！"
            Exit Sub
        End If
    Next i
    Me.LstAclList.AddItem AName
End Sub