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
关键词：一个离线ADO数据管理模块的完成