users.vb

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

'==================================
'
' 用户数据模型描述
'
'==================================
Public Class UserDataModel
  '类的数据成员变量
  Public m_iUserID As Integer
  Public m_szUserAccount As String
  Public m_szUserPwd As String
  Public m_szTrueName As String
  Public m_iRoleID As Integer
  Public m_szRoleName As String
  Friend m_iRightLevel As Integer '用Friend声明的变量只可以在同项目内访问

  Public ReadOnly Property RightLevel() As UserPurview
    Get
      Return Me.m_iRightLevel
    End Get
  End Property

End Class


'==================================
'
' 用户描述，提供用户操作的所有功能
'
'==================================
Public Class User
  Protected Const UserIDField = "UserID"
  Protected Const UserAccountField = "UserAccount"
  Protected Const UserPwdField = "UserPwd"
  Protected Const TrueNameField = "TrueName"
  Protected Const RoleIDField = "RoleID"
  Protected Const RoleNameField = "RoleName"
  Protected Const RightLevelField = "RightLevel"

  Friend UserDataModel

  '验证用户身份
  Public Function Login(ByVal strAccount As String, ByVal strPwd As String) As String
    Dim ErrMsg As String = ""
    Dim dmUser As New UserDataModel

    ErrMsg = getUserInfo(strAccount, dmUser)

    If ErrMsg = "" Then      '获取密码成功
      If strPwd <> dmUser.m_szUserPwd Then
        ErrMsg = "用户名密码不匹配，请重试"
      End If
    End If

    Return ErrMsg

  End Function

  Public Function UpdageTrueName(ByVal strAccount As String, _
                        ByVal strTrueName As String) As String

    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String

    strSQL = "EXEC UpdateTrueName '" & dbObj.SafeDbString(strAccount) & "','" _
            & dbObj.SafeDbString(strTrueName) & "'"

    ErrMsg = dbObj.RunSql(strSQL)

    Return ErrMsg

  End Function

  '更新密码
  Public Function ChangePwd(ByVal strAccount As String, _
                          ByVal strOldPwd As String, _
                          ByVal strNewPwd As String, _
                          ByVal strConfirmPwd As String) As String
    Dim ErrMsg As String = ""
    Dim dmUser As New UserDataModel

    ErrMsg = getUserInfo(strAccount, dmUser)

    '1) 获取密码失败
    If ErrMsg <> "" Then
      ErrMsg = "系统错误，用户已被删除？"
      Return ErrMsg
    End If

    '2) 验证旧密码
    If strOldPwd <> dmUser.m_szUserPwd Then
      ErrMsg = "用户旧密码不匹配，请重试"
      Return ErrMsg
    End If

    '3) 验证新密码是否一致
    If strNewPwd <> strConfirmPwd Then
      ErrMsg = "两次密码输入不一致，请重试"
      Return ErrMsg
    End If

    '4) 更新数据库
    ErrMsg = ChangePwd(strAccount, strNewPwd)

    Return ErrMsg

  End Function

  Protected Function changePwd(ByVal strAccount As String, _
                        ByVal strPwd As String) As String

    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String

    strSQL = "EXEC ChangePwd '" & dbObj.SafeDbString(strAccount) & "','" _
            & dbObj.SafeDbString(strPwd) & "'"

    ErrMsg = dbObj.RunSql(strSQL)

    Return ErrMsg

  End Function


  Public Function AddUser(ByRef dmUser As UserDataModel) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    strSQL = "EXEC AddUser " _
            & dbObj.SafeDbString(dmUser.m_szUserAccount) _
            & "," & dbObj.SafeDbString(dmUser.m_szUserPwd) _
            & "," & dbObj.SafeDbString(dmUser.m_szTrueName) _
            & "," & dmUser.m_iRoleID

    ErrMsg = dbObj.GetDataView(strSQL, dv)
    If dv.Count = 0 Then
      Return ErrMsg
    End If

    dmUser.m_iUserID = dv(0)(Me.UserIDField)

    Return ErrMsg

  End Function

  Public Function getUserInfo(ByVal szAccount As String, _
                        ByRef dmUser As UserDataModel) As String

    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String

    Dim dv As New DataView
    strSQL = "EXEC GetUserInfo '" & dbObj.SafeDbString(szAccount) & "'"

    ErrMsg = dbObj.GetDataView(strSQL, dv)
    If dv.Count = 0 Then
      Return ErrMsg
    End If

    If dmUser Is Nothing Then
      dmUser = New UserDataModel
    End If

    '保存数据
    dmUser.m_iUserID = dv(0)(Me.UserIDField)
    dmUser.m_szUserAccount = dv(0)(Me.UserAccountField)
    dmUser.m_szUserPwd = dv(0)(Me.UserPwdField)
    dmUser.m_szTrueName = dv(0)(Me.TrueNameField)
    dmUser.m_iRoleID = dv(0)(Me.RoleIDField)
    dmUser.m_szRoleName = dv(0)(Me.RoleNameField)
    dmUser.m_iRightLevel = dv(0)(Me.RightLevelField)

    Return ErrMsg

  End Function

  Public Function GetAllUsers(ByRef UserAry As System.Collections.ArrayList) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    strSQL = "Exec GetAllUsers"
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If ErrMsg <> "" Then
      Return ErrMsg
    End If

    If UserAry Is Nothing Then
      UserAry = New ArrayList
    End If
    UserAry.Clear()
    UserAry.Capacity = dv.Count
    Dim i As Integer
    Dim dmUser As UserDataModel
    For i = 0 To dv.Count - 1
      dmUser = New UserDataModel
      dmUser.m_iRoleID = dv(i)(Me.RoleIDField)
      dmUser.m_iUserID = dv(i)(Me.UserIDField)
      dmUser.m_szRoleName = dv(i)(Me.RoleNameField)
      dmUser.m_iRightLevel = dv(i)(Me.RightLevelField)
      dmUser.m_szTrueName = dv(i)(Me.TrueNameField)
      dmUser.m_szUserAccount = dv(i)(Me.UserAccountField)
      dmUser.m_szUserPwd = dv(i)(Me.UserPwdField)
      UserAry.Add(dmUser)
    Next

  End Function


End Class