fmuser.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   840
         TabIndex        =   1
         Top             =   360
         Width           =   1215
      End
   End
End
Attribute VB_Name = "FMUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub ComboTypeID_Click()

  Select Case Me.ComboTypeID.Text

    Case 0:
      Me.ComboUserTypeName.Text = "管理员"

    Case 1:
      Me.ComboUserTypeName.Text = "普通用户"

    Case 2:
      Me.ComboUserTypeName.Text = "高级用户"
  End Select

End Sub

Private Sub ComboUserTypeName_Click()

  Select Case Me.ComboUserTypeName.Text

    Case "管理员":
      Me.ComboTypeID.Text = "0"

    Case "普通用户":
      Me.ComboTypeID.Text = "1"

    Case "高级用户":
      Me.ComboTypeID.Text = "2"
  End Select

End Sub

Private Sub ComdAdd_Click()
  Dim AddUser As New ADODB.Recordset
  Dim SqlStr As String
  Dim DBStr As String
  Dim sUserID As String
  Dim sUserName As String
  Dim sCode As String
  Dim sCode2 As String
  Dim iType As String
  Dim sRemake As String
    
  If Me.TextUserID.Text = "" Then
    MsgBox "请输入用户ID！"
    Exit Sub
  End If
    
  sUserID = Trim(Me.TextUserID.Text)
    
  If Me.TextUserName.Text = "" Then
    MsgBox "请输入用户名！"
    Exit Sub
  End If
    
  sUserName = Trim(Me.TextUserName.Text)
    
  If Me.TextCode.Text = "" Then
    MsgBox "请输入用户密码！"
    Exit Sub
  End If
    
  sCode = Trim(Me.TextCode.Text)
    
  If Me.TextCode2.Text = "" Then
    MsgBox "请确认用户密码！"
    Exit Sub
  End If
    
  If Me.TextCode.Text <> Me.TextCode2.Text Then
    MsgBox "两次输入的密码不一致！"
    Exit Sub
  End If
        
  sCode2 = Trim(Me.TextCode2.Text)
    
  If Me.ComboTypeID.Text = "" Then
    MsgBox "请输入用户类型！"
    Exit Sub
  End If
    
  iType = Trim(Me.ComboTypeID.Text)
    
  If Me.ComboUserTypeName.Text = "" Then
    MsgBox "请输入备注！"
    Exit Sub
  End If
    
  sRemake = Trim(Me.ComboUserTypeName.Text)
    
  DBStr = "select * from UserInfo where UserID='" & sUserID & "'"
  AddUser.Open DBStr, g_DBConn, adOpenForwardOnly, adLockOptimistic

  If Not AddUser.BOF Then
    MsgBox "该用户ID已存在！"
    AddUser.Close
    Exit Sub
  End If

  AddUser.Close
    
  DBStr = "select * from UserInfo where UserName='" & sUserName & "'"
  AddUser.Open DBStr, g_DBConn, adOpenForwardOnly, adLockOptimistic

  If Not AddUser.BOF Then
    MsgBox "该用户名已存在！"
    AddUser.Close
    Exit Sub
  End If

  AddUser.Close
    
  DBStr = "select * from UserInfo where UserPwd='" & sCode & "'"
  AddUser.Open DBStr, g_DBConn, adOpenForwardOnly, adLockOptimistic

  If Not AddUser.BOF Then
    MsgBox "该用户密码已存在！"
    AddUser.Close
    Exit Sub
  End If

  AddUser.Close
    
  SqlStr = "insert into UserInfo(UserID,UserName,UserPwd,UserType,Remake) values('" & sUserID & "','" & sUserName & "','" & sCode & "','" & iType & "','" & sRemake & "');"
  g_DBConn.Execute SqlStr
  MsgBox "添加成功！"
  Me.TextUserID.Text = ""
  Me.TextUserName.Text = ""
  Me.TextCode.Text = ""
  Me.TextCode2.Text = ""
  Me.ComboTypeID.Text = ""
  Me.ComboUserTypeName.Text = ""
    
  Adodc1.Refresh
End Sub

Private Sub ComdDelete_Click()
  Dim DeleteUser As New ADODB.Recordset
  Dim DBStr As String
  Dim sUserID As String
  Dim sUserName As String
    
  sUserID = Trim(Me.TextUserID.Text)
  sUserName = Trim(Me.TextUserName.Text)
    
  If sUserID = "" Then
    MsgBox "请输入用户ID！"
    Exit Sub
  Else
    DBStr = "select * from UserInfo where UserName='" & sUserName & "'"
  End If
    
  Set DeleteUser = New ADODB.Recordset
  DBStr = "select * from UserInfo where UserID='" & sUserID & "'"
  DeleteUser.Open DBStr, g_DBConn, adOpenDynamic, adLockOptimistic
    
  If DeleteUser.RecordCount = 0 Then
    MsgBox "该用户不存在!"
    DeleteUser.Close
    Exit Sub
  End If
   
  DeleteUser.Delete adAffectCurrent
    
  MsgBox "删除成功！"
  DeleteUser.Close
    
  Me.TextUserID.Text = ""
  Me.TextUserName.Text = ""
  Me.TextCode.Text = ""
  Me.TextCode2.Text = ""
  Me.ComboTypeID.Text = ""
  Me.ComboUserTypeName.Text = ""
    
  Adodc1.Refresh
    
End Sub

Private Sub ComdModify_Click()
  Dim AddUser As New ADODB.Recordset
  Dim SqlStr As String
  Dim Str As String
  Dim sUserID As String
  Dim sUserName As String
  Dim sCode As String
  Dim sCode2 As String
  Dim iType As String
  Dim sRemake As String
    
  If Me.TextUserID.Text = "" Then
    MsgBox "请输入用户ID！"
    Exit Sub
  End If
    
  sUserID = Trim(Me.TextUserID.Text)
    
  If Me.TextUserName.Text = "" Then
    MsgBox "请输入用户名！"
    Exit Sub
  End If
    
  sUserName = Trim(Me.TextUserName.Text)
    
  If Me.TextCode.Text = "" Then
    MsgBox "请输入用户密码！"
    Exit Sub
  End If
    
  sCode = Trim(Me.TextCode.Text)
    
  If Me.TextCode2.Text = "" Then
    MsgBox "请确认用户密码！"
    Exit Sub
  End If
    
  If Me.TextCode.Text <> Me.TextCode2.Text Then
    MsgBox "两次输入的密码不一致！"
    Exit Sub
  End If
        
  sCode2 = Trim(Me.TextCode2.Text)
    
  If Me.ComboTypeID.Text = "" Then
    MsgBox "请输入用户类型！"
    Exit Sub
  End If
    
  iType = Trim(Me.ComboTypeID.Text)
    
  If Me.ComboUserTypeName.Text = "" Then
    MsgBox "请输入备注！"
    Exit Sub
  End If
    
  sRemake = Trim(Me.ComboUserTypeName.Text)
    
  Str = "select * from UserInfo where UserID='" & sUserID & "'"
  AddUser.Open Str, g_DBConn, adOpenStatic, adLockOptimistic
  AddUser.MoveFirst

  If AddUser.Fields("UserPwd").Value = sCode Then
    SqlStr = "update UserInfo set UserID='" & sUserID & "',UserName='" & sUserName & "',UserPwd='" & sCode & "',UserType='" & iType & "',Remake='" & sRemake & "'" & "where UserID='" & sUserID & "'"
    g_DBConn.Execute SqlStr
    AddUser.Close
    MsgBox "修改成功!"
        
    Me.TextUserID.Text = ""
    Me.TextUserName.Text = ""
    Me.TextCode.Text = ""
    Me.TextCode2.Text = ""
    Me.ComboTypeID.Text = ""
    Me.ComboUserTypeName.Text = ""
    
    Adodc1.Refresh
  Else
    MsgBox "密码错误,修改失败!"
    AddUser.Close
    Exit Sub
  End If
        
End Sub

Private Sub ComdQuit_Click()
  Unload Me
    
End Sub

Private Sub Form_Load()
  Me.Top = (Screen.Height - Me.Height) / 2    '垂直方向居中
  Me.Left = (Screen.Width - Me.Height) / 2    '水平方向居中
  
  '设置Adodc连接字符串
  Adodc1.ConnectionString = g_ConnStr
  Adodc1.CommandType = adCmdTable
  Adodc1.RecordSource = "UserInfo"
End Sub