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 $#@60; 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的
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 $#@60;
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
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
