dim cn as adodb.connect
dim rscn as adodb.recordset
dim connectstring as string
connectstring="driver={SQLSERVER};server=serverip;uid=sa;pwd=;database=userdatabase"
cn.open connectstring
Public Function OpenConnection() As String '打开数据库
On Error GoTo SQLConErr
With adoCN
.CursorLocation = adUseClient
.Provider = "sqloledb"
.Properties("Data Source").Value = cNtServerName
.Properties("Initial Catalog").Value = cDatabaseName
.Properties("User ID") = cSQLUserName
.Properties("Password") = cSQLPassword
.Properties("prompt") = adPromptNever
.ConnectionTimeout = 15
.Open
If .State = adStateOpen Then
adoDateTime.Open "select getdate()", adoCN, adOpenStatic, adLockOptimistic
cServerDate = Format(adoDateTime(0), "yyyy-mm-dd")
cServertime = Mid(adoDateTime(0), 10)
Else
MsgBox "数据库连接失败,请找系统管理员进行检查 !", 16, cProgramName
End
End If
End With
SqlCommand.ActiveConnection = adoCN
SqlCommand.CommandType = adCmdText
Exit Function
SQLConErr:
Select Case Err.Number
Case -2147467259
MsgBox "找不到指定的SQL Server服务器或者数据库不存在,请重新设置!", vbExclamation
F_SetSystem.Show 1
Case -2147217843
MsgBox "指定的SQL Server数据库用户不存在或口令错误,请重新设置!", vbExclamation
F_SetSystem.Show 1
Case Else
MsgBox "数据环境连接失败,请找系统管理员进行检查 !", 16, cProgramName
End Select
OpenConnection
End Function
'==============================================================================
'初始化数据环境
'==============================================================================
Function IniDataEnviroment(ByVal sServerNm As String, ByVal sDbNm As String, _
ByVal sUser As String, ByVal sPwd As String) As Long
Dim con As Connection
Dim sConnection As String
On Error GoTo Err_
'打开数据连接、验证
'==============================
For Each con In DE.Connections
With con
.CursorLocation = adUseClient
sConnection = " Provider=SQLOLEDB.1; "
'如果提供了用户名不是用集成安全特性
'==================================
If Trim(sUser) <> "" Then
sConnection = sConnection & " Integrated Security=; "
sConnection = sConnection & " Persist Security Info=FALSE; "
sConnection = sConnection & " Use Procedure for Prepare=1; "
Else
sConnection = sConnection & " Integrated Security=SSPI; "
sConnection = sConnection & " Persist Security Info=False; "
sConnection = sConnection & " Use Procedure for Prepare=1; "
End If