我做的是客户端服务器程序,通过sql密码认证的,我给你们你们还得做数据库啊,代码有点多。
下面的是模块里面的
Option Explicit
Public fMainForm As New frmMain
Public State As Boolean
Public Username As String
Sub Main()
Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.Ok Then
        End
    End If
    Unload fLogin
Set fMainForm = New frmMain
    fMainForm.Show
    
End SubPublic 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
    State = True
On Error GoTo ExecuteSQL_Error
'用Split 函数来产生一个包含各个子串的数组
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 SQL, cnn, adOpenDynamic, adLockBatchOptimistic
    Set ExecuteSQL = rst
    MsgString = "查询到" & rst.RecordCount & "条记录"
End IfExecuteSQL_Exit:
'清空数据集对象
    Set rst = Nothing
'中断连接
    Set cnn = Nothing
    Exit Function
ExecuteSQL_Error:
    MsgString = "查询错误:" & Err.Description
    MsgBox "你没有连接到服务器上,请与管理员联系", vbOKOnly + vbExclamation, "警告"
    State = False
    'Debug.Print Err.Description
    Resume ExecuteSQL_ExitEnd FunctionPublic Function ConnectString() As String
ConnectString = "File Name=c:\Program Files\Common Files\ODBC\Data Sources\HTK.dsn;"End Function
在下面是登录窗口的代码
Option Explicit
Public Ok As Boolean
Dim miCount As IntegerPrivate Sub cboItem_Click()
    
    Username = Trim(cboItem)
    
End SubPrivate Sub cmdCancel_Click()
    Ok = False
    Me.Hide
End SubPrivate Sub cmdOk_Click()
Dim txtSQL As String
Dim MsgText As String
Username = ""
Dim mrc As ADODB.Recordset
txtSQL = "select user_PWD from user_Info where user_ID='" & Trim(cboItem) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If State = False Then
    Exit Sub
End IfIf txtPWD <> Trim(mrc.Fields(0)) Then
    MsgBox "输入的密码错误,请重新输入!", vbOKOnly + vbExclamation, "警告"
    txtPWD.Text = ""
    txtPWD.SetFocus
    mrc.Close
End IfmiCount = miCount + 1
If miCount = 3 Then
    Me.Hide
End If
    Exit Sub
End SubPrivate Sub Form_Load()
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
txtSQL = "select user_ID from user_Info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
    Do While Not mrc.EOF
        cboItem.AddItem Trim(mrc.Fields(0))
        mrc.MoveNext
    Loop
    cboItem.ListIndex = 0
Else
    MsgBox "请与管理员联系取得用户名", vbOKOnly + vbExclamation, "警告"
    Exit Sub
End If
mrc.Close
Ok = False
miCount = 0
End Sub
登录窗口上有一个list下拉列表框,有一个文本框,还有两个按钮,一个是确认,一个是取消按钮。就这么多!
如果还不清楚,可以把你们的邮箱告诉我,我把源代码发给你!

解决方案 »

  1.   

    是在
    fLogin.Show vbModal
        If Not fLogin.Ok Then
            End
        End If
    进去然后就出不来了?
      

  2.   

    要Unload 窗口才会返回到Main函数!Exit sub 不成。
      

  3.   

    to: holydiaoblo(鱼头)
    当执行到flogin.show vbmodal时就不出来了。还没有执行下面的if 语句呢!
      

  4.   

    to:zhsu(做人Bata版)
    是这样的,当执行到flogin.show vbmodal去执行登录窗口,如果密码确认完毕再回到main()函数中去,但是现在就是确认了密码密码正确的也回不去啊。
      

  5.   

    还有啊,当点击取消按钮时,它能过跳出来去执行main()函数里面的内容。就是if语句了!
      

  6.   

    无论确定还是取消都要将窗口关闭(Unload Me)才能返回到Main 函数!!
      

  7.   

    你为什么舍不得unload你的登录窗口?
    exit sub只是退出了当前过程,并没有关闭模式窗口,程序停在那里等待事件,后面的代码当然不能运行。
      

  8.   

    你还没有明白吗??
    就是说flogin.show vbmodal的时候,Sub Main()就暂停了,而将flogin压栈,然后一直到你点击cmdOk或cmdCancel,这个时候如果你只是将flogin.hide,flogin并没有退栈,所以Sub Main()依然没有回到栈顶,自然就不执行了。
    所以你在cmdok_click或是在cmdCancel_click的时候,你要unload me,也就是说将flogin从堆栈中退出,这样sub main()就重新回到栈顶继续执行了。