fibsqlmonitor.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

  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(PChar(FMonitorCount)      -   SizeOf(Integer));
  FTraceDataType:= PInteger(PChar(FMonitorCount)      - 2*SizeOf(Integer));
  FBufferSize   := PInteger(PChar(FMonitorCount)      - 3*SizeOf(Integer));
  FQPrepareReaderCount:=PInteger(PChar(FMonitorCount) - 4*SizeOf(Integer));
  FQExecuteReaderCount:=PInteger(PChar(FMonitorCount) - 5*SizeOf(Integer));
  FQFetchReaderCount  :=PInteger(PChar(FMonitorCount) - 6*SizeOf(Integer));
  FConnectReaderCount :=PInteger(PChar(FMonitorCount) - 7*SizeOf(Integer));
  FTransactReaderCount:=PInteger(PChar(FMonitorCount) - 8*SizeOf(Integer));
  FTimeStamp    := PDateTime(PChar(FTransactReaderCount)- SizeOf(TDateTime));
  FReserved     := PByte(PChar(FTimeStamp)- SizeOf(Byte));
  FReserved1    := PByte(PChar(FReserved )- 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: String;
  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 + qry.Fields[i].asString;
     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)+')';
      WriteSQLData(st, tfTransact);
    end;
  end;
end;