frmallset.frm

来自「OA编程 源代码」· FRM 代码 · 共 1,598 行 · 第 1/4 页

End Sub

Private Sub Form_Unload(Cancel As Integer)
If PubAllSetConn.State = 1 Then
   PubAllSetConn.Close
End If
If PubAllSetRst.State = 1 Then
    PubAllSetRst.Close
End If
If Rsttemp.State = 1 Then
   Rsttemp.Close
End If
Set PubAllSetRst = Nothing
Set PubAllSetConn = Nothing
Set Rsttemp = Nothing

End Sub

'setlimit函数实现对用户或用户组权限的设置usertype 1为用户，0为用户组;usergroupname->用户或用户组名称,limit->权限字符串,lanmu->跟栏目名称
Private Function SetLimit(UserType As Integer, UserGroupName As String, LanMuName As String) As Boolean
Dim i, w As Integer
Dim TreeNo As String
Dim mystring As String
Dim GroupUserCount As Integer
Dim GroupPerSon(100) As String
Dim CurrentLimit As String
GroupUserCount = 0
SetLimit = False
'mystring = "select treebase.treename from treelimit,treebase where treelimit.treeno=treebase.treeno where treebase.treename='" & Limit & "'"
'获得栏目编号
'mystring = "select treebase.treeno from treelimit,treebase where treelimit.treeno=treebase.treeno and treebase.treename='" & LanMuName & "'"
'Set RstTemp = PubAllSetConn.Execute(mystring)
'TreeNo = RstTemp(0)
'RstTemp.Close
If Len(Trim(LanMuName)) = 1 Then
   TreeNo = "0" & LanMuName
Else
    TreeNo = LanMuName
End If



'mystring = "select treeno,username,limit from treelimit"
'Set RstTemp = PubAllSetConn.Execute(mystring)
'Do While Not RstTemp.EOF
'    If Left(RstTemp(0), 2) = TreeNo Then
'        mystring = "delete from treelimit where treeno='" & RstTemp(0) & "' and username='" & UserGroupName & "'"
'        PubAllSetConn.Execute mystring, 64
'    End If
'    RstTemp.MoveNext
'Loop
'RstTemp.Close
If UserType = 1 Then
    mystring = "select treeno,linkstate from treebase order by treeno"
    Set Rsttemp = PubAllSetConn.Execute(mystring)
    Do While Not Rsttemp.EOF
        If Left(Rsttemp(0), 2) = TreeNo Then
            mystring = "delete from treelimit where username='" & UserGroupName & "' and treeno='" & Rsttemp(0) & "'"
            PubAllSetConn.Execute mystring, 64
            CurrentLimit = GetLimit(Rsttemp(0))
            If CurrentLimit <> "0000000000" Then
                mystring = "insert into treelimit values('" & Rsttemp(0) & "','','" & UserGroupName & "','" & CurrentLimit & "')"
                PubAllSetConn.Execute mystring, 64
            End If
        End If
        Rsttemp.MoveNext
    Loop
Else
    mystring = "select username from groupuser where groupname='" & UserGroupName & "'"
    Set Rsttemp = PubAllSetConn.Execute(mystring)
    Do While Not Rsttemp.EOF
        GroupPerSon(GroupUserCount) = Rsttemp(0)
        GroupUserCount = GroupUserCount + 1
        Rsttemp.MoveNext
    Loop
    Rsttemp.Close
    mystring = "select treeno,linkstate from treebase order by treeno"
    Set Rsttemp = PubAllSetConn.Execute(mystring)
    Do While Not Rsttemp.EOF
        If Left(Rsttemp(0), 2) = TreeNo Then
            For i = 0 To GroupUserCount - 1
                mystring = "delete from treelimit where Groupname='" & UserGroupName & "' and username='" & GroupPerSon(i) & "' and treeno='" & Rsttemp(0) & "'"
                PubAllSetConn.Execute mystring, 64
                CurrentLimit = GetLimit(Rsttemp(0))
                If CurrentLimit <> "0000000000" Then
                    mystring = "insert into treelimit values('" & Rsttemp(0) & "','" & UserGroupName & "','" & GroupPerSon(i) & "','" & CurrentLimit & "')"
                    PubAllSetConn.Execute mystring, 64
                End If
            Next i
        End If
        Rsttemp.MoveNext
    Loop
            
        
        
End If
Rsttemp.Close
SetLimit = True
End Function

Private Function GetLimit(TreeNo As String) As String
Dim a1, a2, a3, a4, a5 As Integer
Dim mystring As String
Dim FrstTemp As New ADODB.Recordset
mystring = "select linkstate from treebase where treeno='" & TreeNo & "' order by treeno"
Set FrstTemp = PubAllSetConn.Execute(mystring)
If FrstTemp.EOF Then
   MsgBox "数据错误！", 64, "提示"
   Exit Function
End If
Select Case FrstTemp(0)
        
            
        Case 3
            If CkDispLab.Value Then
                a1 = 1
            Else
                a1 = 0
            End If
            If CkInfoRead.Value Then
                a2 = 1
            Else
                a2 = 0
            End If
            If CkInfoWrite.Value Then
                a3 = 1
            Else
                a3 = 0
            End If
            If CkInfoDel.Value Then
                a4 = 1
            Else
                a4 = 0
            End If
            If CkInfoBkup.Value Then
                a5 = 1
            Else
                a5 = 0
            End If
            GetLimit = a1 & CStr(a2) & CStr(a3) & CStr(a4) & CStr(a5) & "00000"
        Case Else
            If CkDispLab.Value Then
                a1 = 1
            Else
                a1 = 0
            End If
            If CkInfoRead.Value Then
                a2 = 1
            Else
                a2 = 0
            End If
            GetLimit = CStr(a1) & CStr(a2) & "00000000"
End Select


End Function

Private Sub LstSour_DblClick()
If LstSour.SelCount <> 0 Then
            For i = 0 To LstSour.ListCount - 1
                If LstSour.Selected(i) Then
                   LstTar.AddItem LstSour.list(i)
                   LstTar.ItemData(LstTar.ListCount - 1) = LstSour.ItemData(i)
                End If
            Next i
            For i = 1 To LstSour.SelCount
                For c = 0 To LstSour.ListCount - 1
                    If LstSour.Selected(c) Then
                       LstSour.RemoveItem c
                       Exit For
                    End If
                Next c
            Next i
           
           
End If
End Sub

Private Sub LstTar_DblClick()
If LstTar.SelCount <> 0 Then
            For i = 0 To LstTar.ListCount - 1
                If LstTar.Selected(i) Then
                   LstSour.AddItem LstTar.list(i)
                   LstSour.ItemData(LstSour.ListCount - 1) = LstTar.ItemData(i)
                End If
            Next i
            For i = 1 To LstTar.SelCount
                For c = 0 To LstTar.ListCount - 1
                    If LstTar.Selected(c) Then
                       LstTar.RemoveItem c
                       Exit For
                    End If
                Next c
            Next i
           
           
        End If
End Sub

Private Sub LstViewCurUser_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Integer
LabUser.Caption = Item.Text
For i = 0 To ChkQxList.Count - 1
    ChkQxList(i).Value = 0
    LabInformation(i).ForeColor = InitFontColor
Next i

If Mid(Item.Key, 3, 1) <> "." Then
        '获得用户类型,0为用户组，1为用户,
        CurrentUserOrGroup = Right(Item.Key, Len(Item.Key) - 4)
        Sqlstring = "select limit from treelimit where groupname='" & CurrentUserOrGroup & "' and treeno='" & CurrentLanMu & "'"
        Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
        If Not PubAllSetRst.EOF Then
            For i = 0 To 4
                If Mid(PubAllSetRst(0), i + 1, 1) = 1 Then
                   ChkQxList(i).Value = 1
                   LabInformation(i).ForeColor = SelectColor
                End If
            Next i
        End If
        PubAllSetRst.Close
           
Else
        CurrentUserOrGroup = Right(Item.Key, Len(Item.Key) - 3)
        Sqlstring = "select limit from treelimit where username='" & CurrentUserOrGroup & "' and treeno='" & CurrentLanMu & "'"
        Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
        If Not PubAllSetRst.EOF Then
            For i = 0 To 4
                If Mid(PubAllSetRst(0), i + 1, 1) = 1 Then
                   ChkQxList(i).Value = 1
                   LabInformation(i).ForeColor = SelectColor
                End If
            Next i
        End If
        PubAllSetRst.Close
        
End If

        
        
End Sub

Private Sub LstViewSour_DblClick()
Dim i As Integer
For i = 1 To LstViewSour.ListItems.Count
            If LstViewSour.ListItems(i).Selected Then
                w = w + 1
                OldKey = LstViewSour.ListItems(i).Key
                OldIco = LstViewSour.ListItems(i).Icon
                OldText = LstViewSour.ListItems(i).Text
                Set TempItem = LstViewTar.ListItems.Add(, OldKey, OldText, OldIco)
            End If
        Next i
        If w = 0 Then
           Exit Sub
        End If
        For i = 1 To w
            For c = 1 To LstViewSour.ListItems.Count
                If LstViewSour.ListItems(c).Selected Then
                    LstViewSour.ListItems.Remove c
                    Exit For
                End If
            Next c
        Next i
        
End Sub

Private Sub LstViewTar_DblClick()
For i = 1 To LstViewTar.ListItems.Count
          If LstViewTar.ListItems(i).Selected Then
              w = w + 1
              OldKey = LstViewTar.ListItems(i).Key
              OldIco = LstViewTar.ListItems(i).Icon
              OldText = LstViewTar.ListItems(i).Text
              Set TempItem = LstViewSour.ListItems.Add(, OldKey, OldText, OldIco)
          End If
      Next i
      If w = 0 Then
         Exit Sub
      End If
      For i = 1 To w
          For c = 1 To LstViewTar.ListItems.Count
              If LstViewTar.ListItems(c).Selected Then
                  LstViewTar.ListItems.Remove c
                  Exit For
              End If
          Next c
Next i
End Sub

Private Sub StabMenu_Click(PreviousTab As Integer)
If PreviousTab = 1 Then
 '  STabMenu.TabPicture(0) = LoadPicture(App.Path & "\image\label16.gif")
  ' STabMenu.TabPicture(1) = LoadPicture()
   
Else
   If BTreeViewExpand = False Then
      BTreeViewExpand = True
      '填充TREEVIEW
      Call FillTreeView
   End If
      
   'STabMenu.TabPicture(1) = LoadPicture(App.Path & "\image\label16.gif")
   'STabMenu.TabPicture(0) = LoadPicture()
End If
End Sub

Private Sub Timer1_Timer()
If Jishu = 0 Then
    Label8.Visible = True
    Image3.Visible = True
    
ElseIf Jishu = 1 Then
    Label8.Visible = False
    Image3.Visible = False
ElseIf Jishu = 2 Then
   Label8.Visible = True
   Image3.Visible = True
ElseIf Jishu = 3 Then
   Label8.Visible = False
   Image3.Visible = False
   Timer1.Enabled = False
   Jishu = 0
   Exit Sub
End If

Jishu = Jishu + 1


End Sub

Private Sub FillTreeView()
Dim mystring As String
Dim Mykey As String
Dim nodX As MSComctlLib.Node
Dim CurrentKey As String
Dim LastKey As String
Dim Sqlstring As String
Sqlstring = "select treeno,treename from treebase where treeno like '__' "
Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
Do While Not PubAllSetRst.EOF
    Mykey = "栏" & Trim(PubAllSetRst(0))
    Sqlstring = Trim(PubAllSetRst(1))
    Set nodX = TViewLanMu.Nodes.Add(, 0, Mykey, Sqlstring)
    PubAllSetRst.MoveNext
Loop
CurrentKey = 4
Sqlstring = "select treeno,treename from treebase order by treeno"
Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
Do While Not CurrentKey > 10
    Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
    Do While Not PubAllSetRst.EOF
    If Len(Trim(PubAllSetRst(0))) = CurrentKey Then
        Mykey = "栏" & Trim(PubAllSetRst(0))
        Mylastkey = Left(Mykey, CurrentKey - 1)
        mystring = Trim(PubAllSetRst(1))
        Set nodX = TViewLanMu.Nodes.Add(Mylastkey, 4, Mykey, mystring)
        
    End If
    PubAllSetRst.MoveNext
    Loop
    CurrentKey = CurrentKey + 2
    
Loop

Set nodX = Nothing



End Sub

Private Sub TViewLanMu_NodeClick(ByVal Node As MSComctlLib.Node)
Dim Sqlstring As String
Dim i As Integer
CurrentLanMu = Mid(Node.Key, 2, Len(Node.Key) - 1)
LabLanMu.Caption = Node.Text
Sqlstring = "select distinct Groupname from treelimit where treeno='" & CurrentLanMu & "' and groupname<>''"
Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
LstViewCurUser.ListItems.Clear
Do While Not PubAllSetRst.EOF
    Set TempItem = LstViewCurUser.ListItems.Add(, "用户组." & PubAllSetRst(0), PubAllSetRst(0), 2)
    PubAllSetRst.MoveNext
Loop
PubAllSetRst.Close
Sqlstring = "select distinct groupuser.username_c,groupuser.username from treelimit,groupuser where treelimit.groupname='' and treelimit.treeno='" & CurrentLanMu & "' and groupuser.username=treelimit.username"
Set PubAllSetRst = PubAllSetConn.Execute(Sqlstring)
Do While Not PubAllSetRst.EOF
    Set TempItem = LstViewCurUser.ListItems.Add(, "用户." & PubAllSetRst(1), PubAllSetRst(0), 1)
    
    PubAllSetRst.MoveNext
Loop
For i = 0 To ChkQxList.Count - 1
    ChkQxList(i).Value = 0
    LabInformation(i).ForeColor = InitFontColor
Next i

End Sub