作者：未知 来源：月光软件站 加入时间：2005-6-5　月光软件站

　　Option Explicit
　　Public pubcn As New ADODB.Connection
　　Dim temp_i As Integer
　　''连接数据库
　　Public Sub GetConnect()
　　   
　　    On Error GoTo errorhandler:
　　    Dim constr As String
　　    If Not (pubcn.State = 0) Then
　　        pubcn.Close
　　    End If
　　       
　　    pubcn.CursorLocation = adUseClient
　　    pubcn.ConnectionTimeout = 5
　　    pubcn.Open "Provider=sqloledb;" & _
　　           "Network Library=DBMSSOCN;" & _'指明采用IP+端口方式查找Sql Server
　　           "Data Source=172.17.21.125,1433;" & _
　　           "Initial Catalog=hpdata;" & _
　　           "User ID=user;" & _
　　           "Password=password;" & _
　　           "Encrypt=yes"
　　          
　　    pubcn.DefaultDatabase = "hpdata" ''!!!!!!!!!!!!!!!!
　　    Exit Sub
　　errorhandler:
　　    Dim msg As Integer
　　    msg = MsgBox("连接时发生错误:" & Err.Number & Err.Description & Err.Source & "请将此信息发至邮箱", vbOKOnly)
　　
　　End Sub
　　
　　''简单查询得到数据集////////////////////////////////////////////////////////
　　Public Function GetRS(sqlstr As String) As ADODB.Recordset
　　   
　　    On Error GoTo errorhandler
　　    Call GetConnect
　　   
　　    Set GetRS = New ADODB.Recordset
　　   
　　    GetRS.Open sqlstr, pubcn, adOpenStatic, adLockOptimistic
　　   
　　    Set GetRS.ActiveConnection = Nothing
　　   
　　    pubcn.Close
　　    Exit Function
　　errorhandler:
　　    Dim i As Integer
　　    i = MsgBox(sqlstr & ":::::::" & Err.Description & Err.HelpContext, vbOKCancel)
　　
　　End Function
　　'同步数据集
　　Public Sub UpdateRS(Rs As ADODB.Recordset, Optional RequerryFlag As Integer)
　　    Call GetConnect
　　   
　　    With Rs
　　        .ActiveConnection = pubcn
　　        .Update
　　        'If (Not IsMissing(RequerryFlag)) And RequerryFlag = 1 Then ''改于2004年2月6日为修除历史记录本客户号查询的修改无法数据同步而设
　　           ' .Requery
　　        'End If
　　        .ActiveConnection = Nothing
　　    End With
　　       
　　    pubcn.Close
　　
　　End Sub
　　'执行带有参数对象的查询得到数据集
　　Public Sub GetRSFromCmd(Cmd As ADODB.Command, str As String, Rs As ADODB.Recordset)
　　   
　　    On Error GoTo errorhandler
　　    Call GetConnect
　　    If Not (Cmd.State = adStateClosed) Then
　　        Cmd.Cancel
　　        Cmd.ActiveConnection = Nothing
　　    End If
　　    With Cmd
　　        .ActiveConnection = pubcn
　　        .CommandTimeout = 5
　　        .CommandType = adCmdText
　　        .CommandText = str
　　    End With
　　    If Not (Rs.State = 0) Then
　　        Rs.Close
　　    End If
　　    Rs.Open Cmd, , adOpenStatic, adLockOptimistic
　　  
　　    Rs.ActiveConnection = Nothing
　　   
　　    With Cmd
　　        .ActiveConnection = Nothing
　　    End With
　　    pubcn.Close
　　    Exit Sub
　　errorhandler:
　　    temp_i = MsgBox(str & Err.Number & Err.Description & Err.Source, vbOKOnly)
　　   
　　End Sub

       '执行无返回结果的sql语句      

　　Public Sub CnExecute(ByVal Qstr As String, ByRef RecordNumber As Long, Optional QRs As ADODB.Recordset)
　　    'On Error GoTo errorhandler
　　   
　　    Call GetConnect
　　    pubcn.Execute Qstr, RecordNumber, adExecuteNoRecords
　　   
　　    If IsMissing(QRs) Then
　　    QRs.ActiveConnection = pubcn
　　    QRs.Requery
　　    QRs.ActiveConnection = Nothing
　　    End If
　　    pubcn.Close
　　errorhandler:
　　   temp_i = MsgBox(Qstr & Err.Number & Err.Description, vbOKOnly)
　　
　　End Sub

相关软件：