checkuser.bas

来自「用VB开发的一套邮政编码区号查询」· BAS 代码 · 共 72 行

Attribute VB_Name = "checkuser"
'登陆状态
Public state As Boolean
'用户名
Public userName As String

Public Sub CheckUser(userID As String, passwd As String)

Dim userDB As Database
Dim userRD As Recordset
Dim dbName As String
Dim STRSQL As String

Screen.MousePointer = 11

On Error GoTo errEnd

dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "zjsDataBase.mdb"
STRSQL = "select [用户身份] from [Admin] where [用户ID]=""" & userID & """ and [用户密码]=""" & passwd & """"

'DBEngine.DefaultUser = "admin"
'DBEngine.DefaultPassword = "admin"
'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)

If userRD.RecordCount > 0 Then
    '设置用户身份
    UserShenFen = userRD![用户身份]
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    
    '进入用户环境
    Load FrmMain
    FrmMain.Show
    Unload FrmLogIn
    logOK = True
    userName = userID
    Screen.MousePointer = vbDefault
Else
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    logOK = False
    
    Screen.MousePointer = vbDefault
    MsgBox "用户名或密码错误！请重新输入！", vbOKOnly + vbExclamation, "登陆失败"
End If
Exit Sub

errEnd:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbOKOnly + vbExclamation, "登陆错误"
    logOK = False
    Err.Clear
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    Exit Sub

End Sub