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

作者：来源：添加时间：2006-5-21 19:36:46

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

上一篇： Edit Method
下一篇：asp.net中将Excel文件(.xls)绑定到DataGrid

站内搜索