vb登陆界面设计

weixin_44686364 2019-03-09 06:21:06

做的登陆界面，有用户名且无论该用户名在不在数据库中都显示没有该用户，哪怕用户名和密码都与数据库里的一致
全局模块变量：
Option Explicit

Public guserName As String '用户名称，该变量用于存储登录用户的名称
Public guserKind As String '用户类型，该变量用于确定登录用户的类型
Public gempID As String '员工编号，该变量用于记录当前职员的编号
Public gbLog As Boolean '登录成功，该变量用于标识是否登录成功
Public conn As ADODB.Connection '数据库的connection对象

Public Function ConnStr() As String
ConnStr = "Provider=SQLOLEDB.1 ;integerated Security =SSPI; Persist Security Info=False;User ID=sa;Password=LK19960217;Initial Catalog=DBEmp;Data Source=ThePower,1433"
End Function

Public Function ExeSQL(SQL As String, rs As ADODB.Recordset, Optional enWrite As Boolean = True) As Boolean
On Error GoTo Exe_Error '如果有错误，则转入Exe_Error处
Set rs = New ADODB.Recordset
If enWrite Then
rs.Open SQL, conn, adOpenStatic, adLockOptimistic '以写方式执行SQL语句
Else
rs.Open SQL, conn, adOpenStatic, adLockReadOnly '以只读方式执行SQL语句
End If
ExeSQL = True '执行成功，返回true
Exit Function
Exe_Error:
ExeSQL = False '执行失败，返回false
Exit Function
End Function

Public Function RecExist(SQL As String) As Integer
Dim flag As String '标识SQL语句是否成功执行
Dim rs As ADODB.Recordset
flag = ExeSQL(SQL, rs, False) '执行SQL语句并返回结果
If rs.RecordCount <> 0 Then
RecExist = rs.RecordCount 'RecExist 返回值为记录数
Else
RecExist = 0 '如果记录数不存在，则返回0
End If
End Function

Public Function RefData(txtSQL As String, dgRef As DataGrid) As Integer
Dim rsData As ADODB.Recordset
Dim result As String '定义ExeSQL函数返回结果
result = ExeSQL(txtSQL, rsData, False)

If rsData.RecordCount <> 0 Then '如果返回的Recordset对象中的记录数不为0
Set dgRef.DataSource = rsData '设置DataGrid 的数据源
RefData = rsData.RecordCount
Else
MsgBox "数据为空！", vbOKOnly + vbExclamation, "警告"
RefData = 0
End If
End Function

Public Function ISEquLen(txt As TextBox, intlen As Integer) As Boolean
If Len(txt.Text) <> intlen Then '如果输入的数据位数不符合规定
MsgBox "输入数据有误请重新输入！"
txt.SetFocus '输入文本框获得焦点，让用户重新输入
ISEquLen = False
Else
ISEquLen = True
End If
End Function

Public Function OpenConn() '建立数据库链接
Set conn = New ADODB.Connection '创建新的连接
conn.Open ConnStr '打开数据库连接

End Function

Public Function CloseConn()
conn.Close '关闭数据库连接

End Function

Sub Main() '应用程序启动入口
Dim frmLog As New frmLogin '定义登录窗体变量
Dim title As String '定义字符串变量用于记录程序标题

If App.PrevInstance Then '检查应用程序实例是否运行
title = App.title
MsgBox "应用程序已经运行！"
App.title = "" '设置应用程序标题为空
frmmain.Caption = "" '设置主窗体标题为空
AppActivate title

Else
OpenConn '打开数据库连接
frmLog.Show vbModal '显示登录窗体
End If
Unload frmLog '卸载登录窗体

End Sub
登录界面代码：
Option Explicit
Dim num As Integer

Private Sub cmdCancel_Click()
CloseConn
End
End Sub

Private Sub cmdLog_Click()
Dim txtSQL As String
Dim rsLog As ADODB.Recordset
Dim flag As String

guserName = ""
guserKind = ""

If Trim(Me.cboName.Text) = "" Then
MsgBox "用户名不能为空", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
txtSQL = "select * from tbUser where userID=' " & Me.cboName.Text & "'"
flag = ExeSQL(txtSQL, rsLog, False)
If rsLog.RecordCount = 0 Then
MsgBox "没有该用户，请重新输入", vbOKOnly + vbExclamation, "警告"
Me.cboName.SetFocus
Exit Sub
Else
If Trim(rsLog.Fields(1)) = Trim(Me.txtPass.Text) Then
guserName = Trim(Me.cboName.Text)
guserKind = Trim(rsLog.Fields(2))

gbLog = True
rsLog.Clone
Unload Me
frmmain.Show
Else
If num < 2 Then
num = num + 1
MsgBox "密码不正确，请重新输入！您还有" & Str(3 - num) & "次机会", vbOKOnly + vbExclamation, "警告"
Me.txtPass.SetFocus
Me.txtPass.Text = ""
Else
MsgBox "登录失败"
End
End If
End If
End If
End If
End Sub

Private Sub Form_Load()
Dim txtSQL As String
Dim rsLog As ADODB.Recordset
Dim flag As String
Dim i As Integer
num = 0
OpenConn
txtSQL = "select * from tbUser"
flag = ExeSQL(txtSQL, rsLog, False)
For i = 0 To rsLog.RecordCount - 1
Me.cboName.AddItem rsLog.Fields(0)
rsLog.MoveNext
Next

End Sub