unit HStringVisualizer;

System.SysUtils,

System.Classes,

System.SyncObjs,

ToolsAPI;

THStringVisualizer = class(TInterfacedObject,

IOTADebuggerVisualizer,

IOTADebuggerVisualizer250,

IOTADebuggerVisualizerValueReplacer,

IOTAThreadNotifier,

IOTAThreadNotifier160)

private

type

TDeferredRec = record

Result: string;

{$IF CompilerVersion >= 23.0} // Delphi XE2 introduced TOTAAddress

ResultAddress: TOTAAddress;

{$ELSE}

ResultAddress: LongWord;

{$IFEND}

ResultSize: LongWord;

end;

private

FCompleted: Boolean;

FDeferred: TDeferredRec;

FLastKnownRawValue: string;

public

constructor Create;

destructor Destroy; override;

{ IOTADebuggerVisualizer }

function GetSupportedTypeCount: Integer;

procedure GetSupportedType(Index: Integer; var TypeName: string; var AllDescendants: Boolean); overload;

function GetVisualizerIdentifier: string;

function GetVisualizerName: string;

function GetVisualizerDescription: string;

{ IOTADebuggerVisualizer250 — adds generic/template support }

procedure GetSupportedType(Index: Integer; var TypeName: string; var AllDescendants: Boolean; var IsGeneric: Boolean); overload;

{ IOTADebuggerVisualizerValueReplacer }

function GetReplacementValue(const Expression, TypeName, EvalResult: string): string;

{ IOTAThreadNotifier }

procedure EvaluteComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress, ResultSize: LongWord; ReturnCode: Integer);

procedure ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);

procedure ThreadNotify(Reason: TOTANotifyReason);

procedure AfterSave;

procedure BeforeSave;

procedure Destroyed;

procedure Modified;

{ IOTAThreadNotifier160 — 64-bit address overload }

{$IF CompilerVersion >= 23.0} // Delphi XE2 introduced IOTAThreadNotifier160

{ ---- IOTAThreadNotifier160 ---- }

///<sumary>

/// This is called when an evaluate call that returned erDeferred completes.

/// That happens e.g. when the evaluation involves a function call.

/// Sets the FDeferred fields.

/// @param ReturnCode <> 0 if error </summary>

/// @NOTE: Evaluate is called in the TryEvaluate method. TryEvaluate also waits for

/// EvaluateComplete to be called and handles the FDeferred fields.

procedure EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress: TOTAAddress; ResultSize: LongWord; ReturnCode: Integer); overload;

{$IFEND}

///<summary>

/// This is called when an evaluate that returned erDeferred completes.

/// Calls the overloaded EvaluateComplete method of IOTAThreadNotifier160,

/// passing on the parameters and converting the ResultAddress to TOTAAddress

/// @param ReturnCode <> 0 if error </summary>

procedure EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress, ResultSize: Cardinal; ReturnCode: Integer); overload;

end;

procedure Register;

procedure Register;

// Components are not registered here; the visualizer registers itself

// in the initialization section via the ToolsAPI.

end;

constructor THStringVisualizer.Create;

inherited;

end;

destructor THStringVisualizer.Destroy;

inherited;

end;

function THStringVisualizer.GetSupportedTypeCount: Integer;

Result := 2;

end;

procedure THStringVisualizer.GetSupportedType(Index: Integer;

var TypeName: string; var AllDescendants: Boolean);

AllDescendants := False;

case Index of

0: TypeName := 'HSTRING';

1: TypeName := '__HSTRING__';

end;

end;

function THStringVisualizer.GetVisualizerIdentifier: string;

Result := Classname;

end;

function THStringVisualizer.GetVisualizerName: string;

Result := 'HSTRING Visualizer by DelphiCoder';

end;

function THStringVisualizer.GetVisualizerDescription: string;

Result := 'Displays the content of a Windows Runtime HSTRING handle';

end;

procedure THStringVisualizer.GetSupportedType(Index: Integer;

var TypeName: string; var AllDescendants, IsGeneric: Boolean);

IsGeneric := False;

GetSupportedType(Index, TypeName, AllDescendants); // delegate to v1

end;

function THStringVisualizer.GetReplacementValue(const Expression, TypeName, EvalResult: string): string;

CurProcess: IOTAProcess;

CurThread: IOTAThread;

NotifierIndex: Integer;

CanModify: Boolean;

ResultBuf: array[0..4095] of Char;

ResultAddr: TOTAAddress;

ResultSize: LongWord;

ResultVal: LongWord;

DebugSvcs: IOTADebuggerServices;

EvalRes: TOTAEvaluateResult;

Expr: string;

FLastKnownRawValue := EvalResult;

Result := EvalResult; // safe fallback — show the raw handle value

if (EvalResult = '0')

or (EvalResult = 'nil')

or (EvalResult = '$0')

or (EvalResult = '$00000000')

or (EvalResult = '$0000000000000000')

then

begin

Result := '(empty HSTRING)';

Exit;

end;

if not Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then

Exit;

CurProcess := DebugSvcs.CurrentProcess;

if CurProcess = nil then

Exit;

CurThread := CurProcess.CurrentThread;

if CurThread = nil then

Exit;

// EvalResult contains the handle value as a hex string e.g. '$1A2B3C4D'.

// We use the raw handle value from EvalResult, not Expression, because

// Expression may be a complex lvalue that the evaluator re-evaluates.

Expr := Format('PWideChar(WindowsGetStringRawBuffer(HSTRING(%s), nil))', [EvalResult]);

FCompleted := False;

FDeferred.Result := '';

// Register the notifier BEFORE calling Evaluate so the callback

// cannot be missed if evaluation completes synchronously.

NotifierIndex := CurThread.AddNotifier(Self);

try

FillChar(ResultBuf, SizeOf(ResultBuf), 0);

EvalRes := CurThread.Evaluate(

Expr,

@ResultBuf[0],

Length(ResultBuf),

CanModify,

eseAll,

'',

ResultAddr,

ResultSize,

ResultVal,

'',

0);

case EvalRes of

erOK:

begin

// Result already in the buffer — no need to wait

if ResultBuf[0] <> #0 then

Result := string(PChar(@ResultBuf[0]))

else

Result := '(empty)';

end;

erDeferred:

begin

// Block until EvaluateComplete fires

while not FCompleted do

DebugSvcs.ProcessDebugEvents;

if FDeferred.Result <> '' then

Result := FDeferred.Result

else

Result := Format('HSTRING($%s) <deferred eval returned empty>', [EvalResult]);

end;

erError:

Result := Format('HSTRING($%s) <eval error>', [EvalResult]);

end;

finally

CurThread.RemoveNotifier(NotifierIndex);

end;

end;

procedure THStringVisualizer.EvaluteComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress, ResultSize: LongWord; ReturnCode: Integer);

EvaluateComplete(ExprStr, ResultStr, CanModify, ResultAddress, ResultSize, ReturnCode);

end;

procedure THStringVisualizer.EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress, ResultSize: Cardinal; ReturnCode: Integer);

{$IF CompilerVersion >= 23.0}

EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress), LongWord(ResultSize), ReturnCode);

end;

procedure THStringVisualizer.EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean;

ResultAddress: TOTAAddress; ResultSize: LongWord; ReturnCode: Integer);

{$IFEND}

if ReturnCode = 0 then

begin

FDeferred.Result := ResultStr;

FDeferred.ResultAddress := ResultAddress;

FDeferred.ResultSize := ResultSize;

end

else

begin

FDeferred.ResultAddress := 0;

FDeferred.ResultSize := 0;

end;

FCompleted := True;

end;

procedure THStringVisualizer.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);

end;

procedure THStringVisualizer.ThreadNotify(Reason: TOTANotifyReason);

end;

procedure THStringVisualizer.AfterSave;

end;

procedure THStringVisualizer.BeforeSave;

end;

procedure THStringVisualizer.Destroyed;

end;

procedure THStringVisualizer.Modified;

end;

GVisualizer: IOTADebuggerVisualizer;

if Supports(BorlandIDEServices, IOTADebuggerServices) then

begin

GVisualizer := THStringVisualizer.Create;

(BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(GVisualizer);

end;

if Supports(BorlandIDEServices, IOTADebuggerServices) then

begin

(BorlandIDEServices as IOTADebuggerServices).UnregisterDebugVisualizer(GVisualizer);

GVisualizer := nil;

end;

end.