Visual Basic: RDO Data Control

RDO Events Example

This example illustrates several of the Remote Data Object (RDO) event handlers. The code establishes event variables and handlers to trap connection and query events. To help illustrate use of the BeforeConnect event, the code concatenates a workstation ID value and the current time to the end of the connect string. This permits identification of the specific connection at the server. After establishing the connection, the code executes a query that takes an fairly long time to execute the query is designed to run for about a minute. Because a 5 second QueryTimeout value is set, the QueryTimeout event should fire unless the query returns before 5 seconds has elapsed. Notice that the query itself is run asynchronously and the code does not poll for completion of the query. In this case the code simply waits for the QueryComplete or QueryTimeout events to fire indicating that the query is finished. The code also permits you to request another 5 seconds of waiting time.

Note that to make this example work correctly, you must do a number of things first, including setting references to the Remote Data Objects and Common Dialog libraries, adding a CommandButton and a Timer control to a form, plus you must change the ODBC connect string in the Form_Load() event to point to a valid server.

  Option Explicit
Private WithEvents cn As rdoConnection
Private WithEvents EngEv As rdoEngine
Dim er As rdoError
Dim strConnect As String
Dim rs As rdoResultset
Dim TimeStart As Single
Dim clock As Integer
Dim ShowClock As Integer
Dim QueryComplete As Integer
Dim InfoMsg As String
Dim Connected As Boolean
Dim ans As Integer

Private Sub EngEv_InfoMessage()
    InfoMsg = "For your information..." _
    & " the following message" _
        & " was returned by the server." & vbCrLf
    For Each er In rdoErrors
        InfoMsg = InfoMsg & er.Number _
    & " - " & er.Description & vbCrLf
    Next
        
End Sub
Private Sub cn_BeforeConnect( _
    ConnectString As String, Prompt As Variant)
  InfoMsg = "About to connect to:" & ConnectString _
    & " - " & Prompt
  ConnectString = ConnectString & ";WSID=" _
    & "EventTest" & Time$ & ";"
End Sub

Private Sub cn_Connect(ByVal ErrorOccurred As Boolean)
  'Fires once connected.
  Connected = True
End Sub

Private Sub cn_Disconnect() 'Fires when disconnected
  Connected = False
End Sub

Private Sub cn_QueryComplete(ByVal Query As _
  RDO.rdoQuery, ByVal ErrorOccurred As Boolean)
  Timer1.Enabled = False
  QueryComplete = vbChecked
  RunButton.Enabled = True
  Beep
  
  MsgBox "Query Done"
End Sub

Private Sub cn_QueryTimeout(ByVal Query As _
  RDO.rdoQuery, Cancel As Boolean)
    ans = MsgBox("The query did not complete " _
    & "in the time allocated. " _
    & "Press Cancel to abandon the query " _
    & "or Retry to keep working.", _
        vbRetryCancel + vbQuestion, "Query Timed Out")
    If ans = vbRetry Then
        Cancel = False
        QueryComplete = vbGrayed
    Else
        Timer1.Enabled = False
        QueryComplete = vbChecked
    End If
End Sub

Private Sub MenufileExit_Click()
    cn.Close
    Unload Form1
End Sub

Private Sub RunButton_Click()
    RunButton.Enabled = False
    On Error GoTo C1EH
    QueryComplete = vbGrayed
    Timer1.Enabled = True
    Set rs = cn.OpenResultset( _
        "execute VeryLongProcedure", _
        rdOpenKeyset, rdConcurValues, rdAsyncEnable)
    TimeStart = Timer
QuitRun:
Exit Sub
C1EH:
    Debug.Print Err, Error
        InfoMsg = "Error:.. the following error" _
        & " was returned by the server." & vbCrLf
    For Each er In rdoErrors
        InfoMsg = InfoMsg & er.Number _
        & " - " & er.Description & vbCrLf
    Next
    MsgBox "Query Failed to run"
    Timer1.Enabled = False
    Resume QuitRun

End Sub

Private Sub Form_Load()
On Error GoTo FLeh
Set EngEv = rdoEngine
Set cn = New rdoConnection
Show
    With cn
        .Connect = "UID=;PWD=;database=Workdb;" _
            & "Server=SEQUEL;" _
                & "driver={SQL Server};DSN='';"
        .QueryTimeout = 5
        .CursorDriver = rdUseClientBatch
        .EstablishConnection rdDriverNoPrompt
    End With
Exit Sub

FLeh:
    Debug.Print Err, Error
    For Each er In rdoErrors
        Debug.Print er.Description
    Next
    Stop
    Resume
End Sub

Private Sub Timer1_Timer()
    Static ot As Integer
    ' Display number of seconds
    ShowClock = Int(Timer - TimeStart)
    If ShowClock = ot Then Form1.Refresh
End Sub