RDO rdoConnection物件的Events

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