frm用户.frm

这是一个用来管理一个运行系统权限的程序

End
Attribute VB_Name = "Frm用户"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Qx_Temp As Integer
Dim Ur_Qx As Boolean '记录有无用户管理权限
Dim Qx_Menu() As String '记录仅限菜单
Private Sub Command10_Click()
  Command8.Visible = False
  Frame2.Visible = False
End Sub
Private Sub Command2_Click() '删除
  Dim Kk As String
  Me.MSHFlexGrid1.Col = Me.MSHFlexGrid1.FixedCols + 2
  Kk = Trim(Me.MSHFlexGrid1.Text)
  Dim Ii As Integer
  If Kk = "超级用户" Then
     Call MsgBox("超级用户不能删除!", 48, "系统提示")
     Exit Sub
  End If
  Ii = MsgBox("删除【" & Kk & "】这个用户?", vbYesNo, "系统提示")
  If Ii = 6 Then
     Dim CN As New ADODB.Connection
     CN.ConnectionString = Adodc1.ConnectionString
     CN.Open
     If TabStrip1.Tabs(1).Selected = True Then '操作用户
        CN.Execute "delete from ur where 用户='" & Kk & "'"
     Else
        CN.Execute "delete from Sur where 姓名='" & Kk & "'"
     End If
     CN.Close
  End If
  Adodc1.Refresh
  MSHFlexGrid1.Refresh
End Sub
Private Sub Command3_Click()
  Unload Me
End Sub
Private Sub Command4_Click() '增加
  Command2.Enabled = False
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
  Command6.Visible = True
  Frame1.Visible = True
  TabStrip1.Enabled = False
  If TabStrip1.Tabs(1).Selected = True Then '操作用户
     text1(0) = Adodc1.Recordset.RecordCount + 1
     text1(3).Visible = True
     Label1(3).Visible = True
     Shape1(3).Visible = True
     text1(4).Visible = True
     Label1(4).Visible = True
     Shape1(4).Visible = True
     Command7.Visible = True
     
     text1(0).Enabled = True
     text1(1).Enabled = True
     text1(2).Enabled = True
     text1(4).Enabled = True
     Command7.Enabled = True
     XpBut确定.Caption = "增加"
     text1(1) = ""
     text1(2) = ""
     text1(3) = ""
     text1(4) = 0
  Else '审核员
     text1(0) = Adodc1.Recordset.RecordCount + 1
     text1(1) = ""
     text1(2) = ""
     text1(3).Visible = False
     Label1(3).Visible = False
     Shape1(3).Visible = False
     text1(4).Visible = False
     Label1(4).Visible = False
     Shape1(4).Visible = False
     Command7.Visible = False
     XpBut确定.Caption = "增加"
  End If
End Sub
Private Sub Command5_Click() '修改
  Dim Ii As Integer
  Command2.Enabled = False
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
  Command6.Visible = True
  Frame1.Visible = True
  TabStrip1.Enabled = False
  If TabStrip1.Tabs(1).Selected = True Then
     text1(3).Visible = True
     Label1(3).Visible = True
     Shape1(3).Visible = True
     text1(4).Visible = True
     Label1(4).Visible = True
     Shape1(4).Visible = True
     Command7.Visible = True
     XpBut确定.Caption = "修改"
     For Ii = 0 To 4
         MSHFlexGrid1.Col = Ii + 1
         text1(Ii) = Trim(MSHFlexGrid1.Text)
     Next Ii
     MSHFlexGrid1.Col = 3
     If Trim(MSHFlexGrid1.Text) = "超级用户" Then
        text1(0).Enabled = False
        text1(1).Enabled = False
        text1(2).Enabled = False
        Command7.Enabled = False
     Else
        text1(0).Enabled = True
        text1(1).Enabled = True
        text1(2).Enabled = True
        Command7.Enabled = True
     End If
  Else
     text1(3).Visible = False
     Label1(3).Visible = False
     Shape1(3).Visible = False
     text1(4).Visible = False
     Label1(4).Visible = False
     Shape1(4).Visible = False
     Command7.Visible = False
     XpBut确定.Caption = "修改"
     For Ii = 0 To 2
         MSHFlexGrid1.Col = Ii + 1
         text1(Ii) = Trim(MSHFlexGrid1.Text)
     Next Ii
  End If
  If Ur_Qx = False Then 'No用户管理权限
     text1(0).Enabled = False
     text1(1).Enabled = False
     text1(2).Enabled = False
     text1(4).Enabled = False
     Command7.Enabled = False
  End If
End Sub
Private Sub Command7_Click()
  Dim Ii As Integer
  For Ii = 0 To UBound(Qx_Menu)
      Check1(Ii).Value = (CInt(text1(4)) And 2 ^ Ii) / (2 ^ Ii)
  Next Ii
  Command8.Visible = True
  Frame2.Visible = True
End Sub
Private Sub Command9_Click()
  Dim Ii As Integer
  Qx_Temp = 0
  For Ii = 0 To UBound(Qx_Menu)
      Qx_Temp = Qx_Temp + Check1(Ii).Value * 2 ^ Ii
  Next Ii
  text1(4) = Qx_Temp
  Command8.Visible = False
  Frame2.Visible = False
End Sub
Private Sub Form_Load()
  Dim Aa As String, Ii As Integer
  Me.Caption = "用户管理"
  Ur_Qx = (UrLimit And 2 ^ 0) / (2 ^ 0)
  '取权限菜单
  Aa = Space$(255)
  Ii = GetPrivateProfileString("权限菜单", "Menu", "0", Aa, Len(Aa), UrConfig)
   '清除每行字符串的最后一个特殊字符(当返回值中存在汉字时，最后会返回一个ASC()=0的特殊字符)
  If Asc(Right(Aa, 1)) = 0 Then
     Aa = Left(Aa, Len(Aa) - 1)
  End If
  Aa = Trim(Left(Aa, Ii))
  Qx_Menu = Split(Aa, ",")
  For Ii = 0 To UBound(Qx_Menu) '装载权限菜单
      Check1(Ii).Caption = Qx_Menu(Ii)
      If UBound(Qx_Menu) < 10 Then
         If Ii < 5 Then
            Check1(Ii).Top = 550 + Ii * 600
            Check1(Ii).Left = 1000
         Else
            Check1(Ii).Top = 550 + (Ii - 5) * 600
            Check1(Ii).Left = 3900
         End If
      Else
         If Ii < 5 Then
            Check1(Ii).Top = 550 + Ii * 600
            Check1(Ii).Left = 700
         ElseIf Ii < 10 Then
            Check1(Ii).Top = 550 + (Ii - 5) * 600
            Check1(Ii).Left = 2600
         Else
            Check1(Ii).Top = 550 + (Ii - 10) * 600
            Check1(Ii).Left = 4500
         End If
      End If
      Check1(Ii).Visible = True
  Next Ii
  
  Adodc1.ConnectionString = UrMdbConStr
  Adodc1.CommandType = adCmdText
  If Ur_Qx = True Then '有用户管理权限
     Adodc1.RecordSource = "select * from ur"
  Else
     Adodc1.RecordSource = "select * from ur where 用户='" & UrName & "'"
     Command2.Enabled = False
     Command4.Enabled = False
     Command7.Enabled = False
  End If
  Adodc1.Refresh
  MSHFlexGrid1.Refresh
  MSHFlexGrid1.ColAlignmentFixed = 4
  MSHFlexGrid1.ColAlignment(1) = 4
  MSHFlexGrid1.ColWidth(0, 0) = 500
  MSHFlexGrid1.ColWidth(1) = 1000
  MSHFlexGrid1.ColWidth(2) = 1000
  MSHFlexGrid1.ColWidth(3) = 1000
  MSHFlexGrid1.ColWidth(4) = 1000
  MSHFlexGrid1.ColWidth(5) = 0
  Command8.Visible = False
  Frame2.Visible = False
End Sub

Private Sub TabStrip1_Click()
  If TabStrip1.Tabs(1).Selected = True Then
     If Ur_Qx = True Then '有用户管理权限
        Adodc1.RecordSource = "select * from ur"
        Command2.Enabled = True
        Command4.Enabled = True
        Command7.Enabled = True
     Else
        Adodc1.RecordSource = "select * from ur where 用户='" & UrName & "'"
        Command2.Enabled = False
        Command4.Enabled = False
        Command7.Enabled = False
     End If
     Adodc1.Refresh
     MSHFlexGrid1.Refresh
     MSHFlexGrid1.ColAlignmentFixed = 4
     MSHFlexGrid1.ColAlignment(1) = 4
     MSHFlexGrid1.ColWidth(0, 0) = 500
     MSHFlexGrid1.ColWidth(1) = 1000
     MSHFlexGrid1.ColWidth(2) = 1000
     MSHFlexGrid1.ColWidth(3) = 1000
     MSHFlexGrid1.ColWidth(4) = 1000
     MSHFlexGrid1.ColWidth(5) = 0
  ElseIf TabStrip1.Tabs(2).Selected = True Then
     Adodc1.RecordSource = "select * from Sur"
     If Ur_Qx = True Then '有用户管理权限
        Command2.Enabled = True
        Command4.Enabled = True
        Command7.Enabled = True
     Else
        Command2.Enabled = False
        Command4.Enabled = False
        Command7.Enabled = False
     End If
     Adodc1.Refresh
     MSHFlexGrid1.Refresh
     MSHFlexGrid1.ColAlignmentFixed = 4
     MSHFlexGrid1.ColAlignment(1) = 4
     MSHFlexGrid1.ColWidth(0, 0) = 500
     MSHFlexGrid1.ColWidth(1) = 1000
     MSHFlexGrid1.ColWidth(2) = 1500
     MSHFlexGrid1.ColWidth(3) = 1500
  End If
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
  If Index = 0 Then
     '只接受数字0-9、回车及删除键及特殊键及小数点。
     If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 13 Or KeyAscii = 8 Or KeyAscii = 46 Then
        If KeyAscii = 13 Then
           text1(1).SetFocus
        End If
     Else
        KeyAscii = 0
        Beep
        Exit Sub
     End If
  End If
End Sub
Private Sub XpBut确定_Click()
  Dim Ii As Integer
  If TabStrip1.Tabs(1).Selected = True Then '操作用户
     For Ii = 0 To 4
         If Trim(text1(Ii)) = "" And Ii <> 3 Then '<>3允许密码为空
            Call MsgBox("数据输入错误!", 48, "系统提示")
            Exit Sub
         End If
     Next Ii
  Else
     For Ii = 0 To 2
         If Trim(text1(Ii)) = "" Then
            Call MsgBox("数据输入错误!", 48, "系统提示")
            Exit Sub
         End If
     Next Ii
  End If
  Adodc2.ConnectionString = Adodc1.ConnectionString
  If XpBut确定.Caption = "增加" Then
     If TabStrip1.Tabs(1).Selected = True Then '操作用户
        Adodc2.RecordSource = "select * from ur"
     Else
        Adodc2.RecordSource = "select * from Sur"
     End If
     Adodc2.Refresh
     Adodc2.Recordset.AddNew
  ElseIf XpBut确定.Caption = "修改" Then
     MSHFlexGrid1.Col = MSHFlexGrid1.FixedCols
     If TabStrip1.Tabs(1).Selected = True Then '操作用户
        Adodc2.RecordSource = "select * from ur where 序号=" & CInt(MSHFlexGrid1.Text)
     Else
        Adodc2.RecordSource = "select * from Sur where 序号=" & CInt(MSHFlexGrid1.Text)
     End If
     Adodc2.Refresh
  End If
  Adodc2.Recordset.Fields(0) = text1(0)
  Adodc2.Recordset.Fields(1) = text1(1)
  Adodc2.Recordset.Fields(2) = text1(2)
  If TabStrip1.Tabs(1).Selected = True Then
     Adodc2.Recordset.Fields(3) = text1(3)
     Adodc2.Recordset.Fields(4) = text1(4)
  End If
  Adodc2.Recordset.Update
  Adodc2.Recordset.Fields(2) = text1(2)
  Adodc2.Recordset.Update
  Adodc2.Refresh
  Adodc1.Refresh
  MSHFlexGrid1.Refresh
End Sub
Private Sub XpBut退出_Click()
  If Ur_Qx = True Then '有用户管理权限
     Command2.Enabled = True
     Command4.Enabled = True
  Else
     Command2.Enabled = False
     Command4.Enabled = False
  End If
  TabStrip1.Enabled = True
  Command3.Enabled = True
  Command5.Enabled = True
  Command6.Visible = False
  Frame1.Visible = False
End Sub