一个离线ADO数据管理模块的实现

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

原文转自：http://www.ltesting.net