VB数据库链接(登陆与退出)

发布时间:2007年06月04日      浏览次数:1565 次
Private Sub cmdok_Click()
'登陆判断
Dim mrc As ADODB.Recordset
Dim sql, msg As String
'判断是否输入用户名
If Trim(usr.Text) = "" Then
MsgBox "请输入用户名!", vbOKOnly + vbExclamation, "警告"
usr.SetFocus
Exit Sub
End If
If Trim(pwd.Text) = "" Then
MsgBox "请输入密码!", vbOKOnly + vbExclamation, "警告"
pwd.SetFocus
Exit Sub
End If
'异常处理
On Error GoTo Execute_Error
sql = "select * from usr where usr = '" & usr.Text & "' and pwd='" & pwd.Text & "'"
Set mrc = ExecuteSQL(sql, msg)
If mrc.EOF Then
MsgBox "用户名错误,请重新输入!", vbOKOnly + vbExclamation, "警告"
pwd.Text = ""
usr.SetFocus
Exit Sub
Else
MsgBox "登陆成功!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
Execute_Error:
MsgBox "录登失败!", vbOKOnly + vbExclamation, "警告"
End Sub
'用ByVal 定义的参数按值传送,而不是按地址传送
Public Function ExecuteSQL(ByVal sql As String, MsgString As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim xString() As String
xString = Split(sql)
'创建连接
On Error GoTo Execute_Error
Set cnn = New ADODB.Connection
'打开连接
cnn.Open cnnectstring
If InStr("INSERT,DELETE,UPDATE", UCase(xString(0))) Then
'执行语句
cnn.Execute sql
'返回查询信息
MsgString = xString(0) & "条记录!"
Else
Set rst = New ADODB.Recordset
'返回记录集信息
rst.Open sql, cnn, adOpenKeyset, adLockOptimistic
Set ExecuteSQL = rst
MsgString = "查询到" & rst.RecordCount & "条记录!"
End If
Execute_Exit:
'清空数据集
Set rst = Nothing
'中断连接
Set cnn = Nothing
Exit Function
Execute_Error:
MsgString = "查询错误" & Err.Description
Resume Execute_Exit
End Function
Public Function cnnectstring() As String
Dim xstr As String
xstr = App.Path
If Right(xstr, 1) <> "/" Then xstr = xstr & "/"
cnnectstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xstr & "data.mdb;Persist Security Info=False"
End Function
Sub Main()
Form1.Show
End Sub
Public Function EnterToTab(keyasc As Integer)
'判断是否为回车键
If keyasc = 13 Then
'转换为Tab键
SendKeys "{Tab}"
End If
End Function
Private Sub cmdCancel_Click()
'退出登陆
Unload Me
End Sub
免责声明:本站相关技术文章信息部分来自网络,目的主要是传播更多信息,如果您认为本站的某些信息侵犯了您的版权,请与我们联系,我们会即时妥善的处理,谢谢合作!