SQL monitor magic

Problem/Question/Abstract:

Having problems with SQL monitor? Need better monitoring? How about multi-threaded monitoring? SQL monitor infrastructure provides this and more.

Answer:

Introduction

SQL monitor is one of the most useful tools in Delphi, when you develop a database application. It allows the programmer to debug the connection between an application and a Database. It is very useful when you have automatic SQL generation. The tool provides the time it takes for each SQL to run, so you can use it to profile you’re DB side of the application.

SQL monitor paints a nice picture. However, SQL monitor has some problems:

You must start SQL monitor before you start the client application. This is a problem with applications that need to run non-stop for long durations.

The tool is not designed to work with multithreaded applications. It can trace only one session at a time, and that session is the last one opened. You cannot select what thread to monitor, nor can you monitor more then one thread.

Some applications use an automatic trouble tickets (TT) in case of errors. When you have a DB related problem, it is useful to add the SQL trace to the TT. However, the SQL monitor is an external tool, and does not allow this kind of trace.

The SQL monitor tool uses an infrastructure provided by Delphi and the BDE to trace SQLs. We can connect to this infrastructure without the SQL monitor tool, in order to get an SQL trace internally to the application, with out any of the problems above.

How the SQL trace works

We need to tell the BDE that we want an SQL trace. We do that by registering a callback function with the BDE (Callback is the equivalent of an event in non Object Oriented systems). The BDE provides SQL trace by setting a memory buffer with some text, and then notifying us with a callback. The callback function gets one parameter – a pointer to a TtraceDesc type (defined in the BDE unit). In that structure is the text we see in the SQL monitor tool.

Setting a BDE SQL Trace

In order to set a trace on the BDE, we need to register a BDE callback using the DbiRegisterCallback function in the DBE unit. The unit takes a number of parameters that sound like gibberish when you look at them in the online help. The VCL provides a nice wrapper for this call with the TBDECallback Class in the DBTables unit. This class takes a number of parameters in its constructor, and sets the appropriate callback. When we free an object of this class, the callback is freed.

To use the TBDECallback object, we need to do a number of things:

The TBDECallback object can register all kinds of DBE callbacks. In order to trace SQL, we need a cbTRACE callback (the value of the CBType parameter in Create).

We need to create a callback function with the following prototype:

function(CBInfo: Pointer): CBRType of object;

We need to create a memory buffer of smTraceBufSize size. (smTraceBufSize is a constant defined in the DBTables unit).

The code to set a trace can look like this:

var
  FSMBuffer: PTraceDesc;
  TraceCallback: TBDECallback;
begin
  GetMem(FSMBuffer, smTraceBufSize);
  TraceCallback := TBDECallback.Create(Self, nil, cbTRACE,
    FSMBuffer, smTraceBufSize, SqlTraceCallBack, False);
end;

The sqlTraceCallBack is a function defined in Delphi. It can look like this:

function TInternalSQLMonitor.SqlTraceCallBack(CBInfo: Pointer): CBRType;
var
  Data: Pointer;
  S: string;
begin
  Data := @PTraceDesc(CBInfo).pszTrace;
  SetLength(S, StrLen(Data));
  StrCopy(PChar(S), Data);

  //  S holds the trace text!

  Result := cbrUSEDEF;
end;

Stopping the trace

In order to stop the trace, all you need to do is

FreeMem(FSMBuffer, smTraceBufSize);
TraceCallback.Free;

And now for the advanced staff…

In the last section I explained how to setup an SQL trace. However, in the start of this article, a complained that the SQL monitor tool does not provide good support for multiple sessions and threads. In fact, the code in the last section has exactly the same problems. We need to overcome those problems.

If you look at the code in the last section, you will see that I do not specify what session and what database to trace. I also do not setup what are the trace options (as we have in the SQL monitor options window).

The problem is that we are opening a trace on the default session, default database and using the default settings (from the BDE driver).

When we run the above code, it registers a trace with the BDE current session. The current session is accessed via the sessions.CurrentSession global object property. By changing the current session, we can register a trace for any session we want. The callback function is registered per session, allowing us multi-threading trace. Don’t confuse the default session with the current session. The default session is one that is automatically opened by Delphi, and cannot be changed. The current session is current from the BDE point of view. It is the session that BDE functions work with. Because the current session is a global definition, we need some thread locking  mechanism when we set a trace. The code for setting a trace can now look like:

var
  ActivationLock: TCriticalSection;

procedure SetTrace;
begin
  ActivationLock.Enter;
  try
    // set the current session to be the session we want to trace.
    SaveCurrentSession := Sessions.CurrentSession;
    Sessions.CurrentSession := Session;
    // set the trace.
    GetMem(FSMBuffer, smTraceBufSize);
    TraceCallback := TBDECallback.Create(Self, nil, cbTRACE,
      FSMBuffer, smTraceBufSize, SqlTraceCallBack, True);
    // restore the current session to the saved session.
    Sessions.CurrentSession := SaveCurrentSession;
  finally
    ActivationLock.Leave;
  end;
end;

We need the same structure when we release the trace.

procedure CloseTrace;
begin
  ActivationLock.Enter;
  try
    // set the current session to be the session we want to trace.
    SaveCurrentSession := Sessions.CurrentSession;
    Sessions.CurrentSession := Session;
    // close the trace.
    FreeMem(FSMBuffer, smTraceBufSize);
    TraceCallback.Free;
    // restore the current session to the saved session.
    Sessions.CurrentSession := SaveCurrentSession;
  finally
    ActivationLock.Leave;
  end;
end;

What about the trace options?

The trace options come from the driver configuration of the BDE. However, you can override them from Delphi by setting the TraceFlags property of a Tdatabase component. There is one fine point to notice. You must set the value of TraceFlags AFTER you open the database. For some reason, if you set the options before you open the database, this has no affect.

Example

The following example is a component providing SQL trace for one session and one database. The component fires a Delphi event for each SQL trace event, with the trace text as a parameter. In order to use this component, all you need to do is attach it to a Tsession and Tdatabase, set the trace options, set the event and activate the trace.
Note that you can only activate a trace on an open database.

Code

unit InternalSQLMonitor_thread;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dbTables, bde, syncobjs;

const
  cDefaultTraceOptions = [tfQPrepare, tfQExecute, tfError, tfStmt, tfDataIn];

type
  TSQLTraceEvent = procedure(Sender: TObject; const SQLTrace: string) of object;

  TInternalSQLMonitor = class(TComponent)
  private
    FActive: Boolean;
    FOnSQLTraceEvent: TSQLTraceEvent;
    FSMBuffer: PTraceDesc;
    TraceCallback: TBDECallback;
    FSession: TSession;
    FDatabase: TDatabase;
    FTraceOptions: TTraceFlags;
    procedure ReplaceComponent(var Reference: TComponent; const Value: TComponent);
    procedure SetActive(const Value: Boolean);
    procedure SetOnSQLTraceEvent(const Value: TSQLTraceEvent);
    procedure SetSession(const Value: TSession);
    procedure SetDatabase(const Value: TDatabase);
    function CanOpenTrace: Boolean;
    procedure SetTraceOptions(const Value: TTraceFlags);
  protected
    function SqlTraceCallBack(CBInfo: Pointer): CBRType;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
  published
    property OnSQLTraceEvent: TSQLTraceEvent read FOnSQLTraceEvent write
      SetOnSQLTraceEvent;
    property Active: Boolean read FActive write SetActive;
    property Session: TSession read FSession write SetSession;
    property Database: TDatabase read FDatabase write SetDatabase;
    property TraceOptions: TTraceFlags read FTraceOptions write SetTraceOptions default
      cDefaultTraceOptions;
  end;

procedure Register;

implementation

var
  ActivationLock: TCriticalSection;

procedure Register;
begin
  RegisterComponents('Samples', [TInternalSQLMonitor]);
end;

{ TInternalSQLMonitor }

function TInternalSQLMonitor.CanOpenTrace: Boolean;
begin
  Result := (Session <> nil) and
    (Session.Active) and
    (Database <> nil) and
    (Database.Connected);
end;

procedure TInternalSQLMonitor.Close;
begin
  SetActive(False);
end;

constructor TInternalSQLMonitor.Create(AOwner: TComponent);
begin
  inherited;
  TraceOptions := cDefaultTraceOptions;
end;

destructor TInternalSQLMonitor.Destroy;
begin
  inherited;
  SetActive(False);
end;

procedure TInternalSQLMonitor.Open;
begin
  SetActive(True);
end;

procedure TInternalSQLMonitor.SetActive(const Value: Boolean);
var
  SaveCurrentSession: TSession;
begin
  // create the critical section, if needed.
  if ActivationLock = nil then
    ActivationLock := TCriticalSection.Create;
  if FActive <> Value then
  begin
    // check that all the preconditions needed to set a trace are met.
    if (Value = True) and (not CanOpenTrace) then
      raise
        Exception.Create('Cannot open trace when the session or database are closed');

    // prevent other threads from hampering. If other trace objects are opened
    // at the same time, prevent them from changing the current session until
    // we finish with it.
    ActivationLock.Enter;
    try
      FActive := Value;
      // set the current session to be the session we want to trace.
      SaveCurrentSession := Sessions.CurrentSession;
      Sessions.CurrentSession := Session;
      if FActive then
      begin
        // set the trace.
        GetMem(FSMBuffer, smTraceBufSize);
        TraceCallback := TBDECallback.Create(Self, nil, cbTRACE,
          FSMBuffer, smTraceBufSize, SqlTraceCallBack, True);
        // Set the trace Flags to the database
        FDatabase.TraceFlags := TraceOptions;
      end
      else
      begin
        // release the trace.
        FreeMem(FSMBuffer, smTraceBufSize);
        TraceCallback.Free;
      end;
      // restore the current session to the saved session.
      Sessions.CurrentSession := SaveCurrentSession;
    finally
      ActivationLock.Leave;
    end;
  end;
end;

procedure TInternalSQLMonitor.SetDatabase(const Value: TDatabase);
begin
  if FDatabase <> Value then
  begin
    if Active then
      Active := False;
    if Assigned(FDatabase) then
      FDatabase.RemoveFreeNotification(Self);
    FDatabase := Value;
    if Assigned(FDatabase) then
      FDatabase.FreeNotification(Self);
  end;
end;

procedure TInternalSQLMonitor.SetOnSQLTraceEvent(
  const Value: TSQLTraceEvent);
begin
  FOnSQLTraceEvent := Value;
end;

procedure TInternalSQLMonitor.SetSession(const Value: TSession);
begin
  if FSession <> Value then
  begin
    if Active then
      Active := False;
    if Assigned(FSession) then
      FSession.RemoveFreeNotification(Self);
    FSession := Value;
    if Assigned(FSession) then
      FSession.FreeNotification(Self);
    if (FDatabase <> nil) and (FDatabase.Session <> FSession) then
      FDatabase := nil;
  end;
end;

procedure TInternalSQLMonitor.SetTraceOptions(const Value: TTraceFlags);
begin
  if FTraceOptions <> Value then
  begin
    FTraceOptions := Value;
    if Active then
      FDatabase.TraceFlags := Value;
  end;
end;

function TInternalSQLMonitor.SqlTraceCallBack(CBInfo: Pointer): CBRType;
var
  Data: Pointer;
  S: string;
begin
  try
    if Assigned(FOnSQLTraceEvent) then
    begin
      Data := @PTraceDesc(CBInfo).pszTrace;
      SetLength(S, StrLen(Data));
      StrCopy(PChar(S), Data);
      FOnSQLTraceEvent(Self, S);
    end;
  except
  end;
  Result := cbrUSEDEF;
end;

procedure TInternalSQLMonitor.ReplaceComponent(var Reference: TComponent;
  const Value: TComponent);
begin
  if Assigned(Value) then
    Reference.RemoveFreeNotification(Self);
  Reference := Value;
  if Assigned(Reference) then
    Value.FreeNotification(Self);
end;

procedure TInternalSQLMonitor.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
  begin
    if (AComponent = FDatabase) then
      Database := nil;
    if (AComponent = FSession) then
      Session := nil;
  end;
end;

initialization

finalization
  if ActivationLock <> nil then
    FreeAndNil(ActivationLock);

end.