vb实现多用户登录

Public Function ConnectString() As String  '链接数据库

    '返回数据库链接

    ConnectString = "provider =sqloledb;server=IP(写运行时数据库的存放地址);UID=sa;PWD=123456;database=charge"

End Function



Public Function exectuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset

    Dim cnn As ADODB.Connection '定义链接

    Dim rst As ADODB.Recordset

    Dim sTokens() As String '定义字符串

    

    On Error GoTo executeSQL_error '异常处理

    

    sTokens = Split(SQL) '拆分字符串函数

    '用Split函数产生一个包含各个子串的数组

    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, adLockBatchOptimistic '返回查询结果

        'adLockOptimistic 仅当调用update方法时，数据提供者锁定记录 adLockBatchOptimistic 用于批处理修改

        '这个是缺省值。 adOpenKeyset 反映由其它用户所做的对记录的改变或者删除动作，但并不反映由其它用户做作的添加新记录的动作。

        Set executeSQL = rst  '返回记录集对象

        MsgString = "查询到" & rst.RecordCount & "记录"

    End If

    

executeSQL_exit:

    Set rst = Nothing '清空数据集对象

    Set cnn = Nothing '中断连接

    Exit Function

    

executeSQL_error:    '判断错误类型

    messtring = "查询错误：" & Err.Description

    

    Resume executeSQL_exit  'Resume 语句 在错误处理程序结束后，恢复原有的运行。

    

End Function

Public Function Testtxt(txt As String) As Boolean

    If Trim(txt) = "" Then

        Testtxt = False

    Else

        Testtxt = True

    End If

    

End Function

'创建窗体

Private Sub Form_Load()

    Dim txtSQL As String

    Dim MsgText As String

    Dim mrc As ADODB.Recordset

    txtSQL = "select * from 表 "

    Set mrc = ExecuteSQL(txtSQL, MsgText)

     mrc.MoveFirst

    Call viewData

    mybookmark = mrc.Bookmark

    mcclean = True

    

     If mrc.EOF = False Then

        mrc.MoveFirst

        Call viewData

        mybookmark = mrc.Bookmark

    Else

        MsgBox "没有记录！", vbOKOnly + vbExclamation, "警告"

        Exit Sub

    End If



End Sub