-
ADO Cursor/Lock/Concurrency 的测试
ADO Cursor/Lock/Concurrency 的测试
------------------------------------------------------------------------
我个人认为ADO2.0在这方面的表现实在是不好，我看ADO更高的版本会不会比较好 一点。或许，要在SQL7.0之下才会有良好的表现，而我使用的是SQL 6.5与Informix。怎
麽说呢？
注：我终於用有SQL7.0可以Testing了，而且Concurrency的表现不错哦，所以了，如果您想用ADO而且是SQL Server当後端，那就使用Sql7，不要用SQL6.5 我们先看一下Recordset中CursorType的属性
AdOpenForwardOnly 顺向资料指标·
AdOpenKeyset 索引键集 (Keyset) 资料指标·
AdOpenDynamic 动态资料指标·可看到其他使用者所做的增加，变更和删除结果
AdOpenStatic 静态资料指标
以上这一些和RDO的定义没有什麽不同，详见本站 RDO 的建立结果集(一)
然而我也在该篇文章中指出，这些要和Cursor所在的位置与RDBMS都有相关。
RDO中Cursor的位置可分为rdUseODBC(对应ADO的AdUseClient)，rdUseServer(对应ADO的 AdUseServer)，rdUseNone(ADO中没有直接的对应)。
ADO Recordset的CursorLocation = AdUseClient时，只有AdOpenStatic/AdOpenForwardOnly 的CursorType会有作用，其他的二者和AdOpenStatic有相同的效果。如果是AdUseServer 呢，在SQL Server中上述的四种CursorType都可以用，但是RecordSet中的Resync方法只有 在adOpenKeyset的CursorType才能用，AdOpenStatic不能使用。
而RDO中经常使用的rdUseNone的CursorType在ADO中没有相对应的设定，那该如何呢？
那得设定
rs.CursorLocation = AdUseServer
rs.CursorType = AdOpenForwardOnly
rs.LockType = AdLockReadOnly
rs.CacheSize = 1
来取代RDO的rdUseNone，而且注意的是不可使用Client端的Cursor，否则RecordSet Open 的时间会久(因为Client端的Cursor在ADO中都是Static的Cursor而不管我们如何设)。
OpenLink ODBC Driver for Informix又有点不一样，如果使用Server端的Cursor，那
只能设定是AdOpenForwardOnly的CursorType，否则会有意想不到的结果，而使用Client
端的Cursor呢，只有AdOpenStatic/AdOpenForwardOnly二者有效，不过特别的是AdOpenStatic
在这里呢却可以使用Resync的方法，只要说我们的Table有Unique的Key且有Select进来， vb教程便可以用，因为下rs.Resync adAffectCurrent 在Informix 中是以另一个查询当笔资料
的Query来做(如Select * from TableName Where KeyFld=keyvalue)，就因为要Query到
当笔，所以一定要有Unique的Key，否则Resync会有错。
vb教程再来讨论一下Lock
RecordSet的LockType有以下的设定：
adLockReadOnly 预设值。唯读 -- 您无法变更资料。
adLockPessimistic 悲观性锁定，通常会在编辑时立即在资料来源锁定记录。
adLockOptimistic 乐观性锁定，在您呼叫 Update 方法时才锁定。
adLockBatchOptimistic 悲观性批次更新
悲观性批次更新我不讨论，而唯读也够明显了，这都不讨论。基本上SQL6.5用OLEDB Provider
vb教程来连时，只有乐观锁定，SQL7.0後才有悲观锁定。SQL6.5想要有悲观锁定，那就用ODBC
Provider的方式来做吧!RDO悲观锁定基本上在Resultset建立时，便会自动Fetch第一笔，
所以在该笔所在的Page上会有一个Update Lock。而ADO又不太相同，它在Recordset
Open之後并不会自动Fetch第一笔，直到我们想引用它或Move系列指令下达时才会有作
用。
上面的Lock是针对Recordset，也就是以Page/Record为对像，如果想要做Table Exclusive Lock
於SQL6.5 设定SQL指令如下：
Select * from qppfa (TabLockX) Where ....
TabLockX代表会对该Table做Exclusive Lock，不过这种Lock对程式设计没有太多用处，
vb教程因为这种方式的Lock会在Fetch时做Table Lock，一旦Update资料或Transactiont结束後
会令该Lock Release掉，如果没有Transaction，那情况是：Fetch时做Table Lock，Update
後Release Lock，Fetch下一笔时再产生Table Lock，而不是们想像的会一直做Lock。
而Informix的Table Lock则好多，它可以用Lock Table table-name in Exclusive Mode
的指令来做，也就是说我们用Connection物件的Execute方法来执行上述的指令便可。
在SQL Server6.5之下
1.不像RDO2.0 有一个rdConcurLock的设定；虽然ADO有一个adLockPessimistic的
LockType，如果透过OLEDB Provider来做，似乎全不是那一回事，怎麽用，都是乐
观的锁定。除非使用ODBC Privder的方式，才会有悲观锁定。
2.RDO 中如果ProgramA 与 ProgramB 同时指到某一笔Record，而後ProgramA成功
的Update该笔资料且Commit，而ProgramB这时也随即Update该笔资料，这时ProgramB
会收到一个错误讯息，这时只要下
Recordset.Move 0
Recordset.Edit
'设定更改的值
Recordset.Update 便可以重新来做一次
但是ADO呢，我个人认为在Update之後产生错误时，正确的使用方式应是：
(rs as ADODB.Recordset)
rs.CancelUpdate
rs.Resync adAffectCurrent
'set new value for recordset
rs.Update
但实际上会在rs.Resync adAffectCurrent这一行再产生错误，而此时Recordset
的内容却有Refresh成Remote资料库的实际资料内容，好奇怪！我不知道这里是我
的做法有误，还是SQL Server 7.0才能如此，至少SQL Server6.5我失败了。以至
於Update的程式要变成：
cn.BeginTrans
On Error Resume Next
rs!fld1 = "v"
rs.Update
Do While cn.Errors.Count > 0
If cn.Errors(cn.Errors.Count - 1).Number = -2147217887 Then
'-2147217887 代表该Record可能被他人更新了 for Server端Cirsor
ans = MsgBox("资料更新有冲突，是否再试一次", vbYesNo)
If ans = vbYes Then
rs.CancelUpdate
rs.Resync adAffectCurrent '这里也会产生一个error
cn.Errors.Clear
rs!fld1 = "v"
rs.Update
Else
Exit Do
End If
Else
Exit Do
End If
Loop
If cn.Errors.Count = 0 Then
cn.CommitTrans
Else
cn.RollbackTrans
End If
以上程式是rs.CursorLocation = adUseServer 的情况，而用rs.CursorLocation =
adUseClient呢，情况又不太相同，基本上这是不提供rs.Resync方法。这种程式能看吗？
实在不好吧？所以在这里我的建议是，使用OLEDB Provider来连SQL6.5时，最好是同一笔
资料同时间被Update的机率很小，如果发生了，就只好Requery，再想办法指到该笔，再
重新Update，要不就要用上面的方式，再不就产生错误，要使用者再重新执行一次。只要
同时Update的可能性小，可能好几年都不会遇上同时Update的问题。
我们知道在实际的应用上有不少是有可能同时Update同一资料的，例如说，我们用一笔
Record来记录流水号，每个Process要取得该Record流水号的那个栏位之内容，之後加1
再存回去，这种情况在多人使用时就很有可能有同时Update的情况，那我建议使用ODBC
Provider的悲观锁定，不过，仍有些问题，如果以下程式所示，而有两个Process A,B
A执行到rs.MoveFirst後换 B执行到rs.MoveFirst，此时有Dead Lock产生，所以B 会进
入等待，而A 呢，它执行到Update时会产生错误，天!这种程式能用吗？所幸，SQL7不会
有回题。
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
connstr = "Driver={?SQL Server};UID=cww;PWD=jjh5612;Server=OPEN_VIEW;Database=cwwtest"
cn.Provider = "MSDASQL"
cn.ConnectionString = connstr
cn.Open
cn.BeginTrans
sql = "Select * from qppfa where case_no = 'E8701761' and seq BETWEEN 1 AND 5 "
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseServer
rs.Source = sql
rs.Open , cn, adOpenKeyset, adLockPessimistic, adCmdText
rs.MoveFirst '这时候才真的有Update Lock
rs!kind = "v"
rs.Update
cn.CommitTrans
在Informix之下(用OpenLink的ODBC Driver)呢，情况很乱，後来我发现只要使用Client
端的Cursor，问题会减到最少，而且这里有一点十分奇特，OpenLink ODBC Driver允许
我们使用Recordset的Resync方法，不但没有错，而且还会把on-line Database的资料
传回来(这一点和使用RDO 的Client端Cursor不同，和 ADO SQL Server6.5也不同)。
不过这里要特别提出的是Resync adAffectCurrent 只在我们的Table有Unique的Key，
而且这个Key有在我们的Select的范围内才有效。所以，以下是我OpenLink ODBC Driver
解决Update concurrency的方式。特别提出是，在这OpenLink ODBC Driver下使用ADO，
千万不要用Server端的Cursor，会有太多问题(除非是AdOpenForwardOnly)。以下的程式
只可用於OpenLink Informix ODBC Driver，不可用於SQL Server!!
Dim WithEvents cn As ADODB.Connection
Private WithEvents rs As ADODB.Recordset
Private qry As ADODB.Command
Private adoerr As ADODB.Errors
'以下是 update资料库的部份
Private Sub UpdateData()
Dim ans As Integer
cn.Execute "Set lock mode to wait 15" '该设定只对Informix有效
cn.BeginTrans
rs.MoveNext
On Error GoTo errh '设定Update 的错误处理函式
updArea: '设定这一个标记，方便错误函式返回这里做事情
rs!fld1 = "h" '自行更改成update所需的设定
rs.Update '如果Update时产生错误时，则会到errh处处理
cn.CommitTrans
Exit Sub
errh:
Do While cn.Errors.Count > 0
If cn.Errors(cn.Errors.Count - 1).Number = -2147217864 Then
'-2147217864 代表该Record可能被他人更新了 for Client端Cirsor
ans = MsgBox("资料更新有冲突，是否再试一次", vbYesNo)
If ans = vbYes Then
rs.CancelUpdate
rs.Resync adAffectCurrent '重新到Database读取当笔资料
cn.Errors.Clear
Resume updArea '重回资料更新的区域
Else
Exit Do
End If
Else
Exit Do
End If
Loop
MsgBox "Update失败" + vbCrLf + cn.Errors(0).Description, vbCritical
cn.RollbackTrans
End If
End Sub
'开启资料库
Private Sub Form_Load()
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
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"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from testtab order by case_no"
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseClient
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
End Sub
SQL7.0呢，这就很好用了，不管乐观锁定或悲观锁定都有很好的表现，我们先看悲观锁
定：
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
cn.BeginTrans
sql = "Select * from TESTTAB"
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseServer
rs.Source = sql
rs.Open , cn, adOpenKeyset, adLockPessimistic, adCmdText
rs.MoveFirst
rs!f1 = "x"
rs.Update
cn.CommitTrans
这样做，如果同时有两个Process执行完rs.Open，而接着都会执行rs.MoveFirst，这时
只有一个Process会成功，另一个则会进入等待，等到先前的Process Release Lock後
才会再执行，这样子就解决了同时Update一笔资料的问题。唯一要注意的只有等待的
时间若太久则会TimeOut，所以改成以下的方式：
Dim cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atServer, 悲观)
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
rs!f1 = "q"
rs.Update
cn.CommitTrans
End If
'以下在.Bas
Public Enum adCursorLoc
atClient = 0
atServer
End Enum
Public Enum adLockType
唯读且向前 = 0
悲观
乐观
唯读
End Enum
Public Function adoOpenRecordset(Conn As adodb.Connection, Source, _
Optional CursorLoc As adCursorLoc, Optional LockType As adLockType) As adodb.Recordset
Dim rs As adodb.Recordset
Dim tryTimes As Integer
Dim vv As Variant
Set rs = New adodb.Recordset
If LockType = 唯读且向前 Or LockType = 悲观 Then
CursorLoc = atServer
rs.CacheSize = 1
End If
If CursorLoc = atClient Then
LockType = 乐观
End If
If CursorLoc = atServer Then
rs.CursorLocation = adUseServer
Select Case LockType
Case 唯读, 唯读且向前
rs.LockType = adLockReadOnly
Case 悲观
rs.LockType = adLockPessimistic
Case 乐观
rs.LockType = adLockOptimistic
End Select
Else
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
End If
Err.Clear
On Error GoTo errh
If TypeOf Source Is adodb.Command Then
rs.Open Source
Else
rs.Open Source, Conn
End If
vv = rs.Fields(0).Value
Set adoOpenRecordset = rs
Exit Function
errh:
If Err.Number = -2147467259 Then
'Time Out Lock by Others
If tryTimes!<=!2 Then
tryTimes = tryTimes + 1
Err.Clear
Resume
Else
Set adoOpenRecordset = Nothing
End If
Else
Set adoOpenRecordset = Nothing
End If
End Function
如果是乐观锁定呢，如果有Concurrency的错误时，它会在Update时才有错，而我们使用
的方式是先CancelUpdate後再使用Resync AffectCurrent来Refresh Current Record，
而後再把Update的程序再重新执行一次，如下：但要注意的是，要使用Client端的Cursor
要不然，Server端的Cursor是不支援这个Resync Method的
td
Option Explicit
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
cn.CommandTimeout = 5
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atClient, 乐观) '要用Client端Cursor
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
Call UpdateRtn
End If
If Err.Number = 0 Then
cn.CommitTrans
Else
cn.RollbackTrans
End If
End Sub
Private Sub UpdateRtn()
Dim ntx As Integer
On Error Resume Next
Do While True
rs!f1 = "q"
rs.Update
If Err.Number = 0 Then
Exit Do
Else
If Err.Number = -2147217864 Then '发生Concurrency错误
If ntx!<=!2 Then
ntx = ntx + 1
Err.Clear
rs.CancelUpdate
rs.Resync adAffectCurrent '重新Refresh Current Record
Else
Exit Do
End If
Else
Exit Do
End If
End If
Loop
On Error GoTo 0
End Sub
------------------------------------------------------------------------
我个人认为ADO2.0在这方面的表现实在是不好，我看ADO更高的版本会不会比较好 一点。或许，要在SQL7.0之下才会有良好的表现，而我使用的是SQL 6.5与Informix。怎
麽说呢？
注：我终於用有SQL7.0可以Testing了，而且Concurrency的表现不错哦，所以了，如果您想用ADO而且是SQL Server当後端，那就使用Sql7，不要用SQL6.5 我们先看一下Recordset中CursorType的属性
AdOpenForwardOnly 顺向资料指标·
AdOpenKeyset 索引键集 (Keyset) 资料指标·
AdOpenDynamic 动态资料指标·可看到其他使用者所做的增加，变更和删除结果
AdOpenStatic 静态资料指标
以上这一些和RDO的定义没有什麽不同，详见本站 RDO 的建立结果集(一)
然而我也在该篇文章中指出，这些要和Cursor所在的位置与RDBMS都有相关。
RDO中Cursor的位置可分为rdUseODBC(对应ADO的AdUseClient)，rdUseServer(对应ADO的 AdUseServer)，rdUseNone(ADO中没有直接的对应)。
ADO Recordset的CursorLocation = AdUseClient时，只有AdOpenStatic/AdOpenForwardOnly 的CursorType会有作用，其他的二者和AdOpenStatic有相同的效果。如果是AdUseServer 呢，在SQL Server中上述的四种CursorType都可以用，但是RecordSet中的Resync方法只有 在adOpenKeyset的CursorType才能用，AdOpenStatic不能使用。
而RDO中经常使用的rdUseNone的CursorType在ADO中没有相对应的设定，那该如何呢？
那得设定
rs.CursorLocation = AdUseServer
rs.CursorType = AdOpenForwardOnly
rs.LockType = AdLockReadOnly
rs.CacheSize = 1
来取代RDO的rdUseNone，而且注意的是不可使用Client端的Cursor，否则RecordSet Open 的时间会久(因为Client端的Cursor在ADO中都是Static的Cursor而不管我们如何设)。
OpenLink ODBC Driver for Informix又有点不一样，如果使用Server端的Cursor，那
只能设定是AdOpenForwardOnly的CursorType，否则会有意想不到的结果，而使用Client
端的Cursor呢，只有AdOpenStatic/AdOpenForwardOnly二者有效，不过特别的是AdOpenStatic
在这里呢却可以使用Resync的方法，只要说我们的Table有Unique的Key且有Select进来， vb教程便可以用，因为下rs.Resync adAffectCurrent 在Informix 中是以另一个查询当笔资料
的Query来做(如Select * from TableName Where KeyFld=keyvalue)，就因为要Query到
当笔，所以一定要有Unique的Key，否则Resync会有错。
vb教程再来讨论一下Lock
RecordSet的LockType有以下的设定：
adLockReadOnly 预设值。唯读 -- 您无法变更资料。
adLockPessimistic 悲观性锁定，通常会在编辑时立即在资料来源锁定记录。
adLockOptimistic 乐观性锁定，在您呼叫 Update 方法时才锁定。
adLockBatchOptimistic 悲观性批次更新
悲观性批次更新我不讨论，而唯读也够明显了，这都不讨论。基本上SQL6.5用OLEDB Provider
vb教程来连时，只有乐观锁定，SQL7.0後才有悲观锁定。SQL6.5想要有悲观锁定，那就用ODBC
Provider的方式来做吧!RDO悲观锁定基本上在Resultset建立时，便会自动Fetch第一笔，
所以在该笔所在的Page上会有一个Update Lock。而ADO又不太相同，它在Recordset
Open之後并不会自动Fetch第一笔，直到我们想引用它或Move系列指令下达时才会有作
用。
上面的Lock是针对Recordset，也就是以Page/Record为对像，如果想要做Table Exclusive Lock
於SQL6.5 设定SQL指令如下：
Select * from qppfa (TabLockX) Where ....
TabLockX代表会对该Table做Exclusive Lock，不过这种Lock对程式设计没有太多用处，
vb教程因为这种方式的Lock会在Fetch时做Table Lock，一旦Update资料或Transactiont结束後
会令该Lock Release掉，如果没有Transaction，那情况是：Fetch时做Table Lock，Update
後Release Lock，Fetch下一笔时再产生Table Lock，而不是们想像的会一直做Lock。
而Informix的Table Lock则好多，它可以用Lock Table table-name in Exclusive Mode
的指令来做，也就是说我们用Connection物件的Execute方法来执行上述的指令便可。
在SQL Server6.5之下
1.不像RDO2.0 有一个rdConcurLock的设定；虽然ADO有一个adLockPessimistic的
LockType，如果透过OLEDB Provider来做，似乎全不是那一回事，怎麽用，都是乐
观的锁定。除非使用ODBC Privder的方式，才会有悲观锁定。
2.RDO 中如果ProgramA 与 ProgramB 同时指到某一笔Record，而後ProgramA成功
的Update该笔资料且Commit，而ProgramB这时也随即Update该笔资料，这时ProgramB
会收到一个错误讯息，这时只要下
Recordset.Move 0
Recordset.Edit
'设定更改的值
Recordset.Update 便可以重新来做一次
但是ADO呢，我个人认为在Update之後产生错误时，正确的使用方式应是：
(rs as ADODB.Recordset)
rs.CancelUpdate
rs.Resync adAffectCurrent
'set new value for recordset
rs.Update
但实际上会在rs.Resync adAffectCurrent这一行再产生错误，而此时Recordset
的内容却有Refresh成Remote资料库的实际资料内容，好奇怪！我不知道这里是我
的做法有误，还是SQL Server 7.0才能如此，至少SQL Server6.5我失败了。以至
於Update的程式要变成：
cn.BeginTrans
On Error Resume Next
rs!fld1 = "v"
rs.Update
Do While cn.Errors.Count > 0
If cn.Errors(cn.Errors.Count - 1).Number = -2147217887 Then
'-2147217887 代表该Record可能被他人更新了 for Server端Cirsor
ans = MsgBox("资料更新有冲突，是否再试一次", vbYesNo)
If ans = vbYes Then
rs.CancelUpdate
rs.Resync adAffectCurrent '这里也会产生一个error
cn.Errors.Clear
rs!fld1 = "v"
rs.Update
Else
Exit Do
End If
Else
Exit Do
End If
Loop
If cn.Errors.Count = 0 Then
cn.CommitTrans
Else
cn.RollbackTrans
End If
以上程式是rs.CursorLocation = adUseServer 的情况，而用rs.CursorLocation =
adUseClient呢，情况又不太相同，基本上这是不提供rs.Resync方法。这种程式能看吗？
实在不好吧？所以在这里我的建议是，使用OLEDB Provider来连SQL6.5时，最好是同一笔
资料同时间被Update的机率很小，如果发生了，就只好Requery，再想办法指到该笔，再
重新Update，要不就要用上面的方式，再不就产生错误，要使用者再重新执行一次。只要
同时Update的可能性小，可能好几年都不会遇上同时Update的问题。
我们知道在实际的应用上有不少是有可能同时Update同一资料的，例如说，我们用一笔
Record来记录流水号，每个Process要取得该Record流水号的那个栏位之内容，之後加1
再存回去，这种情况在多人使用时就很有可能有同时Update的情况，那我建议使用ODBC
Provider的悲观锁定，不过，仍有些问题，如果以下程式所示，而有两个Process A,B
A执行到rs.MoveFirst後换 B执行到rs.MoveFirst，此时有Dead Lock产生，所以B 会进
入等待，而A 呢，它执行到Update时会产生错误，天!这种程式能用吗？所幸，SQL7不会
有回题。
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
connstr = "Driver={?SQL Server};UID=cww;PWD=jjh5612;Server=OPEN_VIEW;Database=cwwtest"
cn.Provider = "MSDASQL"
cn.ConnectionString = connstr
cn.Open
cn.BeginTrans
sql = "Select * from qppfa where case_no = 'E8701761' and seq BETWEEN 1 AND 5 "
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseServer
rs.Source = sql
rs.Open , cn, adOpenKeyset, adLockPessimistic, adCmdText
rs.MoveFirst '这时候才真的有Update Lock
rs!kind = "v"
rs.Update
cn.CommitTrans
在Informix之下(用OpenLink的ODBC Driver)呢，情况很乱，後来我发现只要使用Client
端的Cursor，问题会减到最少，而且这里有一点十分奇特，OpenLink ODBC Driver允许
我们使用Recordset的Resync方法，不但没有错，而且还会把on-line Database的资料
传回来(这一点和使用RDO 的Client端Cursor不同，和 ADO SQL Server6.5也不同)。
不过这里要特别提出的是Resync adAffectCurrent 只在我们的Table有Unique的Key，
而且这个Key有在我们的Select的范围内才有效。所以，以下是我OpenLink ODBC Driver
解决Update concurrency的方式。特别提出是，在这OpenLink ODBC Driver下使用ADO，
千万不要用Server端的Cursor，会有太多问题(除非是AdOpenForwardOnly)。以下的程式
只可用於OpenLink Informix ODBC Driver，不可用於SQL Server!!
Dim WithEvents cn As ADODB.Connection
Private WithEvents rs As ADODB.Recordset
Private qry As ADODB.Command
Private adoerr As ADODB.Errors
'以下是 update资料库的部份
Private Sub UpdateData()
Dim ans As Integer
cn.Execute "Set lock mode to wait 15" '该设定只对Informix有效
cn.BeginTrans
rs.MoveNext
On Error GoTo errh '设定Update 的错误处理函式
updArea: '设定这一个标记，方便错误函式返回这里做事情
rs!fld1 = "h" '自行更改成update所需的设定
rs.Update '如果Update时产生错误时，则会到errh处处理
cn.CommitTrans
Exit Sub
errh:
Do While cn.Errors.Count > 0
If cn.Errors(cn.Errors.Count - 1).Number = -2147217864 Then
'-2147217864 代表该Record可能被他人更新了 for Client端Cirsor
ans = MsgBox("资料更新有冲突，是否再试一次", vbYesNo)
If ans = vbYes Then
rs.CancelUpdate
rs.Resync adAffectCurrent '重新到Database读取当笔资料
cn.Errors.Clear
Resume updArea '重回资料更新的区域
Else
Exit Do
End If
Else
Exit Do
End If
Loop
MsgBox "Update失败" + vbCrLf + cn.Errors(0).Description, vbCritical
cn.RollbackTrans
End If
End Sub
'开启资料库
Private Sub Form_Load()
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
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"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from testtab order by case_no"
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseClient
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
End Sub
SQL7.0呢，这就很好用了，不管乐观锁定或悲观锁定都有很好的表现，我们先看悲观锁
定：
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
cn.BeginTrans
sql = "Select * from TESTTAB"
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.CursorLocation = adUseServer
rs.Source = sql
rs.Open , cn, adOpenKeyset, adLockPessimistic, adCmdText
rs.MoveFirst
rs!f1 = "x"
rs.Update
cn.CommitTrans
这样做，如果同时有两个Process执行完rs.Open，而接着都会执行rs.MoveFirst，这时
只有一个Process会成功，另一个则会进入等待，等到先前的Process Release Lock後
才会再执行，这样子就解决了同时Update一笔资料的问题。唯一要注意的只有等待的
时间若太久则会TimeOut，所以改成以下的方式：
Dim cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atServer, 悲观)
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
rs!f1 = "q"
rs.Update
cn.CommitTrans
End If
'以下在.Bas
Public Enum adCursorLoc
atClient = 0
atServer
End Enum
Public Enum adLockType
唯读且向前 = 0
悲观
乐观
唯读
End Enum
Public Function adoOpenRecordset(Conn As adodb.Connection, Source, _
Optional CursorLoc As adCursorLoc, Optional LockType As adLockType) As adodb.Recordset
Dim rs As adodb.Recordset
Dim tryTimes As Integer
Dim vv As Variant
Set rs = New adodb.Recordset
If LockType = 唯读且向前 Or LockType = 悲观 Then
CursorLoc = atServer
rs.CacheSize = 1
End If
If CursorLoc = atClient Then
LockType = 乐观
End If
If CursorLoc = atServer Then
rs.CursorLocation = adUseServer
Select Case LockType
Case 唯读, 唯读且向前
rs.LockType = adLockReadOnly
Case 悲观
rs.LockType = adLockPessimistic
Case 乐观
rs.LockType = adLockOptimistic
End Select
Else
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
End If
Err.Clear
On Error GoTo errh
If TypeOf Source Is adodb.Command Then
rs.Open Source
Else
rs.Open Source, Conn
End If
vv = rs.Fields(0).Value
Set adoOpenRecordset = rs
Exit Function
errh:
If Err.Number = -2147467259 Then
'Time Out Lock by Others
If tryTimes!<=!2 Then
tryTimes = tryTimes + 1
Err.Clear
Resume
Else
Set adoOpenRecordset = Nothing
End If
Else
Set adoOpenRecordset = Nothing
End If
End Function
如果是乐观锁定呢，如果有Concurrency的错误时，它会在Update时才有错，而我们使用
的方式是先CancelUpdate後再使用Resync AffectCurrent来Refresh Current Record，
而後再把Update的程序再重新执行一次，如下：但要注意的是，要使用Client端的Cursor
要不然，Server端的Cursor是不支援这个Resync Method的
td
Option Explicit
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim ans As Integer, errstr As String, sql As String
Set cn = New ADODB.Connection
connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
cn.CommandTimeout = 5
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atClient, 乐观) '要用Client端Cursor
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
Call UpdateRtn
End If
If Err.Number = 0 Then
cn.CommitTrans
Else
cn.RollbackTrans
End If
End Sub
Private Sub UpdateRtn()
Dim ntx As Integer
On Error Resume Next
Do While True
rs!f1 = "q"
rs.Update
If Err.Number = 0 Then
Exit Do
Else
If Err.Number = -2147217864 Then '发生Concurrency错误
If ntx!<=!2 Then
ntx = ntx + 1
Err.Clear
rs.CancelUpdate
rs.Resync adAffectCurrent '重新Refresh Current Record
Else
Exit Do
End If
Else
Exit Do
End If
End If
Loop
On Error GoTo 0
End Sub
最新更新
nodejs爬虫
Python正则表达式完全指南
爬取豆瓣Top250图书数据
shp 地图文件批量添加字段
爬虫小试牛刀（爬取学校通知公告）
【python基础】函数-初识函数
【python基础】函数-返回值
HTTP请求：requests模块基础使用必知必会
Python初学者友好丨详解参数传递类型
如何有效管理爬虫流量？
2个场景实例讲解GaussDB(DWS)基表统计信息估
常用的 SQL Server 关键字及其含义
动手分析SQL Server中的事务中使用的锁
openGauss内核分析：SQL by pass & 经典执行
一招教你如何高效批量导入与更新数据
天天写SQL，这些神奇的特性你知道吗？
openGauss内核分析：执行计划生成
[IM002]Navicat ODBC驱动器管理器 未发现数据
初入Sql Server 之 存储过程的简单使用
SQL Server -- 解决存储过程传入参数作为s
JavaScript判断两个数组相等的四类方法
js如何操作video标签
React实战--利用甘特图和看板，强化Paas平
【记录】正则替换的偏方
前端下载 Blob 类型整理
抽象语法树AST必知必会
关于JS定时器的整理
JS中使用Promise.all控制所有的异步请求都完
js中字符串的方法
import-local执行流程与node模块路径解析流程
