ADO: How to execute query synchronously with the a

Question

Right now i have a function that runs a query, using ADO, and returns a recordset:

Recordset Execute(Connection connection, String commandText)
{
   //[pseudo-code]
   Recordset rs = new Recordset();
   rs.CursorLocation = adUseClient;   
   rs.CursorType = adOpenForwardOnly;   
   rs.Open(commandText, connection, 
         adOpenForwardOnly, //CursorType; the default
         adLockReadOnly, //LockType
         adCmdText);       

   return rs;
}

And this is fine. It runs synchronously, and returns the recordset of a query.

Now i want a similar version, that shows a ProgressDialog, providing the user with the ability to cancel a long-running query:

Recordset Execute(HWND parenthWnd, String caption, Connection connection, String commandText)
{
   //[pseudo-code]

   //Construct a progressDialog and show it
   IProgressDialog pd = new ProgressDialog();
   pd.SetTitle(caption); //e.g. "Annual Funding Report"
   pd.SetCancelMsg("Please wait while the operation is cancelled");
   pd.StartProgressDialog(parenthWnd, null, PROGDLG_MODAL | PROGDLG_NOTIME | PROGDLG_NOMINIMIZE, null);
   pd.SetLine(1, "Querying server", False, null);
   try
   {
      //Query the server
      Recordset rs = new Recordset();
      rs.Open(commandText, connection, 
            adOpenForwardOnly, //CursorType
            adLockReadOnly, //LockType
            adCmdText | adAsyncExecute); 

      while (rs.State and (adStateConnecting+adStateExecuting+adStateFetching) <> 0) 
      {
         if pd.HasUserCancelled()
            throw new EUserCancelledOperationException();

         Sleep(100);
      };

   finally
   {
      //Hide and destroy the progress dialog     
      pd.StopProgressDialog();
      pd = null;
   }

   //Now we have our results for the client
   return rs;
}

---

The way to check if the user has cancelled the operation is to periodically ask the progress dialog if the user as pressed the cancel button:

pd.HasUserCancelled(); //returns true if user has clicked Cancel

Now i'm faced with how to periodically check if the user has cancelled (and to know if the query has completed, or an error has happened), and to be a good programmer and do it without polling.

The only way to know that an error has happened is to have a handler on the Recordset's FetchCompleteEvent:

pError
An Error object. It describes the error that occurred if the value of adStatus is adStatusErrorsOccurred; otherwise it is not set.

adStatus
An EventStatusEnum status value. When this event is called, this parameter is set to adStatusOK if the operation that caused the event was successfull, or to adStatusErrorsOccurred if the operation failed.

Before this event returns, set this parameter to adStatusUnwantedEvent to prevent subsequent notifications.

pRecordset
A Recordset object. The object for which the records were retrieved.

So this would imply that i'm going to have to have my function construct a helper object, so i can have a FetchComplete handler. But then i have to prevent my synchronous function from returning right away. And then we get into MsgWaitForSingleObject, which is notoriously difficult to use correctly.

So i'm asking for assistance, or canned code.

---

i should be more explicit: i'm looking for an implementation of function with this method signature:

Recordset ExecuteWithCancelOption(Connection connection, String commandText)

that shows a dialog with a cancel button on it.

The challenge is that the function must now create whatever is required to achieve that. If that involves a hidden form, that has a timer on it, etc - okay.

But i'm looking for a synchronous function that displays a Cancel button.

And the function is going to be a near (or exact) drop-in replacement for

Recordset Execute(Connection connection, String commandText)

Given practical considerations on Windows, i would need to supply the function with a parent window handle that it will parent its dialog to:

Recordset ExecuteWithCancelOption(HWND parentHwnd, Connection connection, String commandText)

And given that this is going to be a reusable function, i'll let the caller provide the text that will be displayed:

Recordset ExecuteWithCancelOption(HWND parenthWnd, String caption, Connection connection, String commandText)

And given that these are both class functions in my TADOHelper class, i can give them the same name, and have them be overloads of one another:

Recordset Execute(HWND parenthWnd, String caption, Connection connection, String commandText)

i would think in languages other than Delphi, anonymous delegates are helpful. But i'm still terrified of having to deal with MsgWaitForMultipleObjects.

Answer 1

If it is Delphi you can drop a TTimer component in and use that to check if HasUserCancelled value is True. I don't have Delphi in front of me so I'd have to post an example later.

Edit:

Here's an example of a TTimer OnTimer event that checks the current time and the lastactivity time to decide what to do with the forms if the program has been left "Up":

procedure TForm_Main.Timer1Timer(Sender: TObject);
begin
  // return to opening screen if no activity for a while:
  if Now - LastActivity > TimeOut
  then
    begin
      Form_Select.SBtn_Defendant.Down:= False;
      Form_Select.SBtn_Officer.Down:= False;
      Form_Select.SBtn_Attorney.Down:= False;
      Form_Main.ModalResult:= mrCancel;
      Exit;
    end;
  Form_Main.Caption:= FormatDateTime('ffffdd   mmmm d, yyyy  h:nn:ss AM/PM',    Now);
end;

Answer 2

1. Progress informations and gracefully cancelling a query may not be available in every database engine. They need database support, both on the server and the client side. For example Oracle allows cancelling a query, yet has no "on progress" information but reading the V$SESSION_LONGOPS view. Sure, you can kill the session, but it will rollback the whole of it, not just cancel a give query execution.
2. Usually if the database supports this kind of features, the query is run in a separate thread that will wait for the result. That way the main thread can still get user input or read and display progress information (unless returned in some kind of callback). If the user cancels the query then the appropriate call is issued to stop the operation, allowing the query thread to return, usually the thread will receive a status code that will tell what's happened.
3. Be aware of how ADO implements async operations: http://msdn.microsoft.com/en-us/library/ms681467(VS.85).aspx
4. There's also a FetchProgress() event that could help you if you don't want to go the thread way (and even then to cancel a the query, if possible)

Answer 3

In order to make GUI to respond to button clicks you should return control to the message loop of the window. While loop while (rs.State and (adStateConnecting+adStateExecuting+adStateFetching) <> 0) does not return control back to the message loop thus blocking GUI.

---

Below is an excerpt from a working Delphi code that uses asyncronous ADO queries. This code does not allow for non-modal fetching of data, but ensures that the main form is repainted during data fetch and also allows cancelling the query.

Asynchronous execution and fetching is achieved by setting:
FOpeningDataSet.ExecuteOptions := [eoAsyncExecute, eoAsyncFetchNonBlocking]; execution of query is cancelled by calling
DataSet.Recordset.Cancel;
in FetchProgress event.

Any TADODataSet shall be opened via the method:

OpenDataSetInBackground(DataSourceData.DataSet as TADODataSet);

Supporting code in the main form:

procedure TOperatorForm.OpenDataSetInBackground(DataSet: TADODataSet);
begin
  if DataSet.Active then Exit;
  FOpeningDataSet := DataSet;

  if not FAsyncDataFetch then
  begin
    FOpeningDataSet.Open;
    Exit;
  end;

  FFetchCancel := False;
  FExecuteOptions := FOpeningDataSet.ExecuteOptions;
  FFetchProgress := FOpeningDataSet.OnFetchProgress;
  FFetchComplete := FOpeningDataSet.OnFetchComplete;
  FRecordsetCreate := FOpeningDataSet.OnRecordsetCreate;
  FAfterScroll := FOpeningDataSet.AfterScroll;
  FOpeningDataSet.ExecuteOptions := [eoAsyncExecute, eoAsyncFetchNonBlocking];
  FOpeningDataSet.OnFetchProgress := DataSetFetchProgress;
  FOpeningDataSet.OnFetchComplete := DataSetFetchComplete;
  FOpeningDataSet.OnRecordsetCreate := DataSetRecordsetCreate;
  FOpeningDataSet.AfterScroll := DataSetAfterScroll;
  FOpeningDataSet.CursorLocation := clUseClient;
  FOpeningDataSet.DisableControls;
  try
    DataSetProgressForm.Left := Left + (Width - DataSetProgressForm.Width) div 2;
    DataSetProgressForm.Top := Top + (Height - DataSetProgressForm.Height) div 2;
    DataSetProgressForm.cxButton1.OnClick := DataSetProgressClick;
    DataSetProgressForm.cxButton1.Visible := FShowProgressCancelButton;

    FOpeningDataSet.Open;
    DataSetProgressForm.ShowModal;

  finally
    FOpeningDataSet.EnableControls;
    FOpeningDataSet.ExecuteOptions := FExecuteOptions;
    FOpeningDataSet.OnFetchProgress := FFetchProgress;
    FOpeningDataSet.OnFetchComplete := FFetchComplete;
    FOpeningDataSet.OnRecordsetCreate := FRecordsetCreate;
    FOpeningDataSet.AfterScroll := FAfterScroll;
  end;
end;

procedure TOperatorForm.DataSetProgressClick(Sender: TObject);
begin
  FFetchCancel := True;
end;

procedure TOperatorForm.DataSetFetchProgress(DataSet: TCustomADODataSet; Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
begin
  if FFetchCancel then
    DataSet.Recordset.Cancel;
end;

procedure TOperatorForm.DataSetFetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);
begin
  PostMessage(DataSetProgressForm.Handle, WM_CLOSE, 0, 0);
  MessageBeep(MB_ICONEXCLAMATION);
end;

procedure TOperatorForm.DataSetFetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);
begin
  PostMessage(DataSetProgressForm.Handle, WM_CLOSE, 0, 0);
  MessageBeep(MB_ICONEXCLAMATION);
end;

procedure TOperatorForm.DataSetRecordsetCreate(DataSet: TCustomADODataSet; const Recordset: _Recordset);
begin
  if Assigned(FRecordsetCreate) then FRecordsetCreate(DataSet, Recordset);
end;

procedure TOperatorForm.DataSetAfterScroll(DataSet: TDataSet);
begin
  // From TBetterADODataSet 4.04
  // Ole Willy Tuv's fix 03-10-00 for missing first record
  with TADODataSet(DataSet) do
  begin
    if (eoAsyncFetchNonBlocking in ExecuteOptions) and
       (Bof or Eof) and
       (CursorLocation = clUseClient) and
       (stFetching in RecordSetState) then
    begin
      if Recordset.RecordCount > 0 then
        if Bof then
          Recordset.MoveFirst
        else if Eof then
          Recordset.MoveLast;
      CursorPosChanged;
      Resync([]);
    end;
  end;
  if Assigned(FAfterScroll) then
    FAfterScroll(DataSet);
end;

Progress form:

unit uDataSetProgressForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls;

type
  TDataSetProgressForm = class(TForm)
    AnimateProgress: TAnimate;
    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Button1: TButton;
    Shape1: TShape;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataSetProgressForm: TDataSetProgressForm;

implementation

{$R *.dfm}
{$R servertimeout.res} // contains IDR_SERVAVI animation resource

procedure TDataSetProgressForm.FormCreate(Sender: TObject);
begin
  AnimateProgress.ResName := 'IDR_SERVAVI';
end;

procedure TDataSetProgressForm.FormShow(Sender: TObject);
begin
  AnimateProgress.Active := True;
end;

procedure TDataSetProgressForm.FormHide(Sender: TObject);
begin
  AnimateProgress.Active := False;
end;

end.

and dfm

object DataSetProgressForm: TDataSetProgressForm
  Left = 590
  Top = 497
  BorderStyle = bsNone
  ClientHeight = 104
  ClientWidth = 205
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poDefaultSizeOnly
  OnCreate = FormCreate
  OnHide = FormHide
  OnShow = FormShow
  DesignSize = (
    205
    104)
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 0
    Top = 0
    Width = 205
    Height = 104
    Align = alClient
    Style = bsRaised
  end
  object Bevel2: TBevel
    Left = 12
    Top = 12
    Width = 181
    Height = 80
    Anchors = [akLeft, akTop, akRight, akBottom]
  end
  object Shape1: TShape
    Left = 1
    Top = 1
    Width = 203
    Height = 102
    Anchors = [akLeft, akTop, akRight, akBottom]
    Brush.Style = bsClear
    Pen.Color = clWindowFrame
  end
  object AnimateProgress: TAnimate
    Left = 25
    Top = 23
    Width = 32
    Height = 32
  end
  object Label1: TLabel
    Left = 70
    Top = 31
    Width = 106
    Height = 17
    Hint = 'Selecting data...'
    Caption = 'Selecting data...'
    TabOrder = 1
  end
  object Button1: TButton
    Left = 63
    Top = 64
    Width = 80
    Height = 23
    Caption = 'Cancel'
    Default = True
    TabOrder = 2
  end
end