ADO设定独占性的资料库

领测软件测试网

　　 
　　在Informix之下设定独占性的资料库比较简单，主要就是以下指令

DATABASE database-name EXCLUSIVE
以下FUNCTION是Informix 开启独占资料库的方式
'************************************************************
'DbNmae 待开启的资料库

'UserID User ID
'PassWD User Password
'ExclusiveMode True表示以独占方式开启
'ErrDescription 如果开启过程有错，传回错误描述
'传回值:一个ADBDB.Connection物件，有错时传回Nothing
'*************************************************************
Public Function OpenConnection(ByVal DbName As String, ByVal UserID As String, _
ByVal PassWD As String, ByVal ExclusiveMode, ErrDescription As String) As ADODB.Connection
Dim curConn As New ADODB.Connection, connstr As String
curConn.Provider = "MSDASQL"
connstr = "UID=" + UserID + ";PWD=" + PassWD + ";Database=" + DbName
connstr = connstr + _
";Driver={OpenLink Generic 32 Bit Driver};" _
+ "Host=192.168.0.61;" _
+ ";FetchBufferSize=30" _
+ ";NoLoginBox=Yes" _
+ ";Options=" _
+ ";Protocol=TCP/IP" _
+ ";ReadOnly=No" _
+ ";ServerOptions=" _
+ ";ServerType=Informix 7.2"

curConn.ConnectionString = connstr
On Error GoTo errh:
curConn.Open
If ExclusiveMode Then
curConn.Execute "DATABASE " + DbName + " EXCLUSIVE"
End If
ErrDescription = ""
Set OpenConnection = curConn
Exit Function
errh:
If curConn.State = adStateOpen Then
curConn.Close
End If
ErrDescription = Err.Description
Set curConn = Nothing
End Function

使用方式

Set cn = OpenConnection("cwwpf@eis", "cww", "jjh5612", True, Errstr)
If cn Is Nothing Then
MsgBox Errstr
End If
而SQL Server就没有那样容易，我们知道有一个system stored procedure

SP_DBOPTION database-name, 'Single User', TRUE '设定Single User Mode
SP_DBOPTION database-name, 'Single User', FALSE '设定Multi User Mode

不过这里有许多点要注意：
1.必需是sa才有权
2.透过OLEDB Provider来做时不会成功(for SQL 6.5)
3.如下面的范例中，虽我们成功的设定了 Single User Mode，但不表示我们接下来
的建立连线会成功。说不定在设为单一使用者後，还来不及建立另外的连线时，就
有其他的Process先进入该资料库。
4.我曾经使用同一个Connection先将DataBase设为Single User Mode而後再以该Connection
来开启资料库，Open Recordset，但是有时会发生问题，因而没有Release出来

SetOK = SetSingleUserMode("cwwtest", False, Errstr)
If SetOK Then
Debug.Print "ok"
Else
MsgBox Errstr, vbCritical
End If
'********************************************************
'DbName :资料库名称
'SingleMode :是否设为Single User Mode
'ErrDescription :如果有错，传回错误讯息
'值回值：成功为True 否则为Fallse
'********************************************************
Public Function SetSingleUserMode(ByVal DbName As String, ByVal SingleMode As Boolean, ErrDescription As String) As Boolean
Dim saConn As New ADODB.Connection
Dim connstr As String
Dim cmd3 As New ADODB.Command
Dim Param As ADODB.Parameter

connstr = "Driver={SQL Server};UID=sa;PWD=jjh5612;Server=OPEN_VIEW;Database=master"
saConn.Provider = "MSDASQL"
'connstr = "Data Source=OPEN_VIEW;User=sa;Password=jjh5612;Initial Catalog=master"
'saConn.Provider = "SQLOLEDB"
saConn.ConnectionString = connstr
saConn.Open
Set cmd3 = New ADODB.Command
cmd3.CommandText = "sp_dboption ?, 'Single User', ?"
cmd3.CommandType = adCmdText
Set Param = cmd3.CreateParameter("ParaDBName", adBSTR, adParamInput)
cmd3.Parameters.Append Param
Set Param = cmd3.CreateParameter("ParaSingleMode", adBSTR, adParamInput)
cmd3.Parameters.Append Param
cmd3.Parameters(0).Value = DbName
If SingleMode Then
cmd3.Parameters(1).Value = "True"
Else
cmd3.Parameters(1).Value = "False"
End If
Set cmd3.ActiveConnection = saConn
On Error GoTo errh
cmd3.Execute
ErrDescription = ""
SetSingleUserMode = True
saConn.Close
Exit Function
errh:
ErrDescription = Err.Description
SetSingleUserMode = False
saConn.Close
End Function

文章来源于领测软件测试网 https://www.ltesting.net/