vb的一个小问题

Question

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

Answer 1

http://www.soft6.com/know/detail.asp?id=BACIGD你的问题CSDN上问过不知多少次了

Answer 2

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

Answer 3

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

Answer 4

记得引用ado
窗体代码
Option Explicit
Dim rs As ADODB.Recordset
Dim msgtext As String
Public LoginSucceeded As BooleanPrivate Sub cmdCancel_Click()
    '设置全局变量为 false
    '不提示失败的登录
    LoginSucceeded = False
    End
    
End SubPrivate 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 SubPrivate Sub Form_Load()
    Me.Show
    txtUserName.SetFocus
End SubDim msgtext As String
Dim mrc As ADODB.RecordsetPublic 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 FunctionPublic 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

Answer 5

'引用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

Answer 6

显然，楼主可能不太明白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

Answer 7

思路如下:
<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