ADO设定独占性的资料库

在Informix之下设定独占性的资料库比较简单，主要就是以下指令
　　
　　DATABASEdatabase-nameEXCLUSIVE
　　以下FUNCTION是Informix开启独占资料库的方式
　　'************************************************************
　　'DbNmae待开启的资料库
　　'UserIDUserID
　　'PassWDUserPassword
　　'ExclusiveModeTrue表示以独占方式开启
　　'ErrDescription如果开启过程有错，传回错误描述
　　'传回值:一个ADBDB.Connection物件，有错时传回Nothing
　　'*************************************************************
　　PublicFunctionOpenConnection(ByValDbNameAsString,ByValUserIDAsString,_
　　ByValPassWDAsString,ByValExclusiveMode,ErrDescriptionAsString)AsADODB.Connection
　　DimcurConnAsNewADODB.Connection,connstrAsString
　　curConn.Provider="MSDASQL"
　　connstr="UID=" UserID ";PWD=" PassWD ";Database=" DbName
　　connstr=connstr _
　　";Driver={OpenLinkGeneric32BitDriver};"_
　　 "Host=192.168.0.61;"_
　　 ";FetchBufferSize=30"_
　　 ";NoLoginBox=Yes"_
　　 ";Options="_
　　 ";Protocol=TCP/IP"_
　　 ";ReadOnly=No"_
　　 ";ServerOptions="_
　　 ";ServerType=Informix7.2"
　　
　　curConn.ConnectionString=connstr
　　OnErrorGoToerrh:
　　curConn.Open
　　IfExclusiveModeThen
　　curConn.Execute"DATABASE" DbName "EXCLUSIVE"
　　EndIf
　　ErrDescription=""
　　SetOpenConnection=curConn
　　ExitFunction
　　errh:
　　IfcurConn.State=adStateOpenThen
　　curConn.Close
　　EndIf
　　ErrDescription=Err.Description
　　SetcurConn=Nothing
　　EndFunction
　　
　　使用方式
　　
　　Setcn=OpenConnection("cwwpf@eis","cww","jjh5612",True,Errstr)
　　IfcnIsNothingThen
　　MsgBoxErrstr
　　EndIf
　　而SQLServer就没有那样容易，我们知道有一个systemstoredprocedure
　　
　　SP_DBOPTIONdatabase-name,'SingleUser',TRUE'设定SingleUserMode
　　SP_DBOPTIONdatabase-name,'SingleUser',FALSE'设定MultiUserMode
　　
　　不过这里有许多点要注意：
　　1.必需是sa才有权
　　2.透过OLEDBProvider来做时不会成功(forSQL6.5)
　　3.如下面的范例中，虽我们成功的设定了SingleUserMode，但不表示我们接下来
　　的建立连线会成功。说不定在设为单一使用者後，还来不及建立另外的连线时，就
　　有其他的Process先进入该资料库。
　　4.我曾经使用同一个Connection先将DataBase设为SingleUserMode而後再以该Connection
　　来开启资料库，OpenRecordset，但是有时会发生问题，因而没有Release出来
　　
　　SetOK=SetSingleUserMode("cwwtest",False,Errstr)
　　IfSetOKThen
　　Debug.Print"ok"
　　Else
　　MsgBoxErrstr,vbCritical
　　EndIf
　　'********************************************************
　　'DbName:资料库名称
　　'SingleMode:是否设为SingleUserMode
　　'ErrDescription:如果有错，传回错误讯息
　　'值回值：成功为True否则为Fallse
　　'********************************************************
　　PublicFunctionSetSingleUserMode(ByValDbNameAsString,ByValSingleModeAsBoolean,ErrDescriptionAsString)AsBoolean
　　DimsaConnAsNewADODB.Connection
　　DimconnstrAsString
　　Dimcmd3AsNewADODB.Command
　　DimParamAsADODB.Parameter
　　
　　connstr="Driver={SQLServer};UID=sa;PWD=jjh5612;Server=OPEN_VIEW;Database=master"
　　saConn.Provider="MSDASQL"
　　'connstr="DataSource=OPEN_VIEW;User=sa;Password=jjh5612;InitialCatalog=master"
　　'saConn.Provider="SQLOLEDB"
　　saConn.ConnectionString=connstr
　　saConn.Open
　　Setcmd3=NewADODB.Command
　　cmd3.CommandText="sp_dboption?,'SingleUser',?"
　　cmd3.CommandType=adCmdText
　　SetParam=cmd3.CreateParameter("ParaDBName",adBSTR,adParamInput)
　　cmd3.Parameters.AppendParam
　　SetParam=cmd3.CreateParameter("ParaSingleMode",adBSTR,adParamInput)
　　cmd3.Parameters.AppendParam
　　cmd3.Parameters(0).Value=DbName
　　IfSingleModeThen
　　cmd3.Parameters(1).Value="True"
　　Else
　　cmd3.Parameters(1).Value="False"
　　EndIf
　　Setcmd3.ActiveConnection=saConn
　　OnErrorGoToerrh
　　cmd3.Execute
　　ErrDescription=""
　　SetSingleUserMode=True
　　saConn.Close
　　ExitFunction
　　errh:
　　ErrDescription=Err.Description
　　SetSingleUserMode=False
　　saConn.Close
　　EndFunction->