Build your own profiler using ADO

February 21, 2010 by Rodrigo 17 Comments

You can construct your own SQL profiler for yours apps wich use ADO, the TAdoConnection Object has two events TADOConnection.OnWillExecute and TADOConnection.OnExecuteComplete to accomplish this task.

TWillExecuteEvent = procedure (const Connection: TADOConnection; var CommandText: WideString; var CursorType: TCursorType; var LockType: TADOLockType; var CommandType: TCommandType; var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus; const Command: _Command; const Recordset: _Recordset) of object;

TExecuteCompleteEvent = procedure (const Connection: TADOConnection; RecordsAffected: Integer; const Error: Error; var EventStatus: TEventStatus; const Command: _Command; const Recordset: _Recordset) of object;

1) Create a New Form with a TListview and a TMemo (in this example i am use a TSynEdit for format the SQL Command)

2) Create a public procedure in your form called AddLog

procedure AddLog(const Command,CommandType,Status,CursorType,LockType:String;RecordsAffected:Integer);

and implement the procedure like this

procedure TFrmLogSql.AddLog(const Command,CommandType,Status,CursorType,LockType:String;RecordsAffected:Integer);
var
  item : TListItem;
begin
    ListViewSQL.Items.BeginUpdate;
  try
    item:=ListViewSQL.Items.Add;
    item.Caption:=FormatDateTime('DD/MM/YYYY HH:NN:SS.ZZZ',Now);
    item.SubItems.Add(CommandType);
    item.SubItems.Add(Command);
    item.SubItems.Add(Status);
    item.SubItems.Add(IntToStr(RecordsAffected));
    item.SubItems.Add(CursorType);
    item.SubItems.Add(LockType);
  finally
    ListViewSQL.Items.EndUpdate;
  end;
  ListViewSQL.Items.Item[ListViewSQL.Items.Count-1].MakeVisible(false); //Scroll to the last line
end;

3) Assign the OnChange Event of the TListView

procedure TFrmLogSql.ListViewSQLChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
    if ListViewSQL.Selected<>nil then
    SynEdit1.Lines.Text:=ListViewSQL.Selected.SubItems[1];
end;

4) Assign the events OnWillExecute and OnExecuteComplete for you AdoConnection object.

uses
  TypInfo;

procedure TDataModule1.ADOConnection1WillExecute(
  Connection: TADOConnection; var CommandText: WideString;
  var CursorType: TCursorType; var LockType: TADOLockType;
  var CommandType: TCommandType; var ExecuteOptions: TExecuteOptions;
  var EventStatus: TEventStatus; const Command: _Command;
  const Recordset: _Recordset);
begin
   FrmLogSql.AddLog(
   CommandText,
   'Before '+GetEnumName(TypeInfo(TCommandType),Integer(CommandType)),
   GetEnumName(TypeInfo(TEventStatus),Integer(EventStatus)),
   GetEnumName(TypeInfo(TCursorType),Integer(CursorType)),
   GetEnumName(TypeInfo(TADOLockType),Integer(LockType)),
   0);
end;

procedure TDataModule1.ADOConnection1ExecuteComplete(
  Connection: TADOConnection; RecordsAffected: Integer; const Error: ADODB.Error;
  var EventStatus: TEventStatus; const Command: _Command;
  const Recordset: _Recordset);
begin
  FrmLogSql.AddLog(
  Command.CommandText,
  'After '+GetEnumName(TypeInfo(TCommandType),Integer(Command.CommandType)),
  GetEnumName(TypeInfo(TEventStatus),Integer(EventStatus)),
  GetEnumName(TypeInfo(TCursorType),Integer(Recordset.CursorType)),
  GetEnumName(TypeInfo(TADOLockType),Integer(Recordset.LockType)),
  RecordsAffected);
end;

5) and the final result