dbMonitor GetObjectID (names in Object Tree)

[cis-wurzen]

When an object (e.g. query) pointer is reused then the statements of the new object are listed under the old object item.

The test case for this is the following:

Code: Select all

program ODACDBMonitorTest;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Ora,
  DASQLMonitor,
  ORASQLMonitor;

const
  cServer = 'YourServer';
  cUsername = 'YourUser';
  cPassword = 'YourPassword';

var
  ObjectIDs: array [1..4] of Integer;

procedure Test1;
var
  qr: TOraQuery;
begin
  qr := TOraQuery.Create(nil);
  try
    qr.Name := 'qrTest1';
    qr.SQL.Add('SELECT 1 FROM DUAL');
    qr.Open;
    ObjectIDs[1] := GetObjectID(qr);
  finally
    qr.Free;
  end;
end;

procedure Test2;
var
  qr: TOraQuery;
begin
  qr := TOraQuery.Create(nil);
  try
    qr.Name := 'qrTest2';
    qr.SQL.Add('SELECT 2 FROM DUAL');
    qr.Open;
    ObjectIDs[2] := GetObjectID(qr);
  finally
    qr.Free;
  end;
end;

procedure Test3Rename;
var
  qr: TOraQuery;
begin
  qr := TOraQuery.Create(nil);
  try
    qr.Name := 'qrTest3';
    qr.SQL.Add('SELECT 3 FROM DUAL');
    qr.Open;
    qr.Close;
    ObjectIDs[3] := GetObjectID(qr);
    qr.Name := 'qrTest4';
    qr.SQL.Clear;
    qr.SQL.Add('SELECT 4 FROM DUAL');
    qr.Open;
    ObjectIDs[4] := GetObjectID(qr);
  finally
    qr.Free;
  end;
end;

function TestEditCLOBWithroBeforeEdit: Boolean;
var
  I: Integer;
  se: TOraSession;
  mo: TOraSQLMonitor;
begin
  se := TOraSession.Create(nil);
  mo := TOraSQLMonitor.Create(nil);
  try
    se.Server := cServer;
    se.Username := cUserName;
    se.Password := cPassword;
    se.Connect;

    Test1;
    Test2;
    Test3Rename;
  finally
    mo.Free;
    se.Free;
  end;
  Result := (ObjectIDs[1] <> ObjectIDs[2]) and (ObjectIDs[1] <> ObjectIDs[3]) and (ObjectIDs[1] <> ObjectIDs[4]) and
    (ObjectIDs[2] <> ObjectIDs[3]) and (ObjectIDs[2] <> ObjectIDs[4]) and (ObjectIDs[3] <> ObjectIDs[4]);
  if not Result then
    for I := Low(ObjectIDs) to High(ObjectIDs) do
      WriteLn(Format('[%d] %.8x', [I, ObjectIDs[I]]));
end;

begin
  try
    if TestEditCLOBWithroBeforeEdit then
      WriteLn('PASS')
    else
      WriteLn('FAIL');
  except
    on E: Exception do
    begin
      WriteLn('FAIL - Exception Error');
      WriteLn('  E.ClassName = ', E.ClassName);
      WriteLn('    E.Message = ', E.Message);
    end;
  end;
  ReadLn;
end.

Steps:
- create a new console application in Delphi and paste the code
- adjust the constants cServer, cUserName and cPassword
- start dbMonitor
- compile and run the example
- check output

expected: output is PASS
actual: output is
[1] <8-digit hex value>
[2] <8-digit hex value>
[3] <8-digit hex value>
[4] <8-digit hex value>
FAIL

- check dbMonitor Object Tree

expected:
- it has beside the session the four items qrTest1, qrTest2, qrTest3 and qrTest4
- each qrTest<Number> has one "SELECT <Value> FROM DUAL" statement
actual:
- it has beside the session only qrTest1
- qrTest1 has four "SELECT <Value> FROM DUAL" statements


In order to fix this issue I've changed DASQLMonitor.GetObjectID to take the component name into account by building a string of the hex value of the pointer and the component name. It looks like this:

Code: Select all

function GetObjectID(Obj: TObject): Integer;
var
  S: string;
begin
{$IFDEF CLR}
  if Obj = nil then
    Result := 0
  else
{$ENDIF}
  if Obj is TComponent then
  begin
    S := IntToHex(NativeInt(Obj), SizeOf(Pointer) * 2) + TComponent(Obj).Name;
    Result := BobJenkinsHash(S[1], Length(S) * SizeOf(S[1]), 0);
  end
  else
    Result := Integer(Obj{$IFDEF CLR}.GetHashCode{$ENDIF});
end;

This version works for Delphi 2009 and newer for Win32 and Win64. (requires Generics.Defaults)


Consider adding this (IFDEFed if required) or something similar to your code to fix the issue. Furthermore check GetObjectName for Win64, because IntToHex uses a fixed length of eight and not a compile time evaluated value of SizeOf(Pointer) * 2.

[AlexP]

hello,

Thank you for the information. We will try to add these changes in the net version.