vb的一个小问题

xyjchinese 2005-11-25 10:10:10

小弟刚刚学vb不长时间,想请教个问题:
比如写一个程序,程序运行后，显示“登录”对话框，输入程序密码，核实正确后，才能进入应用程序。
请问这个功能怎么写啊?

...全文

152 8 打赏收藏转发到动态举报

写回复

用AI写文章

8 条回复

切换为时间正序

请发表友善的回复…

发表回复

Gutta 2005-11-26

打赏
举报

显然，楼主可能不太明白ADO的使用方法（我估计的。。。）

楼主可以不用什么数据库，直接用一个自己定义的万用密码（最好是有好几个）

然后在窗体中放两个文本框，一个输入密码，一个是用户名

再放一个按钮，在按钮中输入：

Private Sub Command1_Click()
If text1.text = "USRID" and text2.text = "PASSWORD" then
frmSys.Show
Unload me
Else
Msgbox "错误！无法登陆",vbCritical
End If
End Sub

faysky2 2005-11-26

打赏
举报

'引用ADO
Private Sub Command1_Click() '登陆
On Error GoTo Err
If Text1.Text = "" Then
MsgBox "请输入操作员！", vbInformation, "提示"
Exit Sub
End If
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
'连接C:\test.mdb数据库
'cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\test.mdb;Persist Security Info=False"
'连接SQL
cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=登录名;Password=密码;Initial Catalog=数据库;Data Source=Sql服务器别名"
cn.Open
rs.CursorLocation = adUseClient

Dim name As String, passa As String
name = UCase(Trim(Text1.Text))
passa = UCase(Trim(Text2.Text))

rs.Open "select * from user where ID='" & name & "'", cn, 3, 2

If rs.EOF Then
MsgBox "该用户尚未注册！", vbOKCancel, "提示"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
Else
If passa <> Trim(rs!pass) Then
MsgBox "密码不正确，请重输！！！", vbQuestion, "提示"
Text2.Text = ""
Text2.SetFocus
Exit Sub
End If
Me.Hide
main.Show 'main为主窗口名称
Exit Sub
Err:
MsgBox Err.Description
End Sub

上官云峰 2005-11-26

打赏
举报

记得引用ado
窗体代码
Option Explicit
Dim rs As ADODB.Recordset
Dim msgtext As String
Public LoginSucceeded As Boolean

Private Sub cmdCancel_Click()
'设置全局变量为 false
'不提示失败的登录
LoginSucceeded = False
End

End Sub

Private Sub cmdOK_Click()
'检查正确的密码
Dim strsql As String
On Error GoTo Logerr
strsql = "select * from master_table where master_name = '" & txtUserName.Text & "'"
Set rs = ExecuteSQL(strsql, msgtext)
If rs.RecordCount = 0 Then
MsgBox "该用户名不存在，请重试！", , "登录"
txtUserName.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
If txtPassword.Text = rs.Fields("master_pwd") Then
'将代码放在这里传递
'成功到 calling 函数
'设置全局变量时最容易的
LoginSucceeded = True
username = txtUserName.Text
password = txtPassword.Text
pusername = rs.Fields("master_pname")
Me.Hide
MDIForm1.Show
Else
MsgBox "无效的密码，请重试!", , "登录"
txtPassword.SetFocus
SendKeys "{Home}+{End}"
End If
Exit Sub
Logerr:
MsgBox "与数据库通讯失败，请确认环境设置是否正常。", 48, "提示"
End
End Sub

Private Sub Form_Load()
Me.Show
txtUserName.SetFocus
End Sub

Dim msgtext As String
Dim mrc As ADODB.Recordset

Public Function ExecuteSQL(ByVal sql As String, MsgString As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
'Dim SQL As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(sql)
Set cnn = New ADODB.Connection
cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
cnn.Execute sql
MsgString = sTokens(0) & "query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic

Set ExecuteSQL = rst

MsgString = "查询到" & rst.RecordCount & "条纪录"
End If
ExecuteSQL_Exit:
Set rst = Nothing
Exit Function
Set cnn = Nothing
ExecuteSQL_Error:
MsgString = "查询错误:" & Err.Description
Resume ExecuteSQL_Exit
End Function

Public Function ConnectString() As String
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\计划管理系统.mdb;Persist Security Info=False"
'ConnectString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=aa;Data Source=RJB-CL"
End Function

xyjchinese 2005-11-26

打赏
举报

谢谢各位

xingmaohai 2005-11-26

打赏
举报

思路如下:
<1>先在数据库中建相应的表，保存用户及密码的信息。
<2>利用ado查询姓名栏位为输入的值的记录。
<3>如果存在，则继续查询输入的密码是否与数据库中的相对应。
<4>如果信息正确则出现主程式界面;如果错误则按照程式给定的次数限制再次检验登录信息，
如超出次数限定则将程式结束。
具体代码现贴给你：
Private Sub cmdConfirm_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strCnSQL As String
Dim strRsSQL As String
' isruncmdconfirm = True

strCnSQL = _
"Provider=SQLOLEDB.1;Persist Security Info=False;" _
& "DATA Source=W_SERVER;" _
& "Initial Catalog=hansheng;User ID=sa;Pwd=1;"

Set cn = New ADODB.Connection
cn.ConnectionString = strCnSQL
cn.ConnectionTimeout = 6

On Error GoTo cnerrhandler
cn.Open

strRsSQL = "SELECT * from hs_user_info WHERE user_id='" & LCase(Trim(txtuserinfo(0))) & "'"

Set rs = New ADODB.Recordset
Set rs = cn.Execute(strRsSQL)
If rs.EOF Then
MsgBox "块ノめぃ!", vbOKOnly + vbCritical, "簙秤璹虫颓╰参"
Set rs = Nothing
txtuserinfo(0).SetFocus
Exit Sub
Else
' MsgBox disENCRYPTION(rs.Fields("user_password")) & "材Ω"
' rs.Close
'
' strRsSQL = "SELECT * from hs_user_info WHERE user_password='" & ENCRYPTION(Trim(txtuserinfo(1))) & "'"
'
' Set rs = cn.Execute(strRsSQL)
If disENCRYPTION(rs.Fields("user_password")) <> Trim(txtuserinfo(1)) Then
MsgBox "块ノめ盏绁岿粇!", vbOKOnly + vbCritical, "簙秤璹虫颓╰参"
rs.Close
Set rs = Nothing
txtuserinfo(1).SetFocus
Exit Sub
Else
Dim islogon As Boolean

islogon = rs.Fields("user_flag")
If Not islogon Then
' MsgBox rs.Fields("user_flag")
Dim strUpdate As String
strUpdate = "UPDATE hs_user_info SET user_flag=1 WHERE user_id='" & Trim(txtuserinfo(0)) & _
"' AND user_password='" & Trim(txtuserinfo(1)) & "'"
cn.Execute (strUpdate)
mdluser_id = rs.Fields("user_id")
mdluser_password = rs.Fields("user_password")
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
isentercmdconfirm = True
Unload Me
MdifrmMain.Show
Else
MsgBox "ノめ竒祅魁,叫穝匡!", vbOKOnly + vbInformation, "簙秤璹虫颓╰参"
txtuserinfo(0).SetFocus
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
End If
End If
End If
Exit Sub
cnerrhandler:
MsgBox "岿粇方:" & Err.Source & vbCrLf & _
"岿粇ず甧:" & Err.Description & _
"岿粇腹绁:" & Err.Number
Set cn = Nothing

End Sub

northwolves 2005-11-25

打赏
举报

http://community.csdn.net/Expert/topic/4295/4295173.xml?temp=.8874018

winehero 2005-11-25

打赏
举报

首先看你登录信息保存在哪里，
如果是数据库的一用户信息之类的表中，那么需要使用数据库表读取操作（其中可使用ADO对象）执行SQL语句，类似： Select count(1) from 表 where 用户=输入的用户 and 密码=输入的密码
如果结果返回记录数为1，就让程序继续下走，如关闭登录窗体打开主窗体等等,否则提示用户
信息无效,要求其继续输入或者退出系统等
如果信息保存在注册表或文件中,则读取注册表或文件,验证过程同上...

northwolves 2005-11-25