Every now and then I use the watch window to display strings which contain sql statements.
Now I select Copy Value from the context menu and get
'SELECT NAME FROM SAMPLE_TABLE WHERE FIRST_NAME = ''George'''#$D#$A
Of course, this statement has to be reformatted if I want to execute it in a sql tool displaying the results. This is a little bit annoying.
Is there a trick / workaround for that?
I thought it would be amusing to try and work out a way to do this by adding something inside the IDE, mainly because when you posted your q, I didn't have a clue how to. It turns out that you can do it quite easily using a custom OTA package containing a unit like the one below.
Btw, I'm particularly obliged to Rob Kennedy for pointing out in another SO question that the IDE has a Screen object just like any other. That provides an easy way into the problem, bypassing the maze of OTA interfaces I've usually had to work with to code an IDE add-in.
It works by
Finding the Watch Window,
Finding the Copy Watch value item in its context menu & adding a new menu item after it
Using the OnClick handler of the new item to pick up the value from the Watch Window's focused item, re-formatting it as required, then pasting it to the Clipboard.
So far as using OTA services is concerned, it doesn't do anything fancy, but with the IDE I think the KISS principle applies.
Code:
unit IdeMenuProcessing;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Menus, ClipBrd, ComCtrls;
type
TOtaMenuForm = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
OurMenuItem : TMenuItem;
WatchWindow : TForm;
WWListView : TListView;
procedure GetWatchValue(Sender : TObject);
end;
var
OtaMenuForm: TOtaMenuForm;
procedure Register;
implementation
{$R *.dfm}
procedure ShowMenus;
begin
OtaMenuForm := TOtaMenuForm.Create(Nil);
OtaMenuForm.Show;
end;
procedure Register;
begin
ShowMenus;
end;
procedure TOtaMenuForm.FormCreate(Sender: TObject);
var
i : Integer;
S : String;
PM : TPopUpMenu;
Item : TMenuItem;
begin
// First create a menu item to insert in the Watch Window's context menu
OurMenuItem := TMenuItem.Create(Self);
OurMenuItem.OnClick := GetWatchValue;
OurMenuItem.Caption := 'Get processed watch value';
WatchWindow := Nil;
WWListView := Nil;
// Next, iterate the IDE's forms to find the Watch Window
for i := 0 to Screen.FormCount - 1 do begin
S := Screen.Forms[i].Name;
if CompareText(S, 'WatchWindow') = 0 then begin // < Localize if necessary
WatchWindow := Screen.Forms[i];
Break;
end;
end;
Assert(WatchWindow <> Nil);
if WatchWindow <> Nil then begin
// Next, scan the Watch Window's context menu to find the existing "Copy watch value" entry
// and insert our menu iem after it
PM := WatchWindow.PopUpMenu;
for i:= 0 to PM.Items.Count - 1 do begin
Item := PM.Items[i];
if CompareText('Copy Watch &Value', Item.Caption) = 0 then begin // < Localize if necessary
PM.Items.Insert(i + 1, OurMenuItem);
Break;
end;
end;
// Now, find the TListView in the Watch Window
for i := 0 to WatchWindow.ComponentCount - 1 do begin
if WatchWindow.Components[i] is TListView then begin
WWListView := WatchWindow.Components[i] as TListView;
Break;
end;
end;
Assert(WWListView <> Nil);
end;
end;
procedure TOtaMenuForm.GetWatchValue(Sender: TObject);
var
WatchValue : String;
begin
// This is called when the Watch Window menu item we added is clicked
if WWListView.ItemFocused = Nil then begin
Memo1.Lines.Add('no Watch selected');
exit;
end;
WatchValue := WWListView.ItemFocused.SubItems[0];
WatchValue := StringReplace(WatchValue, #$D#$A, ' ', [rfreplaceAll]);
if WatchValue[1] = '''' then
Delete(WatchValue, 1, 1);
if WatchValue[Length(WatchValue)] = '''' then
WatchValue := Copy(WatchValue, 1, Length(WatchValue) - 1);
// [etc]
ClipBoard.AsText := WatchValue;
Memo1.Lines.Add('>' + WatchValue + '<');
end;
initialization
finalization
if Assigned(OTAMenuForm) then begin
OTAMenuForm.Close;
FreeAndNil(OTAMenuForm);
end;
end.
Btw, I wrote this in D7 because I use that as a sort of lowest common denominator for SO answers because its quite obvious that a large number of people here still use it. Later versions have additional string functions, such as the AniDequotedStr mentioned in a comment, which might be helpful in reformatting the watch value.
Update: According to the OP, the above doesn't work with XE3 because the watch window is implemented using a TVirtualStringTree rather than a TListView. The reason I used the ListView was that I found that picking up the Watch value from the Clipboard (after simulating a click on the context menu's Copy Watch Value) to process it wasn't very reliable. That seems to have improved in XE4 (I don't have XE3 to test), so here's a version that seems to work in XE4:
Update #2: The OP mentioned that the previous version of the code below failed the WatchWindow <> Nil assertion when Delphi is first started. I imagine the reason is that the code is called before the Watch Window has been created in the IDE. I've re-arranged the code an added an OTANotifier that's used to get the notification that a project desktop has been loaded, ad uses that to called the new SetUp routine.
unit IdeMenuProcessing;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Menus, ClipBrd, ComCtrls;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
TOtaMenuForm = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
IsSetUp : Boolean;
ExistingMenuItem,
OurMenuItem : TMenuItem;
WatchWindow : TForm;
Services: IOTAServices;
Notifier : TIdeNotifier;
NotifierIndex: Integer;
procedure GetWatchValue(Sender : TObject);
procedure SetUp;
end;
var
OtaMenuForm: TOtaMenuForm;
procedure Register;
implementation
{$R *.dfm}
procedure ShowMenus;
begin
OtaMenuForm := TOtaMenuForm.Create(Nil);
OtaMenuForm.Services := BorlandIDEServices as IOTAServices;
OtaMenuForm.NotifierIndex := OtaMenuForm.Services.AddNotifier(TIdeNotifier.Create);
OtaMenuForm.Show;
end;
procedure Register;
begin
ShowMenus;
end;
procedure TOtaMenuForm.SetUp;
var
i : Integer;
S : String;
PM : TPopUpMenu;
Item : TMenuItem;
begin
if IsSetUp then exit;
// First create a menu item to insert in the Watch Window's context menu
OurMenuItem := TMenuItem.Create(Self);
OurMenuItem.OnClick := GetWatchValue;
OurMenuItem.Caption := 'Get processed watch value';
WatchWindow := Nil;
// Next, iterate the IDE's forms to find the Watch Window
for i := 0 to Screen.FormCount - 1 do begin
S := Screen.Forms[i].Name;
if CompareText(S, 'WatchWindow') = 0 then begin
WatchWindow := Screen.Forms[i];
Break;
end;
end;
Assert(WatchWindow <> Nil);
if WatchWindow <> Nil then begin
// Next, scan the Watch Window's context menu to find the existing "Copy watch value" entry
// and insert our menu item after it
PM := WatchWindow.PopUpMenu;
for i:= 0 to PM.Items.Count - 1 do begin
Item := PM.Items[i];
if CompareText('Copy Watch &Value', Item.Caption) = 0 then begin
ExistingMenuItem := Item;
PM.Items.Insert(i + 1, OurMenuItem);
if ExistingMenuItem.Action <> Nil then
Memo1.Lines.Add('Has action')
else
Memo1.Lines.Add('No action');
Break;
end;
end;
end;
Caption := 'Setup complete';
IsSetUp := True;
end;
procedure TOtaMenuForm.FormCreate(Sender: TObject);
begin
IsSetUp := False;
end;
procedure TOtaMenuForm.GetWatchValue(Sender: TObject);
var
S,
WatchValue : String;
TL : TStringList;
i : Integer;
begin
// This is called when the Watch Window menu item we added is clicked
ExistingMenuItem.Click;
WatchValue := ClipBoard.AsText;
WatchValue := StringReplace(WatchValue, '#$D#$A', #$D#$A, [rfreplaceAll]);
if WatchValue <> '' then begin
TL := TStringList.Create;
try
TL.Text := WatchValue;
WatchValue := '';
for i := 0 to TL.Count - 1 do begin
S := TL[i];
if S[1] = '''' then
Delete(S, 1, 1);
if S[Length(S)] = '''' then
S := Copy(S, 1, Length(S) - 1);
if WatchValue <> '' then
WatchValue := WatchValue + ' ';
WatchValue := WatchValue + S;
end;
finally
TL.Free;
end;
// [etc]
end;
ClipBoard.AsText := WatchValue;
Memo1.Lines.Add('>' + WatchValue + '<');
end;
{ TIdeNotifier }
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject;
var Cancel: Boolean);
begin
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if NotifyCode = ofnProjectDesktopLoad then
OTAMenuForm.SetUp
end;
initialization
finalization
if Assigned(OTAMenuForm) then begin
OTAMenuForm.Services.RemoveNotifier(OTAMenuForm.NotifierIndex);
OTAMenuForm.Close;
FreeAndNil(OTAMenuForm);
end;
end.
I'm posting this as a separate answer because it uses a different implementation
based on the ToolsAPI's debugger visualizers. There are examples in the Visualizers
sub-folder of the Delphi source code. The one which looked most promising as a
starting point is the example in the StringListVisualizer.Pas file. However, I found
that impenetrable on the first few readings and it turned out that it didn't actually
do what I was hoping for.
The code below, which of course needs to be compiled into an IDE package which
requires the rtl and designide units, is based upon the much simpler DateTime
sample visualizer, but adapted to the Text property of TStrings objects. This adaptation still required quite a lot of work, and that's the main reason I'm posting this additional answer, to save others some head-scratching.
Normally, the Text property of a TStrings variable is displayed in the Watch Window as one or more text lines surrounded by single quotes and separated by the string #$D#$A. The code removes the single quotes and replaces the #$D#$A by a space. This isdone inside the GetReplacementValue function near the top of the code. The rest of the code is just the baggage that you need to include to implement a visualizer, and there's quite a lot of it, even in this rather minimalist implementation.
Once the package is installed, as well as being displayed in the Watch Window,
the Text property can be pasted to the Clipboard using the Copy Watch Value
entry on the Watch Window's context menu.
Code (written for and tested in XE4):
{*******************************************************}
{ }
{ RadStudio Debugger Visualizer Sample }
{ Copyright(c) 2009-2013 Embarcadero Technologies, Inc. }
{ }
{*******************************************************}
{Adapted by Martyn Ayers, Bristol, UK Oct 2015}
unit SimpleTStringsVisualizeru;
interface
procedure Register;
implementation
uses
Classes, Forms, SysUtils, ToolsAPI;
resourcestring
sVisualizerName = 'TStrings Simple Visualizer for Delphi';
sVisualizerDescription = 'Simplifies TStrings Text property format';
const
CRLFReplacement = ' ';
type
TDebuggerSimpleTStringsVisualizer = 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;
TTypeLang = (tlDelphi, tlCpp);
// The following function is the one which actually changes the TStrings
// representation in the Watch Window
//
// Normally, the Text property of TStrings variable is displayed in the Watch Window
// and Evaluate window as one or more text lines surrounded by single quotes
// and separated by the string #$D#$A
//
// This implementation removes the single quotes and replaces the #$D#$A
// by a space
//
// Note the addition of '.Text' to the expression which gets evaluated; this is to
// produce the desired result when using the 'Copy Watch Value' item in the
// Watch Window context menu.
function TDebuggerSimpleTStringsVisualizer.GetReplacementValue(
const Expression, TypeName, EvalResult: string): string;
var
Lang: TTypeLang;
i: Integer;
CurProcess: IOTAProcess;
CurThread: IOTAThread;
ResultStr: array[0..4095] of Char; // was 255
CanModify: Boolean;
ResultAddr, ResultSize, ResultVal: LongWord;
EvalRes: TOTAEvaluateResult;
DebugSvcs: IOTADebuggerServices;
function FormatResult(const Input: string; out ResStr: string): Boolean;
var
TL : TStringList;
i : Integer;
S : String;
const
CRLFDisplayed = '#$D#$A';
begin
Result := True;
ResStr := '';
TL := TStringList.Create;
try
S := Input;
S := StringReplace(S, CRLFDisplayed, #13#10, [rfReplaceAll]);
TL.Text := S;
for i := 0 to TL.Count - 1 do begin
S := TL[i];
if S <> '' then begin
if S[1] = '''' then // Remove single quote at start of line
Delete(S, 1, 1);
if S[Length(S)] = '''' then // Remove single quote at end of line
S := Copy(S, 1, Length(S) - 1);
end;
if ResStr <> '' then
ResStr := ResStr + CRLFReplacement;
ResStr := ResStr + S;
end;
finally
TL.Free;
end;
end;
begin
Lang := tlDelphi;
if Lang = tlDelphi then
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then
CurProcess := DebugSvcs.CurrentProcess;
if CurProcess <> nil then
begin
CurThread := CurProcess.CurrentThread;
if CurThread <> nil then
begin
EvalRes := CurThread.Evaluate(Expression + '.Text', #ResultStr, Length(ResultStr),
CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
if EvalRes = erOK then
begin
Result := ResultStr;
end else if EvalRes = erDeferred then
begin
FCompleted := False;
FDeferredResult := '';
FNotifierIndex := CurThread.AddNotifier(Self);
while not FCompleted do
DebugSvcs.ProcessDebugEvents;
CurThread.RemoveNotifier(FNotifierIndex);
FNotifierIndex := -1;
if (FDeferredResult = '') then
Result := EvalResult
else
FormatResult(FDeferredResult, Result);
end;
end;
end;
end
else
;
end;
procedure TDebuggerSimpleTStringsVisualizer.AfterSave;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.BeforeSave;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.Destroyed;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.Modified;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.ModifyComplete(const ExprStr,
ResultStr: string; ReturnCode: Integer);
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.EvaluteComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: Cardinal;
ReturnCode: Integer);
begin
EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress),
LongWord(ResultSize), ReturnCode);
end;
procedure TDebuggerSimpleTStringsVisualizer.EvaluateComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
ReturnCode: Integer);
begin
FCompleted := True;
if ReturnCode = 0 then
FDeferredResult := ResultStr;
end;
function TDebuggerSimpleTStringsVisualizer.GetSupportedTypeCount: Integer;
begin
Result := 1;
end;
procedure TDebuggerSimpleTStringsVisualizer.GetSupportedType(Index: Integer; var TypeName: string;
var AllDescendants: Boolean);
begin
AllDescendants := True;
TypeName := 'TStrings';
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerDescription: string;
begin
Result := sVisualizerDescription;
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerIdentifier: string;
begin
Result := ClassName;
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerName: string;
begin
Result := sVisualizerName;
end;
procedure TDebuggerSimpleTStringsVisualizer.ThreadNotify(Reason: TOTANotifyReason);
begin
// don't care about this notification
end;
var
TStringsVis: IOTADebuggerVisualizer;
procedure Register;
begin
TStringsVis := TDebuggerSimpleTStringsVisualizer.Create;
(BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(TStringsVis);
end;
procedure RemoveVisualizer;
var
DebuggerServices: IOTADebuggerServices;
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then
begin
DebuggerServices.UnregisterDebugVisualizer(TStringsVis);
TStringsVis := nil;
end;
end;
initialization
finalization
RemoveVisualizer;
end.
Is it possible in Delphi to just save the breakpointss in the .DSK file for a project and no other Desktop settings?
Most of the .DSK gets in the way, but not being able to save debug breakpoints is a real pain (especially when they are conditionally or actions are attached).
I've never come across an IDE facility to save only the breakpoint-related settings in the .Dsk file.
For amusement, I thought I'd try and implement something via an IDE add-in using OTA notifications. The code below runs fine installed into a package installed in D7, and the IDE seems quite happy to re-open a project whose .Dsk file has been processed by it (and the breakpoints get set!).
As you can see, it catches an OTA notifier's FileNotification event when called with a NotifyCode of ofnProjectDesktopSave, which happens just after the IDE has saved the .Dsk file (initially with the extension '.$$$', which I faile to notice when first writing this). It then reads the saved file file, and and prepares an updated version from which all except a specified list of sections are removed. The user then has the option to save the thinned-out file back to disk. I've used a TMemIniFile to do most of the processing simply to minimize the amount of code needed.
I had zero experience of writing an OTA notifier when I read your q, but the GE Experts FAQ referenced below was immensely helpful, esp the example notifier code.
Normally, deleting a project's .Dsk file is harmless, but use this code with caution as it has not been stress-tested.
Update: I noticed that the filename received by TIdeNotifier.FileNotification event actually has an extension of '.$$$'. I'm not quite sure why that should be, but seemingly the event is called before the file is renamed to xxx.Dsk. I thought that would require a change to how
to save the thinned-out version, but evidently not.
Update#2: Having used a folder-monitoring utility to see what actually happens, it turns out that the desktop-save notification the code receives is only the first of a number of operations related to the .Dsk file. These include renaming any existing version of the .Dsk file as a .~Dsk file and finally saving the .$$$ file as the new .Dsk file.
unit DskFilesu;
interface
{$define ForDPK} // undefine to test in regular app
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, IniFiles, TypInfo
{$ifdef ForDPK}
, ToolsApi
{$endif}
;
{$ifdef ForDPK}
{
Code for OTA TIdeNotifier adapted from, and courtesy of, the link on http://www.gexperts.org/open-tools-api-faq/#idenotifier
}
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
{$endif}
type
TDskForm = class(TForm)
edDskFileName: TEdit;
SpeedButton1: TSpeedButton;
OpenDialog1: TOpenDialog;
lbSectionsToKeep: TListBox;
lbDskSections: TListBox;
moDskFile: TMemo;
btnSave: TButton;
procedure btnSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
procedure GetSectionsToKeep;
function GetDskFileName: String;
procedure SetDskFileName(const Value: String);
function GetDskFile: Boolean;
protected
public
DskIni : TMemIniFile;
property DskFileName : String read GetDskFileName write SetDskFileName;
end;
var
NotifierIndex: Integer;
DskForm: TDskForm;
{$ifdef ForDPK}
procedure Register;
{$endif}
implementation
{$R *.DFM}
{$ifdef ForDPK}
procedure Register;
var
Services: IOTAServices;
begin
Services := BorlandIDEServices as IOTAServices;
Assert(Assigned(Services), 'IOTAServices not available');
NotifierIndex := Services.AddNotifier(TIdeNotifier.Create);
end;
{$endif}
procedure DskPopUp(FileName : String);
var
F : TDskForm;
begin
F := TDskForm.Create(Application);
try
F.DskFileName := FileName;
F.ShowModal;
finally
F.Free;
end;
end;
function TDskForm.GetDskFileName: String;
begin
Result := edDskFileName.Text;
end;
procedure TDskForm.SetDskFileName(const Value: String);
begin
edDskFileName.Text := Value;
if Assigned(DskIni) then
FreeAndNil(DskIni);
btnSave.Enabled := False;
DskIni := TMemIniFile.Create(DskFileName);
DskIni.ReadSections(lbDskSections.Items);
GetSectionsToKeep;
end;
procedure TDskForm.btnSaveClick(Sender: TObject);
begin
DskIni.UpdateFile;
end;
procedure TDskForm.FormCreate(Sender: TObject);
begin
lbSectionsToKeep.Items.Add('watches');
lbSectionsToKeep.Items.Add('breakpoints');
lbSectionsToKeep.Items.Add('addressbreakpoints');
if not IsLibrary then
DskFileName := ChangeFileExt(Application.ExeName, '.Dsk');
end;
procedure TDskForm.GetSectionsToKeep;
var
i,
Index : Integer;
SectionName : String;
begin
moDskFile.Lines.Clear;
for i := lbDskSections.Items.Count - 1 downto 0 do begin
SectionName := lbDskSections.Items[i];
Index := lbSectionsToKeep.Items.IndexOf(SectionName);
if Index < 0 then
DskIni.EraseSection(SectionName);
end;
DskIni.GetStrings(moDskFile.Lines);
btnSave.Enabled := True;
end;
function TDskForm.GetDskFile: Boolean;
begin
OpenDialog1.FileName := DskFileName;
Result := OpenDialog1.Execute;
if Result then
DskFileName := OpenDialog1.FileName;
end;
procedure TDskForm.SpeedButton1Click(Sender: TObject);
begin
GetDskFile;
end;
{$ifdef ForDPK}
procedure RemoveNotifier;
var
Services: IOTAServices;
begin
if NotifierIndex <> -1 then
begin
Services := BorlandIDEServices as IOTAServices;
Assert(Assigned(Services), 'IOTAServices not available');
Services.RemoveNotifier(NotifierIndex);
end;
end;
function MsgServices: IOTAMessageServices;
begin
Result := (BorlandIDEServices as IOTAMessageServices);
Assert(Result <> nil, 'IOTAMessageServices not available');
end;
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
Cancel := False;
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
Cancel := False;
// Note: The FileName passed below has an extension of '.$$$'
if NotifyCode = ofnProjectDesktopSave then
DskPopup(FileName);
end;
initialization
finalization
RemoveNotifier;
{$endif}
end.
How can I get progress when I'm executing inno script from a command line compiler (iscc.exe)?
I can pipeline the output but I want to get % completed as well.
Use ISCmplr library instead. For an inspiration, a very basic Delphi InnoSetup compiler might look like this (of course without hardcoded paths). It uses the original CompInt.pas unit from InnoSetup source pack:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, CompInt;
const
CompLib = ISCmplrDLL;
CompPath = 'c:\Program Files (x86)\Inno Setup 5\';
CompScriptProc = {$IFNDEF UNICODE}'ISDllCompileScript'{$ELSE}'ISDllCompileScriptW'{$ENDIF};
type
TCompScriptProc = function(const Params: TCompileScriptParamsEx): Integer; stdcall;
PAppData = ^TAppData;
TAppData = record
Lines: TStringList;
LineNumber: Integer;
StatusLabel: TLabel;
ProgressBar: TProgressBar;
end;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FCompLibHandle: HMODULE;
FCompScriptProc: TCompScriptProc;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FCompLibHandle := SafeLoadLibrary(CompPath + CompLib);
if FCompLibHandle <> 0 then
FCompScriptProc := GetProcAddress(FCompLibHandle, CompScriptProc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FCompLibHandle <> 0 then
FreeLibrary(FCompLibHandle);
end;
function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
AppData: Longint): Integer; stdcall;
begin
// in every stage you can cancel the compilation if you pass e.g. a Boolean
// field through the AppData by using the following line:
// Result := iscrRequestAbort;
Result := iscrSuccess;
case Code of
iscbReadScript:
with PAppData(AppData)^ do
begin
if Data.Reset then
LineNumber := 0;
if LineNumber < Lines.Count then
begin
Data.LineRead := PChar(Lines[LineNumber]);
Inc(LineNumber);
end;
end;
iscbNotifyStatus:
Form1.Label1.Caption := Data.StatusMsg;
iscbNotifyIdle:
begin
with PAppData(AppData)^ do
begin
ProgressBar.Max := Data.CompressProgressMax;
ProgressBar.Position := Data.CompressProgress;
StatusLabel.Caption := Format('Bitrate: %d B/s; Remaining time: %d s',
[Data.BytesCompressedPerSecond, Data.SecondsRemaining]);
Application.ProcessMessages;
end;
end;
iscbNotifySuccess:
ShowMessageFmt('Yipee! Compilation succeeded; Output: %s', [Data.OutputExeFilename]);
iscbNotifyError:
ShowMessageFmt('An error occured! File: %s; Line: %d; Message: %s', [Data.ErrorFilename,
Data.ErrorLine, Data.ErrorMsg]);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
CustData: TAppData;
CompParams: TCompileScriptParamsEx;
begin
if Assigned(FCompScriptProc) then
begin
CustData.Lines := TStringList.Create;
try
CustData.Lines.LoadFromFile('c:\Program Files (x86)\Inno Setup 5\Examples\Example1.iss');
CustData.LineNumber := 0;
CustData.StatusLabel := Label1;
CustData.ProgressBar := ProgressBar1;
CompParams.Size := SizeOf(CompParams);
CompParams.CompilerPath := CompPath; // path to the folder containing *.e32 files (InnoSetup install folder)
CompParams.SourcePath := 'c:\Program Files (x86)\Inno Setup 5\Examples\'; // path to the script file to be compiled
CompParams.CallbackProc := CompilerCallbackProc; // callback procedure which the compiler calls to read the script and for status notifications
Pointer(CompParams.AppData) := #CustData; // custom data passed to the callback procedure
CompParams.Options := ''; // additional options; see CompInt.pas for description
if FCompScriptProc(CompParams) <> isceNoError then
ShowMessage('Compiler Error');
finally
CustData.Lines.Free;
end;
end;
end;
end.
I'm not sure why this isn't something that is changeable with an option set, it would be really nice if it was. And it's not even in DDevExtensions, although I can change a lot of other stuff there.
Is there a place in the Delphi 2009 IDE, or yet another extension that I can install so I can change the host application for the 30+ DLL's in my group project in one fell swoop?
Well, apparently there is no way, although for the life of me I can't think of why. So I wrote this:
(with a few props to Zarko Gajic for the file search)
unit HostAppSwitcherDialog;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, FileCtrl, msxml, msxmldom, Contnrs,
Generics.Collections;
type
TForm1 = class(TForm)
lv1: TListView;
btnFolder: TButton;
btnHostApp: TButton;
btnUpdate: TButton;
procedure btnFolderClick(Sender: TObject);
procedure btnHostAppClick(Sender: TObject);
procedure btnUpdateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure ClearList;
public
end;
TDprojHostAppInfo = class
FileName : String;
Directory : String;
HostApp : String;
function GetPath : String;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetHostApplication(const AFileName : String) : String;
var
DomDoc : IXMLDOMDocument;
DomNode : IXMLDOMNode;
begin
DomDoc := CreateDOMDocument;
if DomDoc.load(AFileName) then
begin
DomNode := DomDoc.selectSingleNode('//Parameters[#Name="HostApplication"]');
if assigned(DomNode) then
Result := DomNode.text;
end;
end;
function FileSearch(const PathName, FileName : string; const InDir : boolean) : TObjectList<TDprojHostAppInfo>;
var Rec : TSearchRec;
Path : string;
TmpFiles : TObjectList<TDprojHostAppInfo>;
DProj : TDprojHostAppInfo;
begin
Result := TObjectList<TDprojHostAppInfo>.Create(False);
Path := IncludeTrailingBackslash(PathName);
if FindFirst(Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
try
repeat
if (faReadOnly and rec.Attr) <> faReadOnly then
begin
DProj := TDprojHostAppInfo.Create;
DProj.FileName := Rec.Name;
DProj.Directory := Path;
DProj.HostApp := GetHostApplication(DProj.GetPath);
Result.Add(DProj);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
If not InDir then Exit;
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
begin
TmpFiles := FileSearch(Path + Rec.Name, FileName, True);
TmpFiles.OwnsObjects := false;
for DProj in TmpFiles do
Result.Add(DProj);
TmpFiles.Free;
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end; //procedure FileSearch
procedure SetHostApplication(const AFileName : String; const ANewHostApplication : String);
var
DomDoc : IXMLDOMDocument;
DomNode : IXMLDOMNode;
begin
DomDoc := CreateDOMDocument;
if DomDoc.load(AFileName) then
begin
DomNode := DomDoc.selectSingleNode('//Parameters[#Name="HostApplication"]');
if assigned(DomNode) then
DomNode.text := ANewHostApplication;
end;
DomDoc.save(AFileName);
end;
procedure TForm1.btnHostAppClick(Sender: TObject);
var
NewHostApp : String;
lvi : TListItem;
DProj : TDprojHostAppInfo;
begin
NewHostApp := InputBox('New Host Application', 'Please type the new host application', 'w:\bcproc\');
for lvi in lv1.Items do
if lvi.Selected then
begin
DProj := TDprojHostAppInfo(lvi.Data);
DProj.HostApp := NewHostApp;
lvi.SubItems[0] := NewHostApp;
end;
end;
procedure TForm1.btnUpdateClick(Sender: TObject);
var
lvi : TListItem;
dproj : TDprojHostAppInfo;
begin
for lvi in lv1.Items do
if lvi.Checked then
begin
dproj := TDprojHostAppInfo(lvi.Data);
SetHostApplication(dproj.GetPath, dproj.HostApp);
end;
end;
procedure TForm1.ClearList;
var
lvi : TListItem;
dproj : TDprojHostAppInfo;
begin
for lvi in lv1.Items do
begin
dproj := TDprojHostAppInfo(lvi.Data);
dproj.Free;
end;
lv1.Clear;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearList;
end;
procedure TForm1.btnFolderClick(Sender: TObject);
var
Options : TSelectDirOpts;
ChosenDir : string;
Files : TObjectList<TDprojHostAppInfo>;
DProj : TDprojHostAppInfo;
lvi : TListItem;
begin
ClearList;
ChosenDir := 'C:\';
if SelectDirectory(ChosenDir, Options, 0) then
begin
Files := FileSearch(ChosenDir, '*.dproj', True);
for DProj in Files do
begin
lvi := lv1.Items.Add;
lvi.Caption := DProj.FileName;
lvi.SubItems.Add(DProj.HostApp);
lvi.Data := DProj;
end;
Files.Free;
end;
end;
function TDprojHostAppInfo.GetPath: String;
begin
Result := Directory + '\' + FileName;
end;
end.
I'll let you write your own DFM, as mine is not pretty.
Since dproj's are just XML files, you can load them and save them. I didn't include ReadOnly ones in the list of things to change on account of still using VSS, but I'd probably take that out of we ever switch to SVN for Delphi XE2.
I am working in an delphi IDE expert , and I need enumerate all the forms displayed by the Delphi IDE, currently i am using the Screen.Forms property , but i am wondering if exist another way to do this using the OTA. because using the Screen.Forms only works when my expert is a BPL but now i am migrating to a dll expert.
Screen.Forms should still work from a DLL. Just make sure you compile your DLL with the "use runtime packages" linker option selected. That way, your DLL will use the same VCL instance as the IDE, and you'll have access to all the same global variables, including Screen.
This is perfectly possible with the OpenToolsAPI.
To extract a list of all opened forms in the IDE, you could use something like this:
procedure GetOpenForms(List: TStrings);
var
Services: IOTAModuleServices;
I: Integer;
Module: IOTAModule;
J: Integer;
Editor: IOTAEditor;
FormEditor: IOTAFormEditor;
begin
if (BorlandIDEServices <> nil) and (List <> nil) then
begin
Services := BorlandIDEServices as IOTAModuleServices;
for I := 0 to Services.ModuleCount - 1 do
begin
Module := Services.Modules[I];
for J := 0 to Module.ModuleFileCount - 1 do
begin
Editor := Module.ModuleFileEditors[J];
if Assigned(Editor) then
if Supports(Editor, IOTAFormEditor, FormEditor) then
List.AddObject(FormEditor.FileName,
(Pointer(FormEditor.GetRootComponent)));
end;
end;
end;
end;
Note that the pointer in that StringList is an IOTAComponent. To resolve this to the TForm instance you must dig deeper. To be continued.
It's also possible to keep track of all forms being opened in the IDE by adding a notifier of type IOTAIDENotifier to the IOTAServices, as follows:
type
TFormNotifier = class(TNotifierObject, IOTAIDENotifier)
public
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: String; var Cancel: Boolean);
end;
procedure Register;
implementation
var
IdeNotifierIndex: Integer = -1;
procedure Register;
var
Services: IOTAServices;
begin
if BorlandIDEServices <> nil then
begin
Services := BorlandIDEServices as IOTAServices;
IdeNotifierIndex := Services.AddNotifier(TFormNotifier.Create);
end;
end;
procedure RemoveIdeNotifier;
var
Services: IOTAServices;
begin
if IdeNotifierIndex <> -1 then
begin
Services := BorlandIDEServices as IOTAServices;
Services.RemoveNotifier(IdeNotifierIndex);
end;
end;
{ TFormNotifier }
procedure TFormNotifier.AfterCompile(Succeeded: Boolean);
begin
// Do nothing
end;
procedure TFormNotifier.BeforeCompile(const Project: IOTAProject;
var Cancel: Boolean);
begin
// Do nothing
end;
procedure TFormNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: String; var Cancel: Boolean);
begin
if BorlandIDEServices <> nil then
if (NotifyCode = ofnFileOpening) then
begin
//...
end;
end;
initialization
finalization
RemoveIdeNotifier;
end.