一个离线ADO数据管理模块的实现
日期：2012-08-23 浏览次数：20724 次
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
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
免责声明： 本文仅代表作者个人观点，与爱易网无关。其原创性以及文中陈述文字和内容未经本站证实，对本文以及其中全部或者部分内容、文字的真实性、完整性、及时性本站不作任何保证或承诺，请读者仅作参考，并请自行核实相关内容。
