Query Progress Callback with Delphi

Today I want to focus on a topic that I was asked for many times: How can we get the progress of a running query and how can we even cancel it? Advantage Data Architect does it, so it should be possible;)
Looking at the sources of TAdsExtendedDataSet (adsfunc.pas), you’ll find wrapper methods around 2 ACE API functions: AdsRegisterCallbackFunction101 and AdsClearProgressCallback. TAdsExtendedDataSet is an ancestor of TAdsQuery, so it inherits these methods.

{**********************************************************
*  Module:  TAdsExtendedDataSet.AdsRegisterCallbackFunction101
*  Date Created:  4-25-2012
*  Description:
**********************************************************}
procedure TAdsExtendedDataSet.AdsRegisterCallbackFunction101( Value : TAdsCallbackFunction101;
                                                              qCallbackID : Int64 );
begin
   ACECheck2( self, ACE.AdsRegisterCallbackFunction101( TCallbackFunction101( Value ),
                                                        qCallbackID ) );
end;

{**********************************************************
*  Module:  TAdsExtendedDataSet.AdsClearCallbackFunction
*  Date Created:  05/24/2001
*  Description:
**********************************************************}
procedure TAdsExtendedDataSet.AdsClearCallbackFunction;
begin
   ACECheck2( self, ACE.AdsClearCallbackFunction );
end;

As you can see, to register a callback, you need to pass in a function pointer (not method pointer!) and a callback identifier. The callback function is defined as follows (in ace.pas):

      { This data type defines what type of function to pass to
        AdsRegisterCallbackFunction(). }
      TCallbackFunction101 = function( usPercent: Word;
                                       qCallbackID: Int64 ): Longint;

In fact, there are two different function definitions being used: one is valid for Delphi older than Delphi 4 (32Bit pointer) and the other for Delphi 4 and newer (64Bit pointer). This has to be kept in mind if being used in a general way. In my example I focus only to the newer Delphi versions.
Now there’s a question on how to combine a function and an object, so the (general) callback function could update the object. The solution is easy – and very dangerous at the same time: Use the callback identifier to pass in a pointer to the object and cast it back within the callback function. For my example, I added a public method to my Mainform.

  public
    function QueryCallback(usPercent: word):longint;

This method does an update on the mainform’s progress bar and checks for a flag (bcancel, set by the „stop button click“ event). If the return value of the method is different than 0, the query shoud be stopped.

function TMainform.QueryCallback(usPercent: word): longint;
begin
  ProgressBar1.Min:=0;
  ProgressBar1.Max:=100;
  ProgressBar1.Position:=usPercent;
  Application.ProcessMessages;
  if bcancel then result:=1
  else result:=0;
end;

The callback function is being called every 2 seconds by the Advantage Client Engine until the query is finished. Within the function, we take the pointer and cast it back to TMainform before calling it’s QueryCallback method.

// Callback used to cancel a query
function ACECallback(usPercent:word; CallbackID:Int64):longint; stdcall;
begin
  result := TMainform(Pointer(CallbackID)).QueryCallback(uspercent);
end;

Finally, register the function any time before opeing the query. Don’t forget to clear when the callback is not being needed any more.

  bcancel:=false;
  AdsQuery1.AdsRegisterCallbackFunction101(@ACECallback,Int64(self));
  AdsQuery1.Open;
  AdsQuery1.AdsClearProgressCallback();