添加删除用户:
添加用户和删除用户窗口是选择一个身份进行添加和删除。当单击添加时候判断用户身份,之后显示添加窗口,填入信息之后,则添加用户成功。
当单击用户身份的时候下面的msflexgrid控件会显示当前身份的的所有用户名,当单击选中一个按删除按钮就会删除其用户。
具体代码如下
添加和删除窗体代码如下:
Option Explicit
Dim currentRow As Integer
Private Sub CmdAddUser_Click()
If Not Testtxt(Combo1.Text) Then
MsgBox "请选择要添加的用户身份!", vbOKOnly + vbExclamation, "警告"
Combo1.SetFocus
Exit Sub
End If
FrmAddUser.Show
End SubPrivate Sub Combo1_Click()
'选中身份自动填入该身份的记录
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim a As Integer
strsql = "select * from User_Info where Status='" & Trim(Combo1.Text) & "'"
Set objrs = ExecuteSQL(strsql, msgtext)
With MyMSFlexGrid
.Rows = 1
.Cols = 3
.CellAlignment = 4
.TextMatrix(0, 0) = "用户名"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "开户名"
Do While Not (objrs.EOF)
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = Trim(objrs.Fields(0).Value)
.TextMatrix(.Rows - 1, 1) = Trim(objrs.Fields(5).Value)
.TextMatrix(.Rows - 1, 2) = Trim(objrs.Fields(3).Value)
objrs.MoveNext
Loop
End With
objrs.Close
End SubPrivate Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End SubPrivate Sub Command2_Click()
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim I As Integer
'没有记录不能删除
If currentRow < 1 Then
MsgBox "没有要删除的内容!请重新选择!", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
'删除当前选中记录
If Trim(MyMSFlexGrid.TextMatrix(currentRow, 0)) = Trim(UserName) Then
MsgBox "该用户不能删除!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
strsql = "select * from User_Info where User_Name='" & Trim(MyMSFlexGrid.TextMatrix(currentRow, 0)) & "'and Teachername='" & Trim(MyMSFlexGrid.TextMatrix(currentRow, 1)) & "'"
Set objrs = ExecuteSQL(strsql, msgtext)
I = MsgBox("真的要删除吗?", vbYesNo, "询问")
If I = vbYes Then
objrs.Delete
objrs.MoveNext
objrs.Close
Call Combo1_Click
MsgBox "删除成功!", vbOKOnly + vbExclamation, "警告"
End If
End If
End SubPrivate Sub Command3_Click()
Unload Me
End SubPrivate Sub MyMSFlexGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'判断行号
With MyMSFlexGrid
.Row = .MouseRow
currentRow = .Row
.Col = 0
End With
End SubPrivate Sub MyMSFlexGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'选中要删除的行
With MyMSFlexGrid
If .Col > 1 Then
.RowSel = currentRow
.ColSel = .ColSel - 1
End If
End With
End Sub
添加窗体代码如下:
Private Sub CmdCancel_Click()
Unload Me
End SubPrivate Sub CmdOk_Click()
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
'判断输入信息的正确性
'==============================================================
If Not Testtxt(TxtUser.Text) Then
MsgBox "用户名不能为空!", vbOKOnly + vbExclamation, "警告"
TxtUser.Text = ""
TxtUser.SetFocus
Exit Sub
End If
If Not Testtxt(TxtName.Text) Then
MsgBox "姓名不能为空!", vbOKOnly + vbExclamation, "警告"
TxtName.Text = ""
TxtName.SetFocus
Exit Sub
End If
If Not Testtxt(TxtcomputerName.Text) Then
MsgBox "机器名不能为空!", vbOKOnly + vbExclamation, "警告"
TxtcomputerName.Text = ""
TxtcomputerName.SetFocus
Exit Sub
End If
If Trim(TxtPassword.Text) <> Trim(TxtEnsurePassword.Text) Then
MsgBox "两个密码不一致,请重新输入!", vbOKOnly + vbExclamation, "警告"
TxtPassword.Text = ""
TxtEnsurePassword.Text = ""
TxtPassword.SetFocus
Exit Sub
End If
'========================================================================
strsql = "select * from User_Info"
Set objrs = ExecuteSQL(strsql, msgtext)
'判断用户名是否重名
If objrs.Fields(0) = Trim(TxtUser.Text) Then
MsgBox "该用户名已经存在,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
TxtUser.Text = ""
TxtUser.SetFocus
Exit Sub
Else
'添加用户名
objrs.AddNew
objrs.Fields(0) = Trim(TxtUser.Text)
objrs.Fields(1) = Trim(TxtPassword.Text)
objrs.Fields(2) = Trim(TxtStatus.Text)
objrs.Fields(4) = Trim(TxtcomputerName.Text)
objrs.Fields(5) = Trim(TxtName.Text)
objrs.Update
objrs.Close
MsgBox "添加用户成功!", vbOKOnly + vbExclamation, "添加成功"
Unload Me
End If
End SubPrivate Sub Form_Load()
TxtStatus.Text = FrmAddDeleteUser.Combo1.Text
End Sub