February | 2010 | The Road to Delphi

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

uses Winsock; function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean; var client : sockaddr_in; sock : Integer; ret : Integer; wsdata : WSAData; begin Result:=False; ret := WSAStartup($0002, wsdata); //initiates use of the Winsock DLL if ret<>0 then exit; try client.sin_family := AF_INET; //Set the protocol to use , in this case (IPv4) client.sin_port := htons(dwPort); //convert to TCP/IP network byte order (big-endian) client.sin_addr.s_addr := inet_addr(PAnsiChar(ipAddressStr)); //convert to IN_ADDR structure sock :=socket(AF_INET, SOCK_STREAM, 0); //creates a socket Result:=connect(sock,client,SizeOf(client))=0; //establishes a connection to a specified socket finally WSACleanup; end; end;