basdatabase.bas

用VB6.0编写的QQ聊天软件

Attribute VB_Name = "basDatabase"
Option Explicit

Public cnn As New ADODB.Connection
Public rst As New ADODB.Recordset
Public rstFriends As New ADODB.Recordset
Public rstTemp As New ADODB.Recordset

Private Sub Main()
    
    If App.PrevInstance = True Then End

    cnn.CursorLocation = adUseClient
    rst.CursorLocation = adUseClient
    rstFriends.CursorLocation = adUseClient

    tkOpenAccessDB App.Path & "\Data\Tekken.mdb" ', "Admin", "LoveZhangXiaoHui"
'    tkOpenSQLServerDB "TekkenStudio", "Tekken", "Tekken", "ainiyisheng"

    
    frmLogin.Show vbModal
'    frmMain.Show

End Sub

Private Sub tkOpenAccessDB( _
        tkFileName As String, _
        Optional tkUserID As String, _
        Optional tkPassword As String _
    )
    
    On Error GoTo tkFinish
    
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & tkFileName & ";" & _
        "Mode=Share Deny None;" & _
        "Extended Properties=;" & _
        "Jet OLEDB:System database=;" & _
        "Jet OLEDB:Registry Path=;" & _
        "Jet OLEDB:Database Password=;" & _
        "Jet OLEDB:Engine Type=5;" & _
        "Jet OLEDB:Database Locking Mode=1;" & _
        "Jet OLEDB:Global Partial Bulk Ops=2;" & _
        "Jet OLEDB:Global Bulk Transactions=1;" & _
        "Jet OLEDB:New Database Password=;" & _
        "Jet OLEDB:Create System Database=False;" & _
        "Jet OLEDB:Encrypt Database=False;" & _
        "Jet OLEDB:Don't Copy Locale on Compact=False;" & _
        "Jet OLEDB:Compact Without Replica Repair=False;" & _
        "Jet OLEDB:SFP=False;" & _
        tkUserID, _
        tkPassword
    
    Exit Sub
tkFinish:
    MsgBox Err.Description
    End
    
End Sub

Private Sub tkOpenSQLServerDB( _
        tkServerName As String, _
        tkDefaultDatabase As String, _
        tkUserID As String, _
        tkPassword As String _
    )

    On Error GoTo tkFinish
    
    cnn.Open "Provider=SQLOLEDB.1;" & _
        "Data Source=" & tkServerName & ";" & _
        "Use Procedure for Prepare=1;" & _
        "Auto Translate=True;" & _
        "Packet Size=4096;" & _
        "Use Encryption for Data=False;" & _
        "Tag with column collation when possible=False", _
        tkUserID, _
        tkPassword
    cnn.DefaultDatabase = tkDefaultDatabase

    Exit Sub
tkFinish:
    MsgBox Err.Description
    End
    
End Sub