frmedituser.frm

Visual basic + sql server2000学员管理系统原代码

If cmdFlag = 1 Then
    '判断添加的用户名是否已存在,存在则退出子程
    strFind = "select * from sysuser where username='" & Trim(txtUserName.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If Not (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "用户名已经存在" & Chr(10) & "添加失败！ ", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    '向SysUser表中添加一行记录
    CmdOpen cmd
    strFind = "insert into sysuser (username,[password],ccode) " & _
            "values ('" & Trim(txtUserName.Text) & "','" & Trim(txtPassword.Text) & "','" & Trim(cmbCode.Text) & "')"
    cmd.CommandText = strFind
    cmd.Execute
    
    '取得刚才添加记录中的Uid值
    strFind = "select uid from sysuser where username='" & Trim(txtUserName.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    '记录SysUser表中Uid字段的值
    Dim intUid As Integer
    intUid = rsTemp![uid]
    RsClose rsTemp
        
    '向SysUserPermit表中添加一行记录
    strFind = "insert into sysuserpermit (uid,pid) values (" & intUid & ",'" & Trim(cmbPermit.Text) & "')"
    cmd.CommandText = strFind
    cmd.Execute
    
    '清除所有控件的文本显示,DisplayRefresh子程 见本窗体
    DisplayRefresh
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    
ElseIf cmdFlag = 2 Then
    '判断添加的中心代码是否已存在,不存在则退出子程
    strFind = "select * from sysuser where username='" & Trim(txtUserName.Text) & "' and ccode='" & Trim(cmbCode.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '确定是否真要删除记录
    If MsgBox("您确实要删除记录吗？", vbYesNo + vbExclamation, "提示") = vbNo Then
        '调用cmdCancel按钮的click事件
        cmdCancel_Click
        '按钮操作标记恢复为0
        cmdFlag = 0
        '显示当前记录内容,Display子程 见本窗体
        Display
        Exit Sub
    Else
        
        '删除一条记录
        CmdOpen cmd
        strFind = "delete from sysuser where username='" & Trim(txtUserName.Text) & "'"
        cmd.CommandText = strFind
        cmd.Execute
        rs.Requery
        
    End If
    
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
    
ElseIf cmdFlag = 3 Then
    '判断添加的中心代码是否已存在,不存在则退出子程
    strFind = "select * from sysuser where username='" & Trim(txtUserName.Text) & "' and ccode='" & Trim(cmbCode.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    
    '修改SysUser表的一行记录
    CmdOpen cmd
    strFind = "update sysuser set [password]='" & Trim(txtPassword.Text) & "' where [ccode]='" & _
               Trim(cmbCode.Text) & "' and username='" & Trim(txtUserName.Text) & "'"
    cmd.CommandText = strFind
    cmd.Execute
    
    '取得刚才添加记录中的Uid值
    strFind = "select uid from sysuser where username='" & Trim(txtUserName.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    '记录SysUser表中Uid字段的值
    intUid = rsTemp![uid]
    RsClose rsTemp
    
    '修改SysUserPermit表一行记录
    CmdOpen cmd
    strFind = "update sysuserpermit set [pid]='" & Trim(cmbPermit.Text) & "' where uid='" & intUid & "'"
    cmd.CommandText = strFind
    cmd.Execute
    
    rs.Requery
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
    
End If

End Sub

Private Sub Form_Activate()
'窗体激活时设置焦点
cmdAdd.SetFocus

RsClose rs
strFind = "select sysuser.* ,sysuserpermit.pid from sysuser inner join sysuserpermit on sysuser.uid=sysuserpermit.uid"
'打开表sysuser,创建记录集
RsOpen rs, con, strFind, "adcmdtext"

'清除所有控件的文本显示,DisplayRefresh子程 见本窗体
DisplayRefresh

'cmdFlag初始值为0
cmdFlag = 0
End Sub

Private Sub Form_Load()

'设置窗体的背景色为GetColor函数的返回值,宽度5900缇,GetColor函数 见模块MdlSystem
Me.BackColor = GetColor
Me.Width = 5800
Me.Height = 3750


'遍历窗体上的所有控件,改变颜色为GetColor函数的返回值(GetColor函数 见模块MdlSystem)
Dim ctlcontrol As Control
For Each ctlcontrol In Controls
    ctlcontrol.BackColor = GetColor
Next

RsClose rs
strFind = "select sysuser.* ,sysuserpermit.pid from sysuser inner join sysuserpermit on sysuser.uid=sysuserpermit.uid"
'打开表sysuser,创建记录集
RsOpen rs, con, strFind, "adcmdtext"

'设置控件的各种属性,字体大小,对齐类型,清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is Label Then
        ctlcontrol.Alignment = 0
        ctlcontrol.FontSize = 10
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    ElseIf TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
        ctlcontrol.FontSize = 10
    End If
Next

'清除所有控件的文本显示,DisplayRefresh子程 见本窗体
DisplayRefresh

'cmdFlag初始值为0
cmdFlag = 0

End Sub

Private Sub Form_LostFocus()
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub

Private Sub Form_Unload(Cancel As Integer)
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub

Private Sub DisplayRefresh()

Dim ctlcontrol As Control
'设置控件的各种属性,字体大小,对齐类型,清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is Label Then
        ctlcontrol.Alignment = 1
        ctlcontrol.FontSize = 10
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    ElseIf TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
        '组合框的内容按字符排序
        'ctlControl.Sorted = True 设计时不可用
        ctlcontrol.FontSize = 10
    End If
Next

'从表SysCenterInfo中取得所有的中心代码,放入cmbCode中
strFind = "select * from syscenterinfo"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbCode.AddItem rsTemp.Fields("ccode")
        rsTemp.MoveNext
Loop
RsClose rsTemp

'从表SysPermit中取得所有的Pid,放入cmbPermit中
strFind = "select * from syspermit"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbPermit.AddItem rsTemp.Fields("pid")
        rsTemp.MoveNext
Loop
RsClose rsTemp

End Sub

Private Sub Display()

cmbCode.Text = rs!ccode
txtUserName.Text = rs!UserName
cmbPermit.Text = rs!PID
txtPassword.Text = rs!Password
txtConfirm.Text = rs!Password

End Sub

Public Sub ControlEnabled()

'消除控件的禁用
Dim ctlEnabled As Control
For Each ctlEnabled In Controls
    ctlEnabled.Enabled = True
Next

End Sub

Public Sub ControlDisabled()

'禁用控件文本框和组合框
Dim ctlDisabled As Control
For Each ctlDisabled In Controls
    If TypeOf ctlDisabled Is TextBox Or TypeOf ctlDisabled Is ComboBox Then
            ctlDisabled.Enabled = False
    End If
Next

End Sub

Private Function InputVerify() As Boolean

InputVerify = True

'中心代码必须是三位数字,也不能为空
If Len(Trim(cmbCode.Text)) <> 3 Then
    InputVerify = False
    MsgBox "请选择中心代码！", vbOKOnly + vbExclamation, "提示"
End If

'权限类型必须是一个字符,也不能为空
If Len(Trim(cmbPermit.Text)) = 0 Then
    InputVerify = False
    MsgBox "请选择权限类型！", vbOKOnly + vbExclamation, "提示"
End If

'权限类型必须是一个字符,也不能为空
If Len(Trim(txtUserName.Text)) > 10 Or Len(Trim(txtUserName.Text)) = 0 Then
    InputVerify = False
    MsgBox "用户名不能为空" & Chr(10) & "不能大于10个字符！", vbOKOnly + vbExclamation, "提示"
End If

'权限类型必须是一个字符,也不能为空
If Len(Trim(txtPassword.Text)) > 20 Or Len(Trim(txtUserName.Text)) = 0 Then
    InputVerify = False
    MsgBox "用户密码不能为空" & Chr(10) & "不能大于20个字符！", vbOKOnly + vbExclamation, "提示"
    Exit Function
Else
    If StrComp(txtPassword.Text, txtConfirm.Text, vbBinaryCompare) <> 0 Then
        InputVerify = False
        MsgBox "用户密码与确认密码不符" & Chr(10) & "请重新输入密码！", vbOKOnly + vbExclamation, "提示"
    End If
End If


End Function