conndatabase.bas

来自「采用最新的XP类模块」· BAS 代码 · 共 58 行

Attribute VB_Name = "conndatabase"
Public cnn As New ADODB.Connection
Public cg1 As New ADODB.Recordset
Public cg2 As New ADODB.Recordset
Public cg3 As New ADODB.Recordset
Public cg4 As New ADODB.Recordset
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long


Sub Main()
tkOpenAccessDB App.Path & "\drilling.mdb"
If cg1.State = adStateOpen Then  '表状态
cg1.Close
End If
cg1.Open "select * from admin ", cnn, adOpenStatic, adLockReadOnly, adCmdText
If cg1.RecordCount = 0 Then
Set cg1 = cnn.Execute("insert into admin values('admin','admin','1','1','1','1','1')")
End If
frmLogin.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