├── README.md ├── StringVisualizer.dfm ├── StringVisualizer.dpk └── StringVisualizer.pas /README.md: -------------------------------------------------------------------------------- 1 | Visualiser for Delphi to show strings 'as is'. 2 | 3 | - Can show very large strings (larger - slower). 4 | - Can copy to clipboard. 5 | - Can save to file. 6 | 7 | Install package [StringVisualizer.dpk] into Delphi, then use just like shown on screenshot: 8 | 9 | ![Img](https://github.com/user-attachments/assets/7a1f87fc-9249-40f6-a9ad-5bad357f898d) 10 | 11 | -------------------------------------------------------------------------------- /StringVisualizer.dfm: -------------------------------------------------------------------------------- 1 | object StringViewerFrame: TStringViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 548 5 | Height = 299 6 | Color = clBtnFace 7 | ParentBackground = False 8 | ParentColor = False 9 | TabOrder = 0 10 | object Panel2: TPanel 11 | Left = 0 12 | Top = 0 13 | Width = 548 14 | Height = 29 15 | Align = alTop 16 | BevelOuter = bvNone 17 | TabOrder = 0 18 | object Button1: TButton 19 | Left = 3 20 | Top = 4 21 | Width = 111 22 | Height = 25 23 | Caption = 'Copy to Clipboard' 24 | TabOrder = 0 25 | OnClick = Button1Click 26 | end 27 | object Button2: TButton 28 | Left = 120 29 | Top = 4 30 | Width = 93 31 | Height = 25 32 | Caption = 'Save to File' 33 | TabOrder = 1 34 | OnClick = Button2Click 35 | end 36 | end 37 | object StatusBar1: TStatusBar 38 | Left = 0 39 | Top = 280 40 | Width = 548 41 | Height = 19 42 | Panels = < 43 | item 44 | Width = 500 45 | end> 46 | end 47 | object Memo: TMemo 48 | AlignWithMargins = True 49 | Left = 3 50 | Top = 32 51 | Width = 542 52 | Height = 245 53 | Align = alClient 54 | ScrollBars = ssBoth 55 | TabOrder = 2 56 | end 57 | object FSD: TFileSaveDialog 58 | DefaultExtension = '.txt' 59 | FavoriteLinks = <> 60 | FileName = 'out.txt' 61 | FileTypes = <> 62 | Options = [fdoOverWritePrompt, fdoPathMustExist] 63 | Title = 'Save string to file' 64 | Left = 10 65 | Top = 46 66 | end 67 | end 68 | -------------------------------------------------------------------------------- /StringVisualizer.dpk: -------------------------------------------------------------------------------- 1 | package StringVisualizer; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | designide; 33 | 34 | contains 35 | StringVisualizer in 'StringVisualizer.pas' {StringViewerFrame}; 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /StringVisualizer.pas: -------------------------------------------------------------------------------- 1 | unit StringVisualizer; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ComCtrls, ToolsAPI, StdCtrls, ExtCtrls, Vcl.Mask; 8 | 9 | type 10 | TAvailableState = (asAvailable, asProcRunning, asOutOfScope); 11 | 12 | TStringViewerFrame = class(TFrame, IOTADebuggerVisualizerExternalViewerUpdater, IOTAThreadNotifier) 13 | Panel2: TPanel; 14 | Button1: TButton; 15 | Button2: TButton; 16 | FSD: TFileSaveDialog; 17 | StatusBar1: TStatusBar; 18 | Memo: TMemo; 19 | procedure Button1Click(Sender: TObject); 20 | procedure Button2Click(Sender: TObject); 21 | private 22 | FOwningForm: TCustomForm; 23 | FClosedProc: TOTAVisualizerClosedProcedure; 24 | FExpression: string; 25 | FNotifierIndex: Integer; 26 | FCompleted: Boolean; 27 | FDeferredResult: string; 28 | FDeferredError: Boolean; 29 | FString: string; 30 | FAvailableState: TAvailableState; 31 | function Evaluate(Expression: string): string; 32 | protected 33 | procedure SetParent(AParent: TWinControl); override; 34 | public 35 | procedure CloseVisualizer; 36 | procedure MarkUnavailable(Reason: TOTAVisualizerUnavailableReason); 37 | procedure RefreshVisualizer(const Expression, TypeName, EvalResult: string); 38 | procedure SetClosedCallback(ClosedProc: TOTAVisualizerClosedProcedure); 39 | procedure SetForm(AForm: TCustomForm); 40 | procedure DisplayString(const Expression, TypeName, EvalResult: string); 41 | 42 | procedure AfterSave; 43 | procedure BeforeSave; 44 | procedure Destroyed; 45 | procedure Modified; 46 | procedure ThreadNotify(Reason: TOTANotifyReason); 47 | procedure EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: LongWord; ReturnCode: Integer); 48 | procedure ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer); 49 | end; 50 | 51 | procedure Register; 52 | 53 | implementation 54 | 55 | uses 56 | DesignIntf, Actnlist, ImgList, Menus, IniFiles, Vcl.Clipbrd, System.Math; 57 | 58 | {$R *.dfm} 59 | 60 | resourcestring 61 | sStringVisualizerName = 'String Visualizer for Delphi'; 62 | sStringVisualizerDescription = 'Displays a String'; 63 | sMenuText = 'Show String'; 64 | sFormCaption = 'String Visualizer for %s'; 65 | sProcessNotAccessible = 'process not accessible'; 66 | sOutOfScope = 'out of scope'; 67 | 68 | type 69 | 70 | IFrameFormHelper = interface 71 | ['{1A770356-D01F-480E-9706-3A75F8AC5CFD}'] 72 | function GetForm: TCustomForm; 73 | function GetFrame: TCustomFrame; 74 | procedure SetForm(Form: TCustomForm); 75 | procedure SetFrame(Form: TCustomFrame); 76 | end; 77 | 78 | TStringVisualizerForm = class(TInterfacedObject, INTACustomDockableForm, IFrameFormHelper) 79 | private 80 | FMyFrame: TStringViewerFrame; 81 | FMyForm: TCustomForm; 82 | FExpression: string; 83 | public 84 | constructor Create(const Expression: string); 85 | { INTACustomDockableForm } 86 | function GetCaption: string; 87 | function GetFrameClass: TCustomFrameClass; 88 | procedure FrameCreated(AFrame: TCustomFrame); 89 | function GetIdentifier: string; 90 | function GetMenuActionList: TCustomActionList; 91 | function GetMenuImageList: TCustomImageList; 92 | procedure CustomizePopupMenu(PopupMenu: TPopupMenu); 93 | function GetToolbarActionList: TCustomActionList; 94 | function GetToolbarImageList: TCustomImageList; 95 | procedure CustomizeToolBar(ToolBar: TToolBar); 96 | procedure LoadWindowState(Desktop: TCustomIniFile; const Section: string); 97 | procedure SaveWindowState(Desktop: TCustomIniFile; const Section: string; IsProject: Boolean); 98 | function GetEditState: TEditState; 99 | function EditAction(Action: TEditAction): Boolean; 100 | { IFrameFormHelper } 101 | function GetForm: TCustomForm; 102 | function GetFrame: TCustomFrame; 103 | procedure SetForm(Form: TCustomForm); 104 | procedure SetFrame(Frame: TCustomFrame); 105 | end; 106 | 107 | TDebuggerStringVisualizer = class(TInterfacedObject, IOTADebuggerVisualizer, 108 | IOTADebuggerVisualizerExternalViewer) 109 | public 110 | function GetSupportedTypeCount: Integer; 111 | procedure GetSupportedType(Index: Integer; var TypeName: string; 112 | var AllDescendants: Boolean); 113 | function GetVisualizerIdentifier: string; 114 | function GetVisualizerName: string; 115 | function GetVisualizerDescription: string; 116 | function GetMenuText: string; 117 | function Show(const Expression, TypeName, EvalResult: string; Suggestedleft, SuggestedTop: Integer): IOTADebuggerVisualizerExternalViewerUpdater; 118 | end; 119 | 120 | { TDebuggerDateTimeVisualizer } 121 | 122 | function TDebuggerStringVisualizer.GetMenuText: string; 123 | begin 124 | Result := sMenuText; 125 | end; 126 | 127 | procedure TDebuggerStringVisualizer.GetSupportedType(Index: Integer; 128 | var TypeName: string; var AllDescendants: Boolean); 129 | begin 130 | TypeName := 'string'; 131 | AllDescendants := False; 132 | end; 133 | 134 | function TDebuggerStringVisualizer.GetSupportedTypeCount: Integer; 135 | begin 136 | Result := 1; 137 | end; 138 | 139 | function TDebuggerStringVisualizer.GetVisualizerDescription: string; 140 | begin 141 | Result := sStringVisualizerDescription; 142 | end; 143 | 144 | function TDebuggerStringVisualizer.GetVisualizerIdentifier: string; 145 | begin 146 | Result := ClassName; 147 | end; 148 | 149 | function TDebuggerStringVisualizer.GetVisualizerName: string; 150 | begin 151 | Result := sStringVisualizerName; 152 | end; 153 | 154 | function TDebuggerStringVisualizer.Show(const Expression, TypeName, EvalResult: string; SuggestedLeft, SuggestedTop: Integer): IOTADebuggerVisualizerExternalViewerUpdater; 155 | var 156 | AForm: TCustomForm; 157 | AFrame: TStringViewerFrame; 158 | VisDockForm: INTACustomDockableForm; 159 | begin 160 | VisDockForm := TStringVisualizerForm.Create(Expression) as INTACustomDockableForm; 161 | AForm := (BorlandIDEServices as INTAServices).CreateDockableForm(VisDockForm); 162 | AForm.Left := SuggestedLeft; 163 | AForm.Top := SuggestedTop; 164 | (VisDockForm as IFrameFormHelper).SetForm(AForm); 165 | AFrame := (VisDockForm as IFrameFormHelper).GetFrame as TStringViewerFrame; 166 | Result := AFrame as IOTADebuggerVisualizerExternalViewerUpdater; 167 | AFrame.DisplayString(Expression, TypeName, EvalResult); 168 | TForm(AForm).FormStyle:=fsStayOnTop; 169 | end; 170 | 171 | 172 | Procedure StrToFile(FileName: String; Str: String; AppendFile: boolean = True); overload; 173 | var 174 | f : TextFile; 175 | FN : string; 176 | begin 177 | if FileName='' then Exit; 178 | 179 | FN:=String(FileName); 180 | AssignFile(f,FN); 181 | if FileExists(FN) and AppendFile then begin 182 | Append(f); 183 | end else begin 184 | ReWrite(f); 185 | end; 186 | Write(f,Str); 187 | CloseFile(f); 188 | end; 189 | 190 | 191 | function DecodeText(const Text: string; Len: integer = -1): string; 192 | var 193 | i,n : integer; 194 | b : boolean; 195 | QStart : integer; 196 | CharMode : integer; 197 | CharText : string; 198 | begin 199 | Result:=Text; 200 | n:=0; 201 | b:=False; 202 | CharMode:=0; 203 | CharText:=''; 204 | if Len=-1 then Len:=Length(Text); 205 | 206 | 207 | for i:=1 to Length(Text) do begin 208 | if (CharMode>0) and ((CharInSet(Text[i],['''','#']) and not b) or (i=Length(Text))) then begin 209 | CharMode:=0; 210 | if CharText<>'' then begin 211 | if i=Length(Text) then begin 212 | CharText:=CharText+Text[i]; 213 | inc(n); 214 | Result[n]:=Char(StrToInt(CharText)); 215 | Break; 216 | end else begin 217 | inc(n); 218 | Result[n]:=Char(StrToInt(CharText)); 219 | CharText:=''; 220 | end; 221 | end; 222 | end; 223 | 224 | if (Text[i]='''') then begin 225 | if (i>1) and (i>QStart) and (Text[i-1]='''') then begin 226 | inc(n); 227 | Result[n]:=Text[i]; 228 | end; 229 | b:=not b; 230 | if b then QStart:=i+1; 231 | Continue; 232 | end; 233 | 234 | if b then begin 235 | inc(n); 236 | Result[n]:=Text[i]; 237 | end else begin 238 | if (CharMode>0) then begin 239 | CharText:=CharText+Text[i]; 240 | end; 241 | if (CharMode=1) and (Text[i]='$') then begin 242 | CharMode:=2; 243 | end; 244 | if Text[i]='#' then begin 245 | CharMode:=1; 246 | CharText:=''; 247 | end; 248 | end; 249 | 250 | end; 251 | SetLength(Result,Min(n,Len)); 252 | end; 253 | 254 | { TStringViewerFrame } 255 | 256 | procedure TStringViewerFrame.DisplayString(const Expression, TypeName, EvalResult: string); 257 | var 258 | P,Size : integer; 259 | begin 260 | FAvailableState:=asAvailable; 261 | FExpression:=Expression; 262 | 263 | if Length(EvalResult)<1024 then begin 264 | FString:=DecodeText(EvalResult); 265 | end else begin 266 | FString:=''; 267 | 268 | P:=1; 269 | Size:=StrToIntDef(Evaluate('length('+Expression+')'),0); 270 | while p nil then 305 | FOwningForm.Close; 306 | end; 307 | 308 | procedure TStringViewerFrame.Destroyed; 309 | begin 310 | 311 | end; 312 | 313 | 314 | function TStringViewerFrame.Evaluate(Expression: string): string; 315 | var 316 | CurProcess: IOTAProcess; 317 | CurThread: IOTAThread; 318 | ResultStr: array[0..1024*1024] of Char; 319 | CanModify: Boolean; 320 | ResultAddr, ResultSize, ResultVal: LongWord; 321 | EvalRes: TOTAEvaluateResult; 322 | DebugSvcs: IOTADebuggerServices; 323 | begin 324 | begin 325 | Result := ''; 326 | if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then 327 | CurProcess := DebugSvcs.CurrentProcess; 328 | if CurProcess <> nil then 329 | begin 330 | CurThread := CurProcess.CurrentThread; 331 | if CurThread <> nil then 332 | begin 333 | EvalRes := CurThread.Evaluate(Expression, @ResultStr, Length(ResultStr), CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0); 334 | case EvalRes of 335 | erOK: Result := ResultStr; 336 | erDeferred: 337 | begin 338 | FCompleted := False; 339 | FDeferredResult := ''; 340 | FDeferredError := False; 341 | FNotifierIndex := CurThread.AddNotifier(Self); 342 | while not FCompleted do 343 | DebugSvcs.ProcessDebugEvents; 344 | CurThread.RemoveNotifier(FNotifierIndex); 345 | FNotifierIndex := -1; 346 | if not FDeferredError then 347 | begin 348 | if FDeferredResult <> '' then 349 | Result := FDeferredResult 350 | else 351 | Result := ResultStr; 352 | end; 353 | end; 354 | erBusy: 355 | begin 356 | DebugSvcs.ProcessDebugEvents; 357 | Result := Evaluate(Expression); 358 | end; 359 | end; 360 | end; 361 | end; 362 | end; 363 | end; 364 | 365 | procedure TStringViewerFrame.EvaluateComplete(const ExprStr, ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: LongWord; ReturnCode: Integer); 366 | begin 367 | FCompleted := True; 368 | FDeferredResult := ResultStr; 369 | FDeferredError := ReturnCode <> 0; 370 | end; 371 | 372 | procedure TStringViewerFrame.MarkUnavailable( 373 | Reason: TOTAVisualizerUnavailableReason); 374 | begin 375 | if Reason = ovurProcessRunning then 376 | begin 377 | FAvailableState := asProcRunning; 378 | end else if Reason = ovurOutOfScope then 379 | FAvailableState := asOutOfScope; 380 | 381 | end; 382 | 383 | procedure TStringViewerFrame.Modified; 384 | begin 385 | 386 | end; 387 | 388 | procedure TStringViewerFrame.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer); 389 | begin 390 | 391 | end; 392 | 393 | procedure TStringViewerFrame.RefreshVisualizer(const Expression, TypeName, EvalResult: string); 394 | begin 395 | FAvailableState := asAvailable; 396 | DisplayString(Expression, TypeName, EvalResult); 397 | end; 398 | 399 | procedure TStringViewerFrame.SetClosedCallback( 400 | ClosedProc: TOTAVisualizerClosedProcedure); 401 | begin 402 | FClosedProc := ClosedProc; 403 | end; 404 | 405 | procedure TStringViewerFrame.SetForm(AForm: TCustomForm); 406 | begin 407 | FOwningForm := AForm; 408 | end; 409 | 410 | procedure TStringViewerFrame.SetParent(AParent: TWinControl); 411 | begin 412 | if AParent = nil then 413 | begin 414 | FString:=''; 415 | if Assigned(FClosedProc) then 416 | FClosedProc; 417 | end; 418 | inherited; 419 | end; 420 | 421 | procedure TStringViewerFrame.ThreadNotify(Reason: TOTANotifyReason); 422 | begin 423 | 424 | end; 425 | 426 | { TStringVisualizerForm } 427 | 428 | constructor TStringVisualizerForm.Create(const Expression: string); 429 | begin 430 | inherited Create; 431 | FExpression := Expression; 432 | end; 433 | 434 | procedure TStringVisualizerForm.CustomizePopupMenu(PopupMenu: TPopupMenu); 435 | begin 436 | // no toolbar 437 | end; 438 | 439 | procedure TStringVisualizerForm.CustomizeToolBar(ToolBar: TToolBar); 440 | begin 441 | // no toolbar 442 | end; 443 | 444 | function TStringVisualizerForm.EditAction(Action: TEditAction): Boolean; 445 | begin 446 | Result := False; 447 | end; 448 | 449 | procedure TStringVisualizerForm.FrameCreated(AFrame: TCustomFrame); 450 | begin 451 | FMyFrame := TStringViewerFrame(AFrame); 452 | end; 453 | 454 | function TStringVisualizerForm.GetCaption: string; 455 | begin 456 | Result := Format(sFormCaption, [FExpression]); 457 | end; 458 | 459 | function TStringVisualizerForm.GetEditState: TEditState; 460 | begin 461 | Result := []; 462 | end; 463 | 464 | function TStringVisualizerForm.GetForm: TCustomForm; 465 | begin 466 | Result := FMyForm; 467 | end; 468 | 469 | function TStringVisualizerForm.GetFrame: TCustomFrame; 470 | begin 471 | Result := FMyFrame; 472 | end; 473 | 474 | function TStringVisualizerForm.GetFrameClass: TCustomFrameClass; 475 | begin 476 | Result := TStringViewerFrame; 477 | end; 478 | 479 | function TStringVisualizerForm.GetIdentifier: string; 480 | begin 481 | Result := 'StringDebugVisualizer'; 482 | end; 483 | 484 | function TStringVisualizerForm.GetMenuActionList: TCustomActionList; 485 | begin 486 | Result := nil; 487 | end; 488 | 489 | function TStringVisualizerForm.GetMenuImageList: TCustomImageList; 490 | begin 491 | Result := nil; 492 | end; 493 | 494 | function TStringVisualizerForm.GetToolbarActionList: TCustomActionList; 495 | begin 496 | Result := nil; 497 | end; 498 | 499 | function TStringVisualizerForm.GetToolbarImageList: TCustomImageList; 500 | begin 501 | Result := nil; 502 | end; 503 | 504 | procedure TStringVisualizerForm.LoadWindowState(Desktop: TCustomIniFile; 505 | const Section: string); 506 | begin 507 | //no desktop saving 508 | end; 509 | 510 | procedure TStringVisualizerForm.SaveWindowState(Desktop: TCustomIniFile; 511 | const Section: string; IsProject: Boolean); 512 | begin 513 | //no desktop saving 514 | end; 515 | 516 | procedure TStringVisualizerForm.SetForm(Form: TCustomForm); 517 | begin 518 | FMyForm := Form; 519 | if Assigned(FMyFrame) then 520 | FMyFrame.SetForm(FMyForm); 521 | end; 522 | 523 | procedure TStringVisualizerForm.SetFrame(Frame: TCustomFrame); 524 | begin 525 | FMyFrame := TStringViewerFrame(Frame); 526 | end; 527 | 528 | var 529 | StringVis: IOTADebuggerVisualizer; 530 | 531 | procedure Register; 532 | begin 533 | StringVis := TDebuggerStringVisualizer.Create; 534 | (BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(StringVis); 535 | end; 536 | 537 | procedure RemoveVisualizer; 538 | var 539 | DebuggerServices: IOTADebuggerServices; 540 | begin 541 | if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then begin 542 | DebuggerServices.UnregisterDebugVisualizer(StringVis); 543 | StringVis := nil; 544 | end; 545 | end; 546 | 547 | procedure TStringViewerFrame.Button1Click(Sender: TObject); 548 | begin 549 | Clipboard.AsText:=FString; 550 | end; 551 | 552 | procedure TStringViewerFrame.Button2Click(Sender: TObject); 553 | begin 554 | if FSD.Execute then begin 555 | StrToFile(FSD.FileName,FString,False); 556 | end; 557 | end; 558 | 559 | initialization 560 | finalization 561 | RemoveVisualizer; 562 | 563 | end. 564 | 565 | --------------------------------------------------------------------------------