Mega Code Archive
SQL monitor magic
<![CDATA[
Title: SQL monitor magic
Question: Having problems with SQL monitor? Need better monitoring? How about multi-threaded monitoring? SQL monitor infrastructure provides this and more.
Answer:
How to get the most from the SQL monitor infrastructure in Delphi.
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 youre DB side of the application.
SQL monitor paints a nice picture. However, SQL monitor has some problems:
1. 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.
2. 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.
3. 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:
1. 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).
2. We need to create a callback function with the following prototype:
function(CBInfo: Pointer): CBRType of object;
3. 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. Dont 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.
The 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.
]]>