fibsqlmonitor.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

  Sa.lpSecurityDescriptor:= @Sd;
  Sa.bInheritHandle:= true;

  FSharedBuffer:= CreateFileMapping($FFFFFFFF, @sa, PAGE_READWRITE,
                       0, cMonitorHookSize, PChar(MonitorHookNames[1]));

  MapError:=GetLastError;
  if MapError= ERROR_ALREADY_EXISTS then
  begin
    FSharedBuffer:= OpenFileMapping(FILE_MAP_ALL_ACCESS, false, PChar(MonitorHookNames[1]));
    if (FSharedBuffer = 0) then
      FIBError(feCannotCreateSharedResource, [GetLastError]);

  end
  else
  begin
    FWriteLock:= CreateMutex(@sa, False, PChar(MonitorHookNames[0]));
    FWriteEvent:= CreateLocalEvent(2, False);
    FWriteFinishedEvent:= CreateLocalEvent(3, True);
    FReadEvent:= CreateLocalEvent(4, False);
    FReadFinishedEvent:= CreateLocalEvent(5, False);
  end;
  FBuffer:= MapViewOfFile(FSharedBuffer, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if FBuffer = nil then
      FIBError(feCannotCreateSharedResource, [GetLastError]);

  FMonitorCount:= PInteger(FBuffer+cMonitorHookSize-SizeOf(Integer));
  FReaderCount:= PInteger(PAnsiChar(FMonitorCount)-SizeOf(Integer));
  FTraceDataType:= PInteger(PAnsiChar(FMonitorCount)-2*SizeOf(Integer));
  FBufferSize:= PInteger(PAnsiChar(FMonitorCount)-3*SizeOf(Integer));
  FQPrepareReaderCount:=PInteger(PAnsiChar(FMonitorCount)-4*SizeOf(Integer));
  FQExecuteReaderCount:=PInteger(PAnsiChar(FMonitorCount)-5*SizeOf(Integer));
  FQFetchReaderCount:=PInteger(PAnsiChar(FMonitorCount)-6*SizeOf(Integer));
  FConnectReaderCount:=PInteger(PAnsiChar(FMonitorCount)-7*SizeOf(Integer));
  FTransactReaderCount:=PInteger(PAnsiChar(FMonitorCount)-8*SizeOf(Integer));
  FTimeStamp:= PDateTime(PAnsiChar(FTransactReaderCount)-SizeOf(TDateTime));
  FIsUnicodeVersion:= PBoolean(PAnsiChar(FTimeStamp)-SizeOf(Byte));
  FReserved:= PByte(PAnsiChar(FIsUnicodeVersion)-SizeOf(Byte));

  if MapError= ERROR_ALREADY_EXISTS then
  begin
    FWriteLock:= OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MonitorHookNames[0]));
    FWriteEvent:= OpenLocalEvent(2);
    FWriteFinishedEvent:= OpenLocalEvent(3);
    FReadEvent:= OpenLocalEvent(4);
    FReadFinishedEvent:= OpenLocalEvent(5);
  end
  else
  begin
    FMonitorCount^:=0;
    FReaderCount^:=0;
    FBufferSize^:=0;
    FQPrepareReaderCount^:=0;
    FQExecuteReaderCount^:=0;
    FQFetchReaderCount^:=0;
    FConnectReaderCount^:=0;
    FTransactReaderCount^:=0;
  end;

  if FMonitorCount^ < 0 then
    FMonitorCount^:= 0;
  if FReaderCount^ < 0 then
    FReaderCount^:= 0;
  vEventsCreated:= true;
end;

function TFIBSQLMonitorHook.SQLString(k:integer):Byte;
begin
  Result:=127
end;

procedure TFIBSQLMonitorHook.DBConnect(db:TFIBDatabase);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FConnectReaderCount^>0)
  then
  begin
    st:= db.Name+':[Connect]'; {do not localize}
    WriteSQLData(st, tfConnect);
  end;
end;

procedure TFIBSQLMonitorHook.DBDisconnect(db:TFIBDatabase);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FConnectReaderCount^>0)
  then
  begin
    st:= db.Name+':[Disconnect]'; {do not localize}
    WriteSQLData(st, tfConnect);
  end;
end;

destructor TFIBSQLMonitorHook.Destroy;
begin
  if vEventsCreated then
  begin
    UnmapViewOfFile(FBuffer);
    CloseHandle(FSharedBuffer);
    CloseHandle(FWriteEvent);
    CloseHandle(FWriteFinishedEvent);
    CloseHandle(FReadEvent);
    CloseHandle(FReadFinishedEvent);
    CloseHandle(FWriteLock);
  end;
  inherited Destroy;
end;

function TFIBSQLMonitorHook.GetEnabled:Boolean;
begin
  Result:= FActive;
end;

function TFIBSQLMonitorHook.GetMonitorCount:Integer;
begin
  if FMonitorCount=nil
  then
   Result:=0
  else
  Result:= FMonitorCount^;
end;

procedure TFIBSQLMonitorHook.RegisterMonitor(SQLMonitor:TFIBCustomSQLMonitor);
begin
  if not vEventsCreated then
  try
    CreateEvents;
  except
    SQLMonitor.Active:= false;
  end;
  if not Assigned(FFIBReaderThread) then
    FFIBReaderThread:= TMonitorReaderThread.Create;
  FFIBReaderThread.AddMonitor(SQLMonitor);
end;

procedure TFIBSQLMonitorHook.ReleaseMonitor(Arg:TFIBCustomSQLMonitor);
begin
  FFIBWriterThread.ReleaseMonitor(Arg.FHWnd);
end;

procedure TFIBSQLMonitorHook.SendMisc(Msg:String);
begin
  if FActive then
    WriteSQLData(Msg, tfMisc);
end;

{$IFDEF INC_SERVICE_SUPPORT}
procedure TFIBSQLMonitorHook.ServiceAttach(service:TpFIBCustomService);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  then
  begin
    st:= service.Name+':[Attach]'; {do not localize}
    WriteSQLData(st, tfService);
  end;
end;

procedure TFIBSQLMonitorHook.ServiceDetach(service:TpFIBCustomService);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  then
  begin
    st:= service.Name+':[Detach]'; {do not localize}
    WriteSQLData(st, tfService);
  end;
end;

procedure TFIBSQLMonitorHook.ServiceQuery(service:TpFIBCustomService);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  then
  begin
    st:= service.Name+':[Query]'; {do not localize}
    WriteSQLData(st, tfService);
  end;
end;

procedure TFIBSQLMonitorHook.ServiceStart(service:TpFIBCustomService);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  then
  begin
    st:= service.Name+':[Start]'; {do not localize}
    WriteSQLData(st, tfService);
  end;
end;

{$ENDIF}

procedure TFIBSQLMonitorHook.SetEnabled(const Value:Boolean);
begin
  if FActive<>Value then
    FActive:= Value;
  if (not FActive) and (Assigned(FFIBWriterThread)) then
  begin
    FFIBWriterThread.Terminate;
    FFIBWriterThread.WaitFor;
    FFIBWriterThread.Free;
    FFIBWriterThread:=nil;
  end;
end;

procedure TFIBSQLMonitorHook.SQLExecute(qry:TFIBQuery);
var
  st:string;
  i:Integer;
  Q:TISC_QUAD;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FQExecuteReaderCount^>0)
  then
  begin
    if qry.Owner is TFIBCustomDataSet then
      st:= TFIBCustomDataSet(qry.Owner).Name+'.'+qry.Name
    else
      st:= qry.Name;
    st:= st+':[Execute] '+qry.ReadySQLText(False); {do not localize}

   if qry.Params.Count > 0 then
   begin
    for i:= 0 to qry.Params.Count-1 do
    with qry.Params[i] do
    begin
        st:= st+CRLF+' '+Name+' = ';
        try
          if IsNull then
            st:= st+'<NULL>' {do not localize}
          else
           if (SQLType = (SQL_TEXT)) or (SQLType =(SQL_VARYING)) then
            st:= st+''''+AsString+''''
           else
           if ((SQLType and (not 1))= SQL_BLOB) then
           begin
            Q:=AsQuad;
            st:= st+'<BLOB> (BLOB_ID='+IntToStr(Q.gds_quad_high)+','+IntToStr(Q.gds_quad_low)+')'
           end
           else
           if ((SQLType and (not 1)) =(SQL_ARRAY)) then
            st:= st+'<ARRAY>'
           else
             st:= st+AsString;
        except
          st:= st+'<Can''t print value>';
        end;
    end;
   end;
    if qry.SQLType in [SQLInsert, SQLUpdate, SQLDelete] then
      st:=st+CRLF+'Rows Affected:'+IntToStr(qry.RowsAffected);
    st:=st+CRLF+'Execute tick count '+IntToStr(qry.CallTime);
    WriteSQLData(st, tfQExecute);
  end;
end;

procedure TFIBSQLMonitorHook.SQLFetch(qry:TFIBQuery);
var
  st:AnsiString;
  i:integer;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FQFetchReaderCount^>0)
  then
  begin
    if qry.Owner is TFIBCustomDataSet then
      st:= TFIBCustomDataSet(qry.Owner).Name
    else
      st:= qry.Name;
    st:= st+':[Fetch] '+qry.ReadySQLText(False); {do not localize}
    for i:=0 to Pred(qry.Current.Count) do
    begin
     st:=st+qry.Fields[i].Name+' = ';
     if qry.Fields[i].IsNull then
       st:= st+'NULL'
     else
       st:= st+UTF8Encode(qry.Fields[i].asWideString);
     st:=st+CRLF;
    end;
    st:=CRLF+st;

    if (qry.Eof) then
      st:= st+CRLF+' End of file reached';
    WriteSQLData(st, tfQFetch);
  end;
end;

procedure TFIBSQLMonitorHook.SQLPrepare(qry:TFIBQuery);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FQPrepareReaderCount^>0)
  then
  begin
    if qry.Owner is TFIBCustomDataSet then
      st:= TFIBCustomDataSet(qry.Owner).Name
    else
      st:= qry.Name;
    st:= st+':[Prepare] '+qry.ReadySQLText(False)+CRLF; {do not localize}
    try
      st:= st+' Plan:'+qry.Plan; {do not localize}
    except
      st:= st+' Plan:Can''t retrieve plan ';
    end;
    WriteSQLData(st, tfQPrepare);
  end;
end;

procedure TFIBSQLMonitorHook.TRCommit(tr:TFIBTransaction);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:= tr.Name+':[Commit (Hard commit)]('+
       IntToStr(tr.TransactionID)+')';
      WriteSQLData(st, tfTransact);
    end;
  end;
end;

procedure TFIBSQLMonitorHook.TRSavepoint(tr:TFIBTransaction;
 const SavePointName:string; Operation:TSavePointOperation);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
  and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:=tr.Name+':Transaction('+IntToStr(tr.TransactionID)+')-';
      case Operation of
       soSet:
        st:= st+' [SetSavePoint("'+SavePointName+'")]';
       soRollBack:
        st:= st+' [RollBackToSavePoint("'+SavePointName+'")]';
       soRelease:
        st:= st+' [ReleaseSavePoint("'+SavePointName+'")]';
      end;
      WriteSQLData(st, tfTransact);
    end;
  end;
end;

procedure TFIBSQLMonitorHook.TRCommitRetaining(tr:TFIBTransaction);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
   and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:= tr.Name+':[Commit retaining (Soft commit)]('+
       IntToStr(tr.TransactionID)+')';
      WriteSQLData(st, tfTransact);
    end;
  end;
end;

procedure TFIBSQLMonitorHook.TRRollback(tr:TFIBTransaction);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
   and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:= tr.Name+':[Rollback]('+
       IntToStr(tr.TransactionID)+')';
      WriteSQLData(st, tfTransact);
    end;
  end;
end;

procedure TFIBSQLMonitorHook.TRRollbackRetaining(tr:TFIBTransaction);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and (GetMonitorCount>0)
   and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:= tr.Name+':[Rollback retaining (Soft rollback)]('+
       IntToStr(tr.TransactionID)+')';
      WriteSQLData(st, tfTransact);
    end;
  end;
end;

procedure TFIBSQLMonitorHook.TRStart(tr:TFIBTransaction);
var
  st:String;
begin
  if FActive and bEnabledMonitoring and bEnabledMonitoring and (GetMonitorCount>0)
   and (FTransactReaderCount^>0)
  then
  begin
    if Assigned(tr.DefaultDatabase)
    then
    begin
      st:= tr.Name+':[Start transaction]('+
       IntToStr(tr.TransactionID)+')';