系统设置.frm

随着市场经济的发展

         Left            =   -68520
         TabIndex        =   8
         Top             =   2760
         Width           =   1215
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确定修改"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   -68520
         TabIndex        =   7
         Top             =   1560
         Width           =   1215
      End
      Begin VB.ComboBox Combo3 
         Height          =   300
         ItemData        =   "系统设置.frx":0038
         Left            =   -72240
         List            =   "系统设置.frx":004B
         TabIndex        =   6
         Top             =   3000
         Width           =   1815
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         Left            =   -72240
         TabIndex        =   5
         Top             =   1920
         Width           =   1815
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   -72240
         TabIndex        =   4
         Top             =   960
         Width           =   1815
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "用户身份"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   -74160
         TabIndex        =   3
         Top             =   3000
         Width           =   1095
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "姓  名"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   -74160
         TabIndex        =   2
         Top             =   1920
         Width           =   1095
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "用 户 名"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   -74160
         TabIndex        =   1
         Top             =   960
         Width           =   1095
      End
      Begin VB.Image Image1 
         Height          =   5595
         Left            =   -75000
         Picture         =   "系统设置.frx":0085
         Stretch         =   -1  'True
         Top             =   360
         Width           =   9000
      End
      Begin VB.Image Image2 
         Height          =   5535
         Left            =   0
         Picture         =   "系统设置.frx":99A8
         Stretch         =   -1  'True
         Top             =   360
         Width           =   8835
      End
   End
End
Attribute VB_Name = "用户权限设置"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Combo1_click()
Dim rs As ADODB.Recordset
Dim sql As String
  sql = "select * from yhxxb where yhm='" & Trim(Combo1.Text) & "'"
  Set rs = exesql(sql)
 If rs.RecordCount > 0 Then '将选中的用户名对应的姓名和身份加到复选框中
             Combo2.Text = Trim(rs.Fields("xm"))
             Combo3.Text = Trim(rs.Fields("yhsf"))
 End If
         Set rs = Nothing
         
End Sub

Private Sub Combo2_click()
Dim rs As ADODB.Recordset
Dim sql As String
  sql = "select * from yhxxb where xm='" & Trim(Combo2.Text) & "'"
  Set rs = exesql(sql)
 If rs.RecordCount > 0 Then '将选中的用户姓名对应的用户名和身份加到复选框中
             Combo1.Text = Trim(rs.Fields("yhm"))
             Combo3.Text = Trim(rs.Fields("yhsf"))
 End If
         Set rs = Nothing
End Sub


Private Sub Combo4_click()
Dim rs As ADODB.Recordset
Dim sql As String
  sql = "select * from yhxxb where yhm='" & Trim(Combo4.Text) & "'"
  Set rs = exesql(sql)
 If rs.RecordCount > 0 Then  '将选中的用户名对应的姓名和身份加到复选框中
             Combo5.Text = Trim(rs.Fields("xm"))
 End If
         Set rs = Nothing
End Sub

Private Sub Combo5_Click()
Dim rs As ADODB.Recordset
Dim sql As String
  sql = "select * from yhxxb where xm='" & Trim(Combo5.Text) & "'"
  Set rs = exesql(sql)
 If rs.RecordCount > 0 Then  '将选中的用户姓名对应的用户名和身份加到复选框中
             Combo4.Text = Trim(rs.Fields("yhm"))
 End If
         Set rs = Nothing
End Sub

Private Sub Command1_Click()
Dim sql As String
Dim rs As ADODB.Recordset
Dim i As String
i = MsgBox("确定要修改此用户权限吗", 1, "")
If i = 1 Then '判断是否确定修改
   If Trim(Combo1.Text) <> "" Then '检查用户名是否为空
      If Trim(Combo2.Text) <> "" Then '检查姓名是否为空
         If Trim(Combo3.Text) <> "" Then '检查身份是否为空
            sql = "select * from yhxxb where yhm='" & Trim(Combo1.Text) & "'"
            Set rs = exesql(sql)
            If rs.RecordCount > 0 Then '检查用户是否存在
                sql = "select * from yhxxb where xm='" & Trim(Combo2.Text) & "'"
                Set rs = exesql(sql)
                If rs.RecordCount > 0 Then '检查姓名是否存在
                    sql = "select * from yhsfb where sfmc='" & Trim(Combo3.Text) & "'"
                    Set rs = exesql(sql)
                    If rs.RecordCount > 0 Then '检查身份是否存在
                     sql = "select * from yhxxb where yhm='" & Trim(Combo1.Text) & "'"
                     Set rs = exesql(sql)
                     rs.Fields("yhsf") = Trim(Combo3.Text)
                     rs.Update
                     Set rs = Nothing
                     MsgBox "修改成功！"
                    Else: MsgBox "没有此身份！"
                    Combo3.Text = ""
                    Combo3.SetFocus
                    End If
                Else: MsgBox "查无此人！"
                Combo2.Text = ""
                Combo2.SetFocus
                End If
            Else: MsgBox "此用户名不存在！"
            Combo1.Text = ""
            Combo1.SetFocus
            End If
         Else: MsgBox "用户身份不能为空！"
         Combo3.SetFocus
         End If
      Else: MsgBox "姓名不能为空！"
      Combo2.SetFocus
      End If
   Else: MsgBox "用户名不能为空！"
   Combo1.SetFocus
   End If
End If
End Sub

Private Sub Command2_Click()
Unload 用户权限设置
End Sub

Private Sub Command3_Click()
Unload 用户权限设置
End Sub

Private Sub Command4_Click()
Dim i As Integer
    Dim sql As String
    Dim rs As New ADODB.Recordset
        If NotEmpty(用户权限设置, "zhuce") = True Then
              If checklenth(用户权限设置, "zhuce") = True Then
                    If same(registext.Text) = 0 Then '如果用户名没有重复
                        If surepass.Text <> passtext.Text Then '密码不一致
                            MsgBox "密码不一致"
                        Else:
                            sql = "select * from yhxxb "
                            Set rs = exesql(sql)
                            rs.AddNew     '将新用户信息写入数据库
                            rs.Fields("yhm") = Trim(registext.Text)
                            rs.Fields("mm") = Trim(passtext.Text)
                            rs.Fields("xm") = Trim(nametext.Text)
                            rs.Fields("yhsf") = "待定用户"
                            rs.Update
                            rs.Close
                            Set rs = Nothing
                            MsgBox "成功添加新用户!"
                        End If
                     Else:
                        MsgBox "用户名重复!请重新输入!"
                        registext.SetFocus
                        registext.Text = ""
                    End If
              End If
        End If
End Sub

Private Sub Command5_Click()
Dim sql As String
Dim rs As ADODB.Recordset
Dim i As String
i = MsgBox("确定要删除此用户吗", 1, "")
If i = 1 Then '判断是否确定修改
   If Trim(Combo4.Text) <> "" Then '检查用户名是否为空
      If Trim(Combo5.Text) <> "" Then '检查姓名是否为空
            sql = "select * from yhxxb where yhm='" & Trim(Combo4.Text) & "'"
            Set rs = exesql(sql)
            If rs.RecordCount > 0 Then '检查用户是否存在
                sql = "select * from yhxxb where xm='" & Trim(Combo5.Text) & "'"
                Set rs = exesql(sql)
                If rs.RecordCount > 0 Then '检查姓名是否存在
                     sql = "select * from yhxxb where yhm='" & Trim(Combo4.Text) & "'"
                     Set rs = exesql(sql)
                     rs.Delete
                     Set rs = Nothing
                     MsgBox "已删除！"
                Else: MsgBox "查无此人！"
                Combo5.Text = ""
                Combo5.SetFocus
                End If
            Else: MsgBox "此用户名不存在！"
            Combo4.Text = ""
            Combo4.SetFocus
            End If
      Else: MsgBox "姓名不能为空！"
      Combo5.SetFocus
      End If
   Else: MsgBox "用户名不能为空！"
   Combo4.SetFocus
   End If
End If
End Sub

Private Sub Form_Load()
Call listinitial("yhm", Combo1)
Call listinitial("xm", Combo2)
Call listinitial("yhm", Combo4)
Call listinitial("xm", Combo5)
End Sub