Enhance TAdsQuery to include Query Callback

In the recently published blog article (Query Progress Callback) I’ve showed how to implement a query callback. For that example I’ve passed a pointer of the form into the callback function, requiring a unique callback function for every Formclass to get the right typecast.
An easier way would be to write a TAdsQuery descendant component that has all required methods already implemented. So let’s begin with a new class, named TAdsQueryEx and a Callback function that casts the given pointer to an instance of that class:

  TAdsQueryEx = class(TAdsQuery)
  public
    function QueryCallback( usPercent: word):longint;
  end;
//...
// Callback used to cancel a query
{$IFDEF ADSDELPHI4_OR_NEWER}
function AdsQueryExCallback(usPercent:word; CallbackID:Int64):longint; stdcall;
begin
  {$IFDEF FPC} {$HINTS OFF} {$ENDIF}
  result := TAdsQueryEx(Pointer(CallbackID)).QueryCallback(uspercent);
  {$IFDEF FPC} {$HINTS ON} {$ENDIF}
end;
{$ELSE}
function AdsQueryExCallback(usPercent:word; CallbackID:Integer):longint; stdcall;
begin
  result := TAdsQueryEx(Pointer(CallbackID)).QueryCallback(uspercent);
end;
{$ENDIF}

In the constructor, we register that function and in the destructor we unregister ist:

constructor TAdsQueryEx.Create(AOwner: TComponent);
begin
  inherited;
{$IFDEF ADSDELPHI4_OR_NEWER}
  inherited AdsRegisterCallbackFunction101(@AdsQueryExCallback,Int64(self));
{$ELSE}
  inherited AdsRegisterCallbackFunction(@AdsQueryExCallback,SIGNED32(self));
{$ENDIF}
end;

destructor TAdsQueryEx.Destroy;
begin
  inherited AdsClearProgressCallback();
  inherited;
end;

Now we need to make sure that this callback function is not being overwritten from outside of our component. Unfortunately the AdsXX API wrappers are not virtual, so a simple override does not work. We need to reintroduce the methods:

  TAdsQueryEx = class(TAdsQuery)
  public
    procedure AdsRegisterCallbackFunction( Value : TAdsCallbackFunction; ulCallbackID : Longint ); reintroduce;
{$IFDEF ADSDELPHI4_OR_NEWER}
    procedure AdsRegisterCallbackFunction101( Value : TAdsCallbackFunction101; qCallbackID : Int64 ); reintroduce;
{$ENDIF}
    procedure AdsClearCallbackFunction; reintroduce;
  end;
//...
procedure TAdsQueryEx.AdsRegisterCallbackFunction(Value: TAdsCallbackFunction;
  ulCallbackID: Integer);
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;
{$IFDEF ADSDELPHI4_OR_NEWER}
procedure TAdsQueryEx.AdsRegisterCallbackFunction101(
  Value: TAdsCallbackFunction101; qCallbackID: Int64);
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;
{$ENDIF}
procedure TAdsQueryEx.AdsClearCallbackFunction;
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;

Finally we need some kind of event handler which is called inside the callback function.

type
  TAdsQueryCallbackEvent = function (usPercent:word):Boolean of object;
  TAdsQueryEx = class(TAdsQuery)
  private
    FOnQueryCallback: TAdsQueryCallbackEvent;
  public
    function QueryCallback( usPercent: word):longint;
  published
    property OnQueryCallback: TAdsQueryCallbackEvent read FOnQueryCallback write SetOnQueryCallback;
  end;
//...
function TAdsQueryEx.QueryCallback(usPercent: word): longint;
var
  bResult: Boolean;
begin
  if assigned(FOnQueryCallback) then
    bResult:=FOnQueryCallback(usPercent)
  else bResult:=False;
  if bResult then Result:=1
  else Result:=0;
end;

That’s it. Let’s put it all together.

unit AdsTableEX;

interface

uses
  SysUtils, Classes, windows, DB, adsdata, adsfunc, adstable, ace;

type
  TAdsQueryCallbackEvent = function (usPercent:word):Boolean of object;

  TAdsQueryEx = class(TAdsQuery)
  private
    FOnQueryCallback: TAdsQueryCallbackEvent;
    procedure SetOnQueryCallback(const Value: TAdsQueryCallbackEvent);
  public
    constructor Create( AOwner: TComponent ); override;
    destructor  Destroy; override;
    function QueryCallback( usPercent: word):longint;
    procedure AdsRegisterCallbackFunction( Value : TAdsCallbackFunction; ulCallbackID : Longint ); reintroduce;
{$IFDEF ADSDELPHI4_OR_NEWER}
    procedure AdsRegisterCallbackFunction101( Value : TAdsCallbackFunction101; qCallbackID : Int64 ); reintroduce;
{$ENDIF}
    procedure AdsClearCallbackFunction; reintroduce;
  published
    property OnQueryCallback: TAdsQueryCallbackEvent read FOnQueryCallback write SetOnQueryCallback;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Advantage', [TAdsQueryEx]);
end;

// Callback used to cancel a query
{$IFDEF ADSDELPHI4_OR_NEWER}
function AdsQueryExCallback(usPercent:word; CallbackID:Int64):longint; stdcall;
begin
  {$IFDEF FPC} {$HINTS OFF} {$ENDIF}
  result := TAdsQueryEx(Pointer(CallbackID)).QueryCallback(uspercent);
  {$IFDEF FPC} {$HINTS ON} {$ENDIF}
end;
{$ELSE}
function AdsQueryExCallback(usPercent:word; CallbackID:Integer):longint; stdcall;
begin
  result := TAdsQueryEx(Pointer(CallbackID)).QueryCallback(uspercent);
end;
{$ENDIF}

{ TAdsQueryEx }

procedure TAdsQueryEx.AdsClearCallbackFunction;
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;

procedure TAdsQueryEx.AdsRegisterCallbackFunction(Value: TAdsCallbackFunction;
  ulCallbackID: Integer);
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;

constructor TAdsQueryEx.Create(AOwner: TComponent);
begin
  inherited;
{$IFDEF ADSDELPHI4_OR_NEWER}
  inherited AdsRegisterCallbackFunction101(@AdsQueryExCallback,Int64(self));
{$ELSE}
  inherited AdsRegisterCallbackFunction(@AdsQueryExCallback,SIGNED32(self));
{$ENDIF}
end;

destructor TAdsQueryEx.Destroy;
begin
  inherited AdsClearProgressCallback();
  inherited;
end;

{$IFDEF ADSDELPHI4_OR_NEWER}
procedure TAdsQueryEx.AdsRegisterCallbackFunction101(
  Value: TAdsCallbackFunction101; qCallbackID: Int64);
begin
  raise Exception.Create('This function is not available in TAdsQueryEx');
end;
{$ENDIF}

function TAdsQueryEx.QueryCallback(usPercent: word): longint;
var
  bResult: Boolean;
begin
  if assigned(FOnQueryCallback) then
    bResult:=FOnQueryCallback(usPercent)
  else bResult:=False;
  if bResult then Result:=1
  else Result:=0;
end;

procedure TAdsQueryEx.SetOnQueryCallback(const Value: TAdsQueryCallbackEvent);
begin
  FOnQueryCallback := Value;
end;

end.