Archived copy of "How to do a very simple debug value replacer for Delphi?"

readme.md

Remark.

Now that the status of Stack Overflow has become unclear - it's mostly an AI feeder now, I copied the below entry from it.

Content

How to do a very simple debug value replacer for Delphi?

Asked 7 years, 11 months ago

Modified 7 years, 11 months ago

Viewed 480 times

1

Why do we need so much code just to tell the debugger to call .ToString on some objects?

I looked at the included examples under C:\Program Files (x86)\Embarcadero\Studio\19.0\source\Visualizers and adapted them for one of my objects - it works well.

Is there an easier way?

unit uMyObjectDebugVisualizer;

interface

procedure Register;

implementation

uses
  Classes, Forms, SysUtils, ToolsAPI;

type
  TMyObjectDebugVisualizer = class(TInterfacedObject,
      IOTADebuggerVisualizer, IOTADebuggerVisualizerValueReplacer, IOTAThreadNotifier, IOTAThreadNotifier160)
  private
    FNotifierIndex: Integer;
    FCompleted: Boolean;
    FDeferredResult: string;
  public
    { IOTADebuggerVisualizer }
    function GetSupportedTypeCount: Integer;
    procedure GetSupportedType(Index: Integer; var TypeName: string;
      var AllDescendants: Boolean);
    function GetVisualizerIdentifier: string;
    function GetVisualizerName: string;
    function GetVisualizerDescription: string;
    { IOTADebuggerVisualizerValueReplacer }
    function GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
    { IOTAThreadNotifier }
    procedure EvaluteComplete(const ExprStr: string; const ResultStr: string;
      CanModify: Boolean; ResultAddress: Cardinal; ResultSize: Cardinal;
      ReturnCode: Integer);
    procedure ModifyComplete(const ExprStr: string; const ResultStr: string;
      ReturnCode: Integer);
    procedure ThreadNotify(Reason: TOTANotifyReason);
    procedure AfterSave;
    procedure BeforeSave;
    procedure Destroyed;
    procedure Modified;
    { IOTAThreadNotifier160 }
    procedure EvaluateComplete(const ExprStr: string; const ResultStr: string;
      CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
      ReturnCode: Integer);
  end;

{ TMyObjectDebugVisualizer }

procedure TMyObjectDebugVisualizer.AfterSave;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.BeforeSave;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.Destroyed;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.Modified;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.EvaluteComplete(const ExprStr,
  ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: Cardinal;
  ReturnCode: Integer);
begin
  EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress),
    LongWord(ResultSize), ReturnCode);
end;

procedure TMyObjectDebugVisualizer.EvaluateComplete(const ExprStr,
  ResultStr: string; CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
  ReturnCode: Integer);
begin
  FCompleted:= True;
  if ReturnCode = 0 then
    FDeferredResult:= ResultStr;
end;

procedure TMyObjectDebugVisualizer.ThreadNotify(Reason: TOTANotifyReason);
begin
  // don't care about this notification
end;

function TMyObjectDebugVisualizer.GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
var
  CurProcess: IOTAProcess;
  CurThread: IOTAThread;
  ResultStr: array[0..255] of Char;
  CanModify: Boolean;
  ResultAddr, ResultSize, ResultVal: LongWord;
  EvalRes: TOTAEvaluateResult;
  DebugSvcs: IOTADebuggerServices;
  Done: Boolean;
begin
  Result:= EvalResult;
  if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then CurProcess:= DebugSvcs.CurrentProcess;
  if (CurProcess <> nil) and (CurProcess.GetProcessType <> optOSX32) then begin
    CurThread:= CurProcess.CurrentThread;
    if CurThread <> nil then repeat
        Done:= True;
        EvalRes:= CurThread.Evaluate(Expression + '.ToString', @ResultStr, Length(ResultStr),
          CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
        case EvalRes of
          erOK: Result:= ResultStr;
          erDeferred: begin
              FCompleted:= False;
              FDeferredResult:= '';
              FNotifierIndex:= CurThread.AddNotifier(Self);
              while not FCompleted do DebugSvcs.ProcessDebugEvents;
              CurThread.RemoveNotifier(FNotifierIndex);
              FNotifierIndex:= -1;
              if FDeferredResult <> '' then Result:= FDeferredResult
              else Result:= EvalResult;
            end;
          erBusy: begin
              DebugSvcs.ProcessDebugEvents;
              Done:= False;
            end;
        end;
      until Done;
  end;
end;

function TMyObjectDebugVisualizer.GetSupportedTypeCount: Integer;
begin
  Result:= 1;
end;

procedure TMyObjectDebugVisualizer.GetSupportedType(Index: Integer; var TypeName: string; var AllDescendants: Boolean);
begin
  AllDescendants:= True;
  TypeName:= 'TMyObject';
end;

function TMyObjectDebugVisualizer.GetVisualizerDescription: string;
begin
  Result:= 'Displays TMyObject objects';
end;

function TMyObjectDebugVisualizer.GetVisualizerIdentifier: string;
begin
  Result:= ClassName;
end;

function TMyObjectDebugVisualizer.GetVisualizerName: string;
begin
  Result:= 'TMyObject Visualizer for Delphi';
end;

var
  MyObjectVis: IOTADebuggerVisualizer;

procedure Register;
begin
  MyObjectVis:= TMyObjectDebugVisualizer.Create;
  (BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(MyObjectVis);
end;

procedure RemoveVisualizer;
var
  DebuggerServices: IOTADebuggerServices;
begin
  if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then begin
    DebuggerServices.UnregisterDebugVisualizer(MyObjectVis);
    MyObjectVis:= nil;
  end;
end;

initialization
finalization
  RemoveVisualizer;
end.

To get this working, you have to add it to a package. Also add "designide.dcp" to the required packages.

• delphi
• debugging
• debuggervisualizer

Share

Improve this question

Follow

asked Mar 1, 2018 at 15:37

[

](https://web.archive.org/web/20260203164441/https://stackoverflow.com/users/1855801/maf-soft)

maf-soft

2,56233 gold badges2828 silver badges5757 bronze badges

• "Why do we need so much code ..." I think that's just the way it is, working with OTA. There's typically a certain amount of of faffing around, but ime it's more a question of verbose declarations than verbose or complex code. Have you seen this, btw: davidghoyle.co.uk/WordPress/?tag=ota 

  -- MartynA

   CommentedMar 1, 2018 at 15:46

• 1

  "Is there an easier way?" - not really. Writing a debug visualizer is not a trivial task in general. The sample visualizers for TDateTime and std::(w)string that come with the IDE are about as simple as you can get. I'm actually a little surprised that Embarcadero didn't provider a simpler visualizer API, or at least provide reusable base classes, for making visualizer development easier. 

  -- Remy Lebeau

   CommentedMar 1, 2018 at 18:55 

• @MartynA: It not just the OTA, it also that you must parse what the IDE gives you, e.g. for my BigIntegers, it is something like '(FData:(4294967295 {$FFFFFFFF}, 4294967295 {$FFFFFFFF}, 4294967295 {$FFFFFFFF}, 0, 0, 0, 0, 0); FSize:3)'. The Visualizer must parse that and then turn it into a BigInteger again, so it can call its .ToString. Note that this BigInteger only has 3 limbs. They can have hundreds, thousands and even millions. And BigDecimal is even a little more complex. 

  -- Rudy Velthuis

   CommentedMar 1, 2018 at 20:10 

• @RudyVelthuis, see my solution above, I didn't have to parse: Evaluate(Expression + '.ToString', ...) - that's quite nice - if it was the only required line of code :) 

  -- maf-soft

   CommentedMar 1, 2018 at 20:45

• 1

  Your solution above needs to be in an answer below. :-) 

  -- Ken White

   CommentedMar 1, 2018 at 21:10

Show 2 more comments

uMyObjectDebugVisualizer.pas

unit uMyObjectDebugVisualizer;

interface

procedure Register;

implementation

uses
  Classes, Forms, SysUtils, ToolsAPI;

type
  TMyObjectDebugVisualizer = class(TInterfacedObject,
      IOTADebuggerVisualizer, IOTADebuggerVisualizerValueReplacer, IOTAThreadNotifier, IOTAThreadNotifier160)
  private
    FNotifierIndex: Integer;
    FCompleted: Boolean;
    FDeferredResult: string;
  public
    { IOTADebuggerVisualizer }
    function GetSupportedTypeCount: Integer;
    procedure GetSupportedType(Index: Integer; var TypeName: string;
      var AllDescendants: Boolean);
    function GetVisualizerIdentifier: string;
    function GetVisualizerName: string;
    function GetVisualizerDescription: string;
    { IOTADebuggerVisualizerValueReplacer }
    function GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
    { IOTAThreadNotifier }
    procedure EvaluteComplete(const ExprStr: string; const ResultStr: string;
      CanModify: Boolean; ResultAddress: Cardinal; ResultSize: Cardinal;
      ReturnCode: Integer);
    procedure ModifyComplete(const ExprStr: string; const ResultStr: string;
      ReturnCode: Integer);
    procedure ThreadNotify(Reason: TOTANotifyReason);
    procedure AfterSave;
    procedure BeforeSave;
    procedure Destroyed;
    procedure Modified;
    { IOTAThreadNotifier160 }
    procedure EvaluateComplete(const ExprStr: string; const ResultStr: string;
      CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
      ReturnCode: Integer);
  end;

{ TMyObjectDebugVisualizer }

procedure TMyObjectDebugVisualizer.AfterSave;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.BeforeSave;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.Destroyed;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.Modified;
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);
begin
  // don't care about this notification
end;

procedure TMyObjectDebugVisualizer.EvaluteComplete(const ExprStr,
  ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: Cardinal;
  ReturnCode: Integer);
begin
  EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress),
    LongWord(ResultSize), ReturnCode);
end;

procedure TMyObjectDebugVisualizer.EvaluateComplete(const ExprStr,
  ResultStr: string; CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
  ReturnCode: Integer);
begin
  FCompleted:= True;
  if ReturnCode = 0 then
    FDeferredResult:= ResultStr;
end;

procedure TMyObjectDebugVisualizer.ThreadNotify(Reason: TOTANotifyReason);
begin
  // don't care about this notification
end;

function TMyObjectDebugVisualizer.GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
var
  CurProcess: IOTAProcess;
  CurThread: IOTAThread;
  ResultStr: array[0..255] of Char;
  CanModify: Boolean;
  ResultAddr, ResultSize, ResultVal: LongWord;
  EvalRes: TOTAEvaluateResult;
  DebugSvcs: IOTADebuggerServices;
  Done: Boolean;
begin
  Result:= EvalResult;
  if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then CurProcess:= DebugSvcs.CurrentProcess;
  if (CurProcess <> nil) and (CurProcess.GetProcessType <> optOSX32) then begin
    CurThread:= CurProcess.CurrentThread;
    if CurThread <> nil then repeat
        Done:= True;
        EvalRes:= CurThread.Evaluate(Expression + '.ToString', @ResultStr, Length(ResultStr),
          CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
        case EvalRes of
          erOK: Result:= ResultStr;
          erDeferred: begin
              FCompleted:= False;
              FDeferredResult:= '';
              FNotifierIndex:= CurThread.AddNotifier(Self);
              while not FCompleted do DebugSvcs.ProcessDebugEvents;
              CurThread.RemoveNotifier(FNotifierIndex);
              FNotifierIndex:= -1;
              if FDeferredResult <> '' then Result:= FDeferredResult
              else Result:= EvalResult;
            end;
          erBusy: begin
              DebugSvcs.ProcessDebugEvents;
              Done:= False;
            end;
        end;
      until Done;
  end;
end;

function TMyObjectDebugVisualizer.GetSupportedTypeCount: Integer;
begin
  Result:= 1;
end;

procedure TMyObjectDebugVisualizer.GetSupportedType(Index: Integer; var TypeName: string; var AllDescendants: Boolean);
begin
  AllDescendants:= True;
  TypeName:= 'TMyObject';
end;

function TMyObjectDebugVisualizer.GetVisualizerDescription: string;
begin
  Result:= 'Displays TMyObject objects';
end;

function TMyObjectDebugVisualizer.GetVisualizerIdentifier: string;
begin
  Result:= ClassName;
end;

function TMyObjectDebugVisualizer.GetVisualizerName: string;
begin
  Result:= 'TMyObject Visualizer for Delphi';
end;

var
  MyObjectVis: IOTADebuggerVisualizer;

procedure Register;
begin
  MyObjectVis:= TMyObjectDebugVisualizer.Create;
  (BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(MyObjectVis);
end;

procedure RemoveVisualizer;
var
  DebuggerServices: IOTADebuggerServices;
begin
  if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then begin
    DebuggerServices.UnregisterDebugVisualizer(MyObjectVis);
    MyObjectVis:= nil;
  end;
end;

initialization
finalization
  RemoveVisualizer;
end.