ADO 的测试(3)

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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有