RDO rdoConnection物件的Events

来源:cww

这次除了介绍rdoConnection物件的Events之外，另外介绍除了OpenResultset之外，
另一种可以传回Resultset的方式，即把rdoQuery物件当作是rdoConnection物件的方法
来使用，而後再使用rdoConnection物件的LastQueryResults来取得Resultset。而这里
也提出一个比较完整的范例，含Error handle。

sql = "Select * from qppfa where case_no = 'E8701761' "
sql = sql + "and seq between ? and ?"   
Set qry = cn.CreateQuery("MyQuery", sql)
qry.CursorType = rdOpenKeyset
qry.LockType = rdConcurValues
qry.QueryTimeout = 10
Call cn.MyQuery(1,40)

首先设定成叁数查询的方式，并设定好rdoQuery的CursorType, LockType等属性，而後
   
    cn.MyQuery(1,40)

这便是把rdoQuery物件当作rdoConnection的方法来呼叫，而且又不用设定rdoParameter
，但是如此呼叫之後，并没有指定接收传回的Resultset物件，所以要再使用

    set rs = cn.LastQueryResults      以取得Resultset。

不过，使用这种方式我没有找到要在何处设定rdAsyncEnable的非同步查询设定，如果要
使用非同步查询，则需改成
sql = "Select * from qppfa where case_no = 'E8701761' "
sql = sql + "and seq between ? and ?"   
Set qry = cn.CreateQuery("MyQuery", sql)
qry.QueryTimeout = 10
qry.rdoParameters(0) = 1
qry.rdoParameters(1) = 40
Set rs = qry.OpenResultset(rdOpenKeyset,rdConcurValues, rdAsyncEnable)
'如果没有使用QueryComplete事件，那只好用以下的方式来做
'Do While rs.StillExecuting
'   'Do something
'   DoEvents
'Loop

最後要提出的是QueryTimeout这个Event，当设定的Query的Timeout已到(qry.QueryTimeout)
则会产生这个事件，而Cancel这个叁数是来控制就此打住不再查询了，或者再查一次，
不过就算我们设定它不再查询了(Cancel = True)，经Testing於Informix(7.2 Dynamic
Server, OpenLink之ODBC Driver)不一定代表Server端就打住，可能会再经过某些动作後
才真的会停，这个期间，程序会Lock住，就好比程序死掉一般。而SQL Server6.5则不会
有这种情况，在Timeout之後，设定Cancel = true则真的就结束查询，不会像Informix
一般会Lock住一段时间。因此我的建议是，如果在Informix之下，不要去改变rdoQuery
Timeout的设定，如此一来，等Informix真正处理到Timeout後，取消查询才不会被Lock
住。

Option Explicit
Dim WithEvents cn   As rdoConnection
Dim en As rdoEnvironment
Private WithEvents rs As rdoResultset
Private qry As rdoQuery

'在连结之前发生的Event，在此提供一个机会可以改变rdoConnection物件的
'Connect属性(即改ConnectionString)
Private Sub cn_BeforeConnect(ConnectString As String, Prompt As Variant)
Debug.Print "Befor Connection"
End Sub

'发生在到伺服器的连结建立之後，不管连结过程有没有错误，都会传回这个Events
Private Sub cn_Connect(ByVal ErrorOccurred As Boolean)
Dim i As Long
If ErrorOccurred Then
   Dim errstr As String
   errstr = GetrdoErrorDescription()
   Call MsgBox(errstr, vbCritical, "Connect过程有误")
Else
   Debug.Print "Connect Success!!"
   '连结成功之後才能或才要做的动作，请在写这里
End If
End Sub

Private Sub cn_Disconnect()
Debug.Print "DisConnection!!"
End Sub

'发生在 rdoResultset 的查询传回第一个结果集或有误时，这个事件在非同步OpenResultset
'时最为有效，方这个事件取代StillExecuting的查询。另外，如果是MultiResult的
'Query，这QueryComplete事件的产生，经Testing是在所有Query都完成後才发生
Private Sub cn_QueryComplete(ByVal Query As RDO.rdoQuery, ByVal ErrorOccurred As Boolean)
If ErrorOccurred Then
   Dim errstr As String
   errstr = "原始查询：" + Query.sql + vbCrLf
   errstr = errstr + GetrdoErrorDescription()
   Call MsgBox(errstr, vbCritical, "查询过程有误")
Else
   Debug.Print "Query SQL =" + Query.sql
   Set rs = cn.LastQueryResults
   'Debug.Print rs.rdoColumns(0).Value
End If
   
End Sub

Private Sub cn_QueryTimeout(ByVal Query As RDO.rdoQuery, Cancel As Boolean)
Dim ans As Integer
ans = MsgBox("查询逾时，是否继续再查？", _
    vbRetryCancel + vbCritical, "查询逾时")
If ans = vbRetry Then
    Cancel = False
Else
    Cancel = True
End If
End Sub

'在OpenResultset, Execute, rdoConnection物件.rdoQuery名称之前发生
'在这里Query物件指的是rdoConnection物件要执行的动作，而设定Cancel = true
'则会取消这次的查询。
Private Sub cn_WillExecute(ByVal Query As RDO.rdoQuery, Cancel As Boolean)
Debug.Print "Will Execute"
End Sub

Private Sub Command1_Click()
rs.Cancel
End Sub

Private Sub Form_Load()
Dim connstr As String
Dim ans As Integer, errstr As String

Set en = rdoEnvironments(0)
Set cn = New rdoConnection
cn.CursorDriver = rdUseServer
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.Connect = connstr

On Error GoTo ConnectErr
cn.EstablishConnection rdDriverNoPrompt, False

Dim sql As String
sql = "Select * from qppfa where case_no = 'E8701761' "
sql = sql + "and seq between ? and ?"
Set qry = cn.CreateQuery("MyQuery", sql)
qry.CursorType = rdOpenKeyset
qry.LockType = rdConcurValues
qry.QueryTimeout = 10

On Error GoTo QryErr
Call cn.MyQuery(1,40)
Exit Sub
ConnectErr:
   errstr = GetrdoErrorDescription
   ans = MsgBox(errstr, _
             vbRetryCancel + vbCritical, "连结错误")
   If ans = vbRetry Then
      err.Clear
      rdoErrors.Clear
      Resume
   Else
      Resume ExitErr
   End If
   Exit Sub
QryErr:
   errstr = GetrdoErrorDescription
   ans = MsgBox(errstr, _
             vbRetryCancel + vbCritical, "查询错误")
   If ans = vbRetry Then
      err.Clear
      rdoErrors.Clear
      Resume
   Else
      Resume ExitErr
   End If
   Exit Sub
ExitErr:
End Sub
Private Function GetrdoErrorDescription() As String
Dim rdoerr As rdoError, errstr As String
   
For Each rdoerr In rdoErrors
    errstr = errstr + rdoerr.Description + vbCrLf
Next
errstr = errstr + "重新试一次？"
GetrdoErrorDescription = errstr
End Function
Private Sub Form_Unload(Cancel As Integer)
If Not (rs Is Nothing) Then rs.Close
If Not (cn Is Nothing) Then cn.Close
End Sub