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 
|