module1.bas

朋友fdsfdsafdsafsafsa推荐的vb连接sql

Attribute VB_Name = "Module1"
'Option Explicit

'声明公有函数GetPrivateProfileString以读取ini文件的内容
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
'声明公有函数WritePrivateProfileString以写入ini文件的内容
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

Public Consb As New ADODB.Connection 'ConSb为打开的活动的连接
Public Rsbdata As New ADODB.Recordset '为操作连接
Public Rsbdata_01 As New ADODB.Recordset '为临时连接


'数据库连接处理
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ConnectSybase(sr, db, us, pd, bs) As Boolean

    On Error GoTo ErrMsg
    
    '判断数据库是否已经打开 如果打开则先关闭
    If Consb.State = adStateOpen Then
        Consb.Close
    End If
    
    

    Dim strConnect As String
    Consb.ConnectionTimeout = 3
    
    If bs = 0 Then
    '-------------------------------
    '连接SQL数据库
    strConnect = "Provider=SQLOLEDB.1;Data Source=" & sr & ";Persist Security Info=True;User ID=" & us & ";Password=" & pd & ";Initial Catalog=" & db
    Consb.Open strConnect
    '-------------------------------
    '通过下句与ODBC数据源进行连接，不需用户选择数据源
    'strConnect = "Provider=MSDASQL.1;Persist Security Info=False;" & " Extended Properties='DSN=chs;SRVR=zb;DB=zbserver;UID=sa2;PWD=abacus'"
    '-------------------------------
    Else
    '连接sybase数据库
    strConnect = "Provider=MSDASQL.1;DRIVER={Sybase System 11};Persist Security Info=False;DSN=; SRVR=" & sr & ";DB=" & db & ";UID=" & us & ";PWD=" & pd
    Consb.Open strConnect
    '-------------------------------
    End If
    '注意：如果你不想建立DSN,可采取无DSN连接方法如下：
    '将上句改为 strConnect = "Provider=MSDASQL.1;DRIVER={Sybase System 11};Persist Security Info=False;DSN=; SRVR=服务器IP;DB=数据库;UID=用户名;PWD=密码"
    'Persist Security是否采用集成安全机制
    ConnectSybase = True
    Exit Function
ErrMsg:
    MsgBox "连接数据库错误!请确认服务器是否开启.", 16
    ConnectSybase = False
    
End Function


'语句处理
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function USESQL(Index, sql) As Boolean

'执行语句

        '判断记录集是否已经打开 如果打开则先关闭
    If Rsbdata.State = adStateOpen Then
        Rsbdata.Close
    End If
    
    
    On Error GoTo ErrMsg
       
    Dim strSQL As String
    
        strSQL = sql '"Select * from gds0" 'strSQL可以是SQL语句（块），存储过程
        Rsbdata.CursorLocation = adUseClient
        Rsbdata.Open strSQL, Consb 'ConSb为打开的活动的连接
    
    USESQL = True
    Exit Function
    
ErrMsg:
    MsgBox "语句执行失败!" & strSQL, 16
    USESQL = False
    


End Function