Option Explicit
'ȱʡÊôÐÔÖµ:
Const m_def_DBName = ""
Const m_def_ServerName = ""
Const m_def_TableName = ""
Const m_def_colUserName = ""
Const m_def_colPassword = ""
'ÊôÐÔ±äÁ¿:
Dim m_DBName As String
Dim m_ServerName As String
Dim m_TableName As String
Dim m_colUserName As String
Dim m_colPassword As String
'ʼþÉùÃ÷:
Event AfterLogin(ByVal Success As Boolean)
Dim conn As ADODB.Connection
Dim rct As ADODB.Recordset'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MappingInfo=txtUserName,txtUserName,-1,Text
Public Property Get UserName() As String
    UserName = txtUserName.Text
End PropertyPublic Property Let UserName(ByVal New_UserName As String)
    txtUserName.Text() = New_UserName
    PropertyChanged "UserName"
End Property'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=13,0,0,
Public Property Get DBName() As String
    DBName = m_DBName
End PropertyPublic Property Let DBName(ByVal New_DBName As String)
    m_DBName = New_DBName
    PropertyChanged "DBName"
End Property'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=13,0,0,
Public Property Get ServerName() As String
    ServerName = m_ServerName
End PropertyPublic Property Let ServerName(ByVal New_ServerName As String)
    m_ServerName = New_ServerName
    PropertyChanged "ServerName"
End Property'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=0
Public Function Login() As BooleanEnd Function'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=13,0,0,
Public Property Get TableName() As String
    TableName = m_TableName
End PropertyPublic Property Let TableName(ByVal New_TableName As String)
    m_TableName = New_TableName
    PropertyChanged "TableName"
End Property'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=13,0,0,
Public Property Get colUserName() As String
    colUserName = m_colUserName
End PropertyPublic Property Let colUserName(ByVal New_colUserName As String)
    m_colUserName = New_colUserName
    PropertyChanged "colUserName"
End Property'×¢Ò⣡²»ÒªÉ¾³ý»òÐÞ¸ÄÏÂÁб»×¢Ê͵ÄÐУ¡
'MemberInfo=13,0,0,
Public Property Get colPassword() As String
    colPassword = m_colPassword
End PropertyPublic Property Let colPassword(ByVal New_colPassword As String)
    m_colPassword = New_colPassword
    PropertyChanged "colPassword"
End PropertyPrivate Sub cmdOK_Click()
    Set rct = New ADODB.Recordset
    rct.Open "select * from '" & TableName & "' where '" & colUserName & "'='" & Trim(txtUserName) & "'", conn, adOpenDynamic, adLockOptimistic, adCmdText
    If rct.EOF And rct.BOF Then
        lblInfo.Caption = "Óû§ÃûÊäÈë´íÎó"
        RaiseEvent AfterLogin(False)
        Exit Sub
    End If
    rct.MoveFirst
    If txtPassword <> Trim(rct.Fields("'" & colPassword & "'")) Then
        lblInfo.Caption = "&Atilde;&Uuml;&Acirc;&euml;&Ecirc;&auml;&Egrave;&euml;&acute;í&Icirc;ó"
        RaiseEvent AfterLogin(False)
        Exit Sub
    Else
        lblInfo.Caption = "&micro;&Ccedil;&Acirc;&frac12;&sup3;&Eacute;&sup1;&brvbar;&pound;&not;&raquo;&para;&Oacute;&shy;" & txtUserName & "&Agrave;&acute;&micro;&frac12;&Otilde;&acirc;&Agrave;&iuml;"
        RaiseEvent AfterLogin(True)
    End If
End Sub'&Icirc;&ordf;&Oacute;&Atilde;&raquo;§&iquest;&Oslash;&frac14;&thorn;&sup3;&otilde;&Ecirc;&frac14;&raquo;&macr;&Ecirc;&ocirc;&ETH;&Ocirc;
Private Sub UserControl_InitProperties()
    m_DBName = m_def_DBName
    m_ServerName = m_def_ServerName
    m_TableName = m_def_TableName
    m_colUserName = m_def_colUserName
    m_colPassword = m_def_colPassword
End Sub'&acute;&Oacute;&acute;&aelig;&Ouml;ü&AElig;÷&Ouml;&ETH;&frac14;&Oacute;&Ocirc;&Oslash;&Ecirc;&ocirc;&ETH;&Ocirc;&Ouml;&micro;
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    txtUserName.Text = PropBag.ReadProperty("UserName", "")
    m_DBName = PropBag.ReadProperty("DBName", m_def_DBName)
    m_ServerName = PropBag.ReadProperty("ServerName", m_def_ServerName)
    m_TableName = PropBag.ReadProperty("TableName", m_def_TableName)
    m_colUserName = PropBag.ReadProperty("colUserName", m_def_colUserName)
    m_colPassword = PropBag.ReadProperty("colPassword", m_def_colPassword)
End Sub'&frac12;&laquo;&Ecirc;&ocirc;&ETH;&Ocirc;&Ouml;&micro;&ETH;&acute;&micro;&frac12;&acute;&aelig;&acute;&cent;&AElig;÷
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("UserName", txtUserName.Text, "")
    Call PropBag.WriteProperty("DBName", m_DBName, m_def_DBName)
    Call PropBag.WriteProperty("ServerName", m_ServerName, m_def_ServerName)
    Call PropBag.WriteProperty("TableName", m_TableName, m_def_TableName)
    Call PropBag.WriteProperty("colUserName", m_colUserName, m_def_colUserName)
    Call PropBag.WriteProperty("colPassword", m_colPassword, m_def_colPassword)
End Sub
Public Function ConnectToServer() As Boolean
    Set conn = New ADODB.Connection
    If conn.State = adStateClosed Then
        conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog='" & DBName & "';Data Source='" & ServerName & "'"
        conn.ConnectionTimeout = 30
        conn.Open
    End If
    ConnectToServer = True
End Function

解决方案 »

  1.   

    看这个吧,这个清楚些
    Option Explicit
    '缺省属性值
    Const m_def_DBName = ""
    Const m_def_ServerName = ""
    Const m_def_TableName = ""
    Const m_def_colUserName = ""
    Const m_def_colPassword = ""
    '属性变量
    Dim m_DBName As String
    Dim m_ServerName As String
    Dim m_TableName As String
    Dim m_colUserName As String
    Dim m_colPassword As String
    '实践声明
    Event AfterLogin(ByVal Success As Boolean)
    Dim conn As ADODB.Connection
    Dim rct As ADODB.Recordset'注意不要删除或修改一下被注释的行
    'MappingInfo=txtUserName,txtUserName,-1,Text
    Public Property Get UserName() As String
        UserName = txtUserName.Text
    End PropertyPublic Property Let UserName(ByVal New_UserName As String)
        txtUserName.Text() = New_UserName
        PropertyChanged "UserName"
    End Property'注意不要删除或修改一下被注释的行
    'MemberInfo=13,0,0,
    Public Property Get DBName() As String
        DBName = m_DBName
    End PropertyPublic Property Let DBName(ByVal New_DBName As String)
        m_DBName = New_DBName
        PropertyChanged "DBName"
    End Property'注意不要删除或修改一下被注释的行
    'MemberInfo=13,0,0,
    Public Property Get ServerName() As String
        ServerName = m_ServerName
    End PropertyPublic Property Let ServerName(ByVal New_ServerName As String)
        m_ServerName = New_ServerName
        PropertyChanged "ServerName"
    End Property'注意不要删除或修改一下被注释的行
    'MemberInfo=0
    Public Function Login() As BooleanEnd Function'注意不要删除或修改一下被注释的行
    'MemberInfo=13,0,0,
    Public Property Get TableName() As String
        TableName = m_TableName
    End PropertyPublic Property Let TableName(ByVal New_TableName As String)
        m_TableName = New_TableName
        PropertyChanged "TableName"
    End Property'注意不要删除或修改一下被注释的行
    'MemberInfo=13,0,0,
    Public Property Get colUserName() As String
        colUserName = m_colUserName
    End PropertyPublic Property Let colUserName(ByVal New_colUserName As String)
        m_colUserName = New_colUserName
        PropertyChanged "colUserName"
    End Property'注意不要删除或修改一下被注释的行
    'MemberInfo=13,0,0,
    Public Property Get colPassword() As String
        colPassword = m_colPassword
    End PropertyPublic Property Let colPassword(ByVal New_colPassword As String)
        m_colPassword = New_colPassword
        PropertyChanged "colPassword"
    End PropertyPrivate Sub cmdOK_Click()
        Set rct = New ADODB.Recordset
        rct.Open "select * from '" & TableName & "' where '" & colUserName & "'='" & Trim(txtUserName) & "'", conn, adOpenDynamic, adLockOptimistic, adCmdText
        If rct.EOF And rct.BOF Then
            lblInfo.Caption = "用户名输入错误"
            RaiseEvent AfterLogin(False)
            Exit Sub
        End If
        rct.MoveFirst
        If txtPassword <> Trim(rct.Fields("'" & colPassword & "'")) Then
            lblInfo.Caption = "密码输入错误"
            RaiseEvent AfterLogin(False)
            Exit Sub
        Else
            lblInfo.Caption = 登陆成功,欢迎" & txtUserName & "来到这里"
            RaiseEvent AfterLogin(True)
        End If
    End Sub'为用户初始化属性
    Private Sub UserControl_InitProperties()
        m_DBName = m_def_DBName
        m_ServerName = m_def_ServerName
        m_TableName = m_def_TableName
        m_colUserName = m_def_colUserName
        m_colPassword = m_def_colPassword
    End Sub'从存储器中加载属性值
    Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    txtUserName.Text = PropBag.ReadProperty("UserName", "")
        m_DBName = PropBag.ReadProperty("DBName", m_def_DBName)
        m_ServerName = PropBag.ReadProperty("ServerName", m_def_ServerName)
        m_TableName = PropBag.ReadProperty("TableName", m_def_TableName)
        m_colUserName = PropBag.ReadProperty("colUserName", m_def_colUserName)
        m_colPassword = PropBag.ReadProperty("colPassword", m_def_colPassword)
    End Sub'将属性值写到存储器
    Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("UserName", txtUserName.Text, "")
        Call PropBag.WriteProperty("DBName", m_DBName, m_def_DBName)
        Call PropBag.WriteProperty("ServerName", m_ServerName, m_def_ServerName)
        Call PropBag.WriteProperty("TableName", m_TableName, m_def_TableName)
        Call PropBag.WriteProperty("colUserName", m_colUserName, m_def_colUserName)
        Call PropBag.WriteProperty("colPassword", m_colPassword, m_def_colPassword)
    End Sub
    Public Function ConnectToServer() As Boolean
        Set conn = New ADODB.Connection
        If conn.State = adStateClosed Then
            conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog='" & DBName & "';Data Source='" & ServerName & "'"
            conn.ConnectionTimeout = 30
            conn.Open
        End If
        ConnectToServer = True
    End Function
      

  2.   

    Public Function ConnectToServer() As Boolean
    这个函数没有见你调用啊
      

  3.   

    在类的初始化或者cmdOK_Click调用Public Function ConnectToServer() As Boolean