limit.frm

OA编程 源代码

                                    Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                                    HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                                Else
                                    HFlLimit.TextMatrix(i, j + 1) = ""
                                End If
                            Next j
                        Else
                            HFlLimit.TextMatrix(i, 7) = "0000000000"
                            For j = 2 To 6
                                HFlLimit.TextMatrix(i, j) = ""
                            Next j
                        End If
                        
                        'Rst.Close
                    End If
                    RSTGroupUser.MoveNext
                Loop
            End If
            
            RSTGroupUser.Close
            
            '----------Set User
            
            sql = "SELECT DISTINCT username,username_c FROM groupuser "
            sql = sql & "ORDER BY username"
            Set RSTGroupUser = gclsDatabase.RDOSelect(sql)
                        
            If RSTGroupUser.RowCount > 0 Then
                Do While Not RSTGroupUser.EOF
                    If Len(Trim(RSTGroupUser!Username)) <> 0 Then
                        i = HFlLimit.Rows
                        If i = 2 Then
                            If TwoFlag = False Then
                                i = 1
                                TwoFlag = True
                            End If
                        End If
                        HFlLimit.Rows = i + 1
                        HFlLimit.TextMatrix(i, 0) = ""
                        HFlLimit.Row = i
                        HFlLimit.Col = 1
                        If Len(Trim(RSTGroupUser!Username_c)) = 0 Then
                            HFlLimit.Text = Trim(RSTGroupUser!Username)
                        Else
                            HFlLimit.Text = Trim(RSTGroupUser!Username_c) & "(" & Trim(RSTGroupUser!Username) & ")"
                        End If
                        'HFlLimit.CellAlignment = flexAlignCenterCenter
                    
                        sql = "SELECT limit FROM treelimit WHERE "
                        sql = sql & "treeno='" & strNodeKey & "' AND "
                        sql = sql & "groupname='' AND "
                        sql = sql & "username='" & RSTGroupUser!Username & "'"
                        Set rst = gclsDatabase.RDOSelect(sql)
                    
                        If rst.RowCount > 0 Then
                            HFlLimit.TextMatrix(i, 7) = Trim(rst!limit)
                            For j = 1 To 5
                                If Mid(Trim(rst!limit), j, 1) = "1" Then
                                    HFlLimit.Row = i
                                    HFlLimit.Col = j + 1
                                    Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                                    HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                                Else
                                    HFlLimit.TextMatrix(i, j + 1) = ""
                                End If
                            Next j
                        Else
                            HFlLimit.TextMatrix(i, 7) = "0000000000"
                            For j = 2 To 6
                                HFlLimit.TextMatrix(i, j) = ""
                            Next j
                        End If
                        
                        'Rst.Close
                    End If
                    RSTGroupUser.MoveNext
                Loop
            End If
            
            RSTGroupUser.Close
            
            HFlLimit.Redraw = True
    End Select
    
    Me.MousePointer = 0
    
    Exit Sub
DatabaseError:
    Me.MousePointer = 0

    Call ManageQuit
End Sub

Private Sub HFlLimitInit()
    Dim i As Integer
    Dim strTitle(7) As String
    
    strTitle(0) = "用户组名"
    strTitle(1) = "用户名"
    strTitle(2) = "显示标题"
    strTitle(3) = "读文件"
    strTitle(4) = "写文件"
    strTitle(5) = "删除文件"
    strTitle(6) = "归档"
    strTitle(7) = "实际权限"
    
    HFlLimit.Redraw = False
    HFlLimit.Clear

    HFlLimit.Cols = 8
    HFlLimit.Rows = 2

    HFlLimit.RowHeight(0) = 450
    HFlLimit.ColWidth(0) = 1430
    HFlLimit.ColWidth(1) = 1430
    HFlLimit.ColWidth(2) = 1100
    HFlLimit.ColWidth(3) = 1100
    HFlLimit.ColWidth(4) = 1100
    HFlLimit.ColWidth(5) = 1100
    HFlLimit.ColWidth(6) = 1100
    HFlLimit.ColWidth(7) = 0

    For i = 0 To 7
        HFlLimit.Row = 0
        HFlLimit.Col = i

        HFlLimit.Text = strTitle(i)
        HFlLimit.FontFixed = "system"
        HFlLimit.FontWidthFixed = 8
        HFlLimit.CellBackColor = Val("&H8000000F&")
        HFlLimit.CellForeColor = Val("&H00FF0000&")
        HFlLimit.CellAlignment = flexAlignCenterCenter
    Next i

    For i = 0 To 7
        HFlLimit.Row = 1
        HFlLimit.Col = i

        HFlLimit.Text = ""
    Next i
    
    HFlLimit.Redraw = True
    TwoFlag = False
End Sub

Private Sub SaveLimit()
    Dim i As Integer
    Dim cc As String

    If SaveFlag Then
    
        Return_Var = MsgBox("是否保存已作的权限修改？", vbDefaultButton1 + vbYesNo + vbQuestion, "提示")
    
        If Return_Var = vbYes Then
    
            On Error GoTo DatabaseError
            
            sql = "DELETE FROM treelimit WHERE "
            sql = sql & "treeno like'" & Trim(strNodeKey) & "%'"
            Return_Var = gclsDatabase.RDODelete(sql)
           
            For i = 1 To HFlLimit.Rows - 1
                
                If Len(Trim(HFlLimit.TextMatrix(i, 0))) <> 0 Then
                    If Val(Trim(HFlLimit.TextMatrix(i, 7))) <> 0 Then
                        sql = "SELECT username FROM groupuser WHERE "
                        sql = sql & "groupname='" & Trim(HFlLimit.TextMatrix(i, 0)) & "'"
                        Set rst = gclsDatabase.RDOSelect(sql)
                        
                        If rst.RowCount > 0 Then
                            Do While Not rst.EOF
                                sql = "INSERT INTO treelimit VALUES("
                                sql = sql & "'" & Trim(strNodeKey) & "',"
                                sql = sql & "'" & Trim(HFlLimit.TextMatrix(i, 0)) & "',"
                                sql = sql & "'" & Trim(rst!Username) & "',"
                                sql = sql & "'" & Trim(HFlLimit.TextMatrix(i, 7)) & "')"
                                Return_Var = gclsDatabase.RDOInsert(sql)
                                If Return_Var = 0 Then GoTo DatabaseError
                                rst.MoveNext
                            Loop
                        Else
                            sql = "INSERT INTO treelimit VALUES("
                            sql = sql & "'" & Trim(strNodeKey) & "',"
                            sql = sql & "'" & Trim(HFlLimit.TextMatrix(i, 0)) & "',"
                            sql = sql & "'','" & Trim(HFlLimit.TextMatrix(i, 7)) & "')"
                            Return_Var = gclsDatabase.RDOInsert(sql)
                            If Return_Var = 0 Then GoTo DatabaseError
                        End If
                        
                        rst.Close
                    End If
                End If
                
                If Len(Trim(HFlLimit.TextMatrix(i, 1))) <> 0 Then
                    If Val(Trim(HFlLimit.TextMatrix(i, 7))) <> 0 Then
                        cc = Trim(HFlLimit.TextMatrix(i, 1))
                        Return_Var = InStr(cc, "(")
                        If Return_Var > 0 Then
                            cc = Mid(cc, Return_Var + 1, Len(cc) - Return_Var - 1)
                        End If
                        ltrLen = Len(strNodeKey)
                        ltrNodeKey = strNodeKey
                        Do While ltrLen > 2
                            ltrNodeKey = Mid(ltrNodeKey, 1, ltrLen - 2)
                            sql = "select treeno from treelimit"
                            sql = sql & " where treeno='" & ltrNodeKey & "'"
                            sql = sql & " and username='" & Trim(cc) & "'"
                            Set rst = gclsDatabase.RDOSelect(sql)
                            If rst.RowCount > 0 Then Exit Do
                            
                            sql = "INSERT INTO treelimit VALUES("
                            sql = sql & "'" & Trim(ltrNodeKey) & "',"
                            sql = sql & "'','" & Trim(cc) & "',"
                            sql = sql & "'" & Trim(HFlLimit.TextMatrix(i, 7)) & "')"
                            
                            Return_Var = gclsDatabase.RDOInsert(sql)
                            If Return_Var = 0 Then GoTo DatabaseError
                            ltrLen = Len(ltrNodeKey)
                        Loop
                        sql = "INSERT INTO treelimit VALUES("
                        sql = sql & "'" & Trim(strNodeKey) & "',"
                        sql = sql & "'','" & Trim(cc) & "',"
                        sql = sql & "'" & Trim(HFlLimit.TextMatrix(i, 7)) & "')"
                        
                        Return_Var = gclsDatabase.RDOInsert(sql)
                        If Return_Var = 0 Then GoTo DatabaseError
                    End If
                End If
            Next i
        End If
    End If

    Exit Sub
DatabaseError:
    Call ManageQuit
End Sub

Private Sub Form_Load()
    On Error GoTo DatabaseError

    FrmLimit.ScaleHeight = FrmLimit.Height
    FrmLimit.ScaleWidth = FrmLimit.Width
    FrmLimit.Top = (Screen.Height - FrmLimit.Height - TitleHeight) / 2
    FrmLimit.Left = (Screen.Width - FrmLimit.Width) / 2
    
    
    Call ManageLimit
    
    sql = "SELECT treeno,treename FROM treebase ORDER BY treeno"
    Set rst = gclsDatabase.RDOSelect(sql)
    
    If rst.RowCount > 0 Then
        Do While Not rst.EOF
            If Len(Trim(rst!TreeNo)) = 2 Then
                Set nodX = TreTree.Nodes.Add(, , _
                    TreeViewChar & Trim(rst!TreeNo), _
                    Trim(rst!treename))
            Else
                Set nodX = TreTree.Nodes.Add( _
                    TreeViewChar & Trim(Mid(Trim(rst!TreeNo), 1, _
                    Len(Trim(rst!TreeNo)) - 2)), _
                    tvwChild, TreeViewChar & Trim(rst!TreeNo), _
                    Trim(rst!treename))
            End If
            rst.MoveNext
        Loop
        
        rst.MoveFirst
        
        strNodeKey = Trim(rst!TreeNo)
        
        Call DispLimit
    Else
        MsgBox "栏目不存在，请先进行栏目设置！", vbExclamation, "系统信息"
        Unload Me
    End If
    
    rst.Close

    SaveFlag = False
        '换皮肤
    Call LoadSkin(Me)
    Exit Sub
DatabaseError:
    Call ManageQuit