ADO Update Concurrency的测试

我个人认为ADO2.0在这方面的表现实在是不好，我看ADO更高的版本会不会比较好
一点。或许，要在SQL7.0之下才会有良好的表现，而我使用的是SQL 6.5与Informix。怎
麽说呢？

在SQL Server6.5之下
  1.不像RDO2.0 有一个rdConcurLock的设定；虽然ADO有一个adLockPessimistic的
    LockType，不过似乎全不是那一回事，怎麽用，都像是乐观的锁定。
  2.我设定Connection物件的IsolationLevel，也没有作用
  3.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方法。

在Informix之下(用OpenLink的ODBC Driver)呢，情况很乱，後来我发现只要使用Client
端的Cursor，问题会减到最少，而且这里有一点十分奇特，OpenLink ODBC Driver允许
我们使用Recordset的Resync方法，不但没有错，而且还会把on-line Database的资料
传回来(这一点和使用RDO 的Client端Cursor不同，和 ADO SQL Server6.5也不同)。
所以，以下是我OpenLink ODBC Driver解决Update concurrency的方式。特别提出是，
在这OpenLink ODBC Driver下使用ADO，千万不要用Server端的Cursor，会有太多问题。
以下的程序只可用於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 = "UID=cww;PWD=jjh5612;Database=cwwpf@eis;" _
        + "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