Making Source writable from the Delphi IDE - delphi

Is it possible to make readonly source code (eg., .pas & .dfm) writable from within the Delphi IDE? The right click option to make files Readonly/Writable within the IDE doesn't change the properties on the file system. Is there an IDE extension or similar that can achieve this?
A way to do this without having to integrate a source control system would be preferable. I am using Delphi XE and Delphi 6.
Thanks!
sse

This is how I would do it.
Create a new package which will be installed into the IDE at designtime. If you have an existing package handy then you could carry on using it. Make sure the package requires the designide package. You can do this in the project manager, or just by viewing the project source and adding designide to the requires clause.
Now add the following unit to your package.
unit MakeEditable;
interface
procedure Register;
implementation
uses
Windows, SysUtils, Menus, ToolsAPI;
type
TMakeEditable = class(TObject)
private
FEditorServices: IOTAEditorServices;
FFileMenu: TMenuItem;
FMakeEditable: TMenuItem;
function MenuItemWithCaptionLike(const Menu: TMenuItem; const DesiredCaption: string): TMenuItem;
procedure MakeEditableClick(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
end;
constructor TMakeEditable.Create;
var
Index: Integer;
PreviousMenuItem: TMenuItem;
begin
inherited;
FEditorServices := (BorlandIDEServices as IOTAEditorServices);
FFileMenu := MenuItemWithCaptionLike((BorlandIDEServices as INTAServices40).MainMenu.Items, 'File');
if Assigned(FFileMenu) then begin
PreviousMenuItem := MenuItemWithCaptionLike(FFileMenu, 'Reopen');
if Assigned(PreviousMenuItem) then begin
Index := PreviousMenuItem.MenuIndex;
if Index>=0 then begin
FMakeEditable := TMenuItem.Create(FFileMenu);
FMakeEditable.Caption := 'Ma&ke Editable';
FMakeEditable.OnClick := MakeEditableClick;
FFileMenu.Insert(Index, FMakeEditable);
end;
end;
end;
end;
destructor TMakeEditable.Destroy;
begin
FMakeEditable.Free;
inherited;
end;
function TMakeEditable.MenuItemWithCaptionLike(const Menu: TMenuItem; const DesiredCaption: string): TMenuItem;
var
i: Integer;
Target, Found: string;
begin
Target := StringReplace(LowerCase(Trim(DesiredCaption)), '&', '', [rfReplaceAll, rfIgnoreCase]);
for i := 0 to Menu.Count-1 do begin
Result := Menu.Items[i];
Found := StringReplace(LowerCase(Trim(Result.Caption)), '&', '', [rfReplaceAll, rfIgnoreCase]);
if Pos(Target, Found)>0 then begin
exit;
end;
end;
Result := nil;
end;
procedure TMakeEditable.MakeEditableClick(Sender: TObject);
procedure MakeFileEditable(const FileName: string);
var
Attributes: DWORD;
begin
Attributes := GetFileAttributes(PChar(FileName));
SetFileAttributes(PChar(FileName), Attributes and not FILE_ATTRIBUTE_READONLY);
end;
var
FileName: string;
FileExt: string;
LinkedFileName: string;
EditBuffer: IOTAEditBuffer;
begin
EditBuffer := FEditorServices.TopBuffer;
FileName := EditBuffer.FileName;
if FileExists(FileName) then begin
MakeFileEditable(FileName);
EditBuffer.IsReadOnly := False;
FileExt := ExtractFileExt(FileName);
if SameText(FileExt,'.dfm') then begin
LinkedFileName := ChangeFileExt(FileName, '.pas');
end else if SameText(FileExt,'.pas') then begin
LinkedFileName := ChangeFileExt(FileName, '.dfm');
end else begin
LinkedFileName := '';
end;
if (LinkedFileName<>'') and FileExists(LinkedFileName) then begin
MakeFileEditable(LinkedFileName);
end;
end;
end;
var
MakeEditableInstance: TMakeEditable;
procedure Register;
begin
MakeEditableInstance := TMakeEditable.Create;
end;
initialization
finalization
MakeEditableInstance.Free;
end.
When you compile and install this package you will now have a new menu item on the File menu which both clears the read-only flag in the input buffer and makes the file writeable.

You can call a .bat file from the tools menu. So you could write a .bat file to do the work for you, and call it with $EDNAME as the parameter.
Your .bat file should see the filename as %1. Then you'd need a little bit of logic to change the read-only flag (attrib command?) and then see if there is a .dfm and do that one as well.
You could also (obviously) make a Delphi command-line app to do this, if you're not comfortable with .bat files.
This idea inspired by this article that talks about how to use a .bat file to integrate SVN commands with the Delphi tools menu:
http://delphi.wikia.com/wiki/Adding_TortoiseSVN_to_the_Tools_menu

Another idea: Just add an option to the tools menu: "open command prompt here". It lets you do all sorts of things from the command line, such as running the attrib command.
Add a new entry to the Tools menu, and use these settings:
Title: Open Command Prompt Here
Program: cmd.exe
Working Dir (leave blank)
Parameters: cd $PATH($EDNAME)
Also, make yourself an "Open Folder Here" entry:
Title: Open Folder Here
Program: explorer.exe
Working Dir (leave blank)
Parameters: $PATH($EDNAME)

Related

Why does the DOF remove lines?

I'm trying to write a plugin for Delphi 5 that will store the paths to our testing exes in the DOF so that there is a direct association between the project and the tests for that project. When I go to add my own module to the DOF file, something like
[DUint Plugin]
IntegrationTestExe=Somepath
UnitTestExeList=Some;Path;
Anytime I go to add this either manually or through code, when I save the project, the lines I add are removed. I chalked this up to maybe the IDE just doesn't allow custom modules in the DOF.
However, we use a third party plugin called EurekaLog. EurekaLog injects its own vars into the DOF and when you save, those vars are not removed. I copied much of the code over so I could test if the EurekaLog code would work properly (through some magic) but their code just wrote their module to the DOF and did nothing else special.
Does anyone know how this is accomplished in EurekaLog? Do I need to register my module somewhere so that the IDE knows not to remove it?
Update After a bit of experimenting, it seems that saving settings to the DOF is actually noticeably more reliable than saving them to the DSK file.
Add another TEdit to the form and create LoadDOFSettings and SaveDOFSettings
analogous to the existing LoadSettings and SaveSettings and call them on receipt
of the DesktopLoad and DesktoSave notifications. The SaveDOFSettings doesn't need to be called via the Timer1 event because the renaming doesn't seem to happen to the DOF.
Original answer
I suggest that before reading this answer, you do a File | Close All in the IDE,
create a new package, add the unit below into it and install it in the IDE.
The purpose of the package is two-fold, firstly to show how to save custom settings in the DSK file and secondly to give you an idea of what event information about project
files you can get from the IDE via the services in the ToolsAPI unit..
Once you've installed the package, keep an eye on its form, which shows you file notifications in the upper memo as you open, work on and close a project. There are
several things to notice:
When you open a project, the last notification you receive is about its DSK file having been opened.
Not every file type is the subject of a notification. In particular, you don't receive any notifications specifically about the DOF file, so if you want to write to it and later read from it, you have to make assumptions about when it's safe (or not) to do so, and this is possibly why you have run into the problem you are asking about.
When you do a Close All on the project, the last file change you get notified about is the DSK being written. The catch is that it's initially written to a file of the same name but with the extension .$$$. Very soon afterwards, but asaics you can't tell exactly when, this .$$$ file is renamed to .DSK.
The form created by the code below has an edit box, edMyValue' which can be used to set a value in a section of the DSK file calledMySettingsand which is reloaded the next time the project is opened. The writing of theMySettings` section of the DSK file is triggered aby a TTimer with a 2-second delay to give the IDE time to write and rename the DSK file as I've described. This obviously provides the opportunity for a race condition.
You might like to refer to
http://www.gexperts.org/open-tools-api-faq/#dsk
(GExperts is the IDE add-in tool that's been around since very early days of Delphi)
The section of the article is talking about the current project's .DSK file. Like the DOF, this is in INI file format, with sections like
[Closed Files]
[Modules]
[EditWindow0]
[View0]
As you'll see it says
check for the ofnProjectDesktopLoad and ofnProjectDesktopSave NotifyCode values. When you see one of those, you can save/load values from the file indicated by the FileName parameter using a class such as TIniFile.
Perhaps it's a bit trickier than the article suggests, because of the renaming business.
Have fun!
unit IDEEventsu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Grids, IniFiles;
type
TFileEventsForm = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
edMyValue: TEdit;
btnClear: TButton;
Timer1: TTimer;
Memo2: TMemo;
procedure btnClearClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
function GetCurrentProject: IOTAProject;
public
// The following are using interfaces accessible via the ToolsAPI
Services: IOTAServices;
ProjectGroup : IOTAProjectGroup;
Project: IOTAProject;
Options : IOTAProjectOptions;
ModServices: IOTAModuleServices;
Module: IOTAModule;
NotifierIndex: Integer; // This is used to disconnect our notifier from the IDE
IsSetUp : Boolean;
SetUpCount : Integer;
DskFileName : String;
procedure SetUp;
procedure SaveSettings;
procedure LoadSettings;
end;
var
FileEventsForm: TFileEventsForm;
procedure Register;
[...]
uses
typinfo;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
// This is the class we use to receive file notication events from the IDE via the
// interfaces in ToolsAPI.Pas
//
// It needs to implement the IOTANotifier and IOTAIDENotifier interfaces and,
// once registered with the IDE, the IDE calls its methods as a kind of call-back
// mechanism so that it gets notified of file events
//
// Note that this file also provides a form for displaying the received event
// notifications and that the IOTANotifier and IOTAIDENotifier interfaces could
// just as easily be implemented by the form itself
protected
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;
// This is necessary to register the package in the IDE
var
Notifier : TIdeNotifier;
begin
FileEventsForm:= TFileEventsForm.Create(Nil);
FileEventsForm.Services := BorlandIDEServices as IOTAServices;
Notifier := TIdeNotifier.Create;
Notifier.Form := FileEventsForm;
FileEventsForm.NotifierIndex := FileEventsForm.Services.AddNotifier(TIdeNotifier.Create);
end;
procedure CloseDown;
begin
FileEventsForm.Services.RemoveNotifier(FileEventsForm.NotifierIndex);
FileEventsForm.Close;
FileEventsForm.Free;
end;
function NotifyCodeString(NotifyCode : TOTAFileNotification) : String;
begin
Result := Copy(GetEnumName(TypeInfo(TOTAFileNotification), Ord(NotifyCode)), 4, MaxInt);
end;
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 True {NotifyCode in [ofnProjectDesktopLoad, ofnActiveProjectChanged]} then begin
FileEventsForm.Show;
FileEventsForm.Memo1.Lines.Add(Format('%s file: %s', [NotifyCodeString(NotifyCode), FileName]));
case NotifyCode of
ofnProjectDesktopLoad,
ofnDefaultDesktopLoad : begin
FileEventsForm.DskFileName := FileName;
FileEventsForm.LoadSettings;
end;
ofnProjectDesktopSave,
ofnDefaultDesktopSave : begin
if True{CompareText(ExtractFileExt(FileName), '.DSK') = 0} then begin
FileEventsForm.Caption := FileName;
FileEventsForm.Timer1.Enabled := True; // causes DSK file to be updated after Timer1.Interval (=2000ms)
end;
end;
end; { case }
end;
end;
procedure TFileEventsForm.btnClearClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
function TFileEventsForm.GetCurrentProject: IOTAProject;
var
i: Integer;
begin
Result := nil;
ModServices := BorlandIDEServices as IOTAModuleServices;
for i := 0 to ModServices.ModuleCount - 1 do
begin
Module := ModServices.Modules[i];
if Supports(Module, IOTAProjectGroup, ProjectGroup) then begin
Result := ProjectGroup.ActiveProject;
Options := Result.ProjectOptions;
Exit;
end
else if Supports(Module, IOTAProject, Project) then
begin // In the case of unbound packages, return the 1st
if Result = nil then begin
Result := Project;
Options := Result.ProjectOptions;
end;
end;
end;
end;
procedure TFileEventsForm.SetUp;
begin
Project := GetCurrentProject;
Inc(SetUpCount);
Caption := 'Setup done ' + IntToStr(SetUpCount);
IsSetUp := True;
end;
procedure TFileEventsForm.LoadSettings;
var
Ini : TMemIniFile;
S : String;
begin
Ini := TMemIniFile.Create(DSKFileName);
try
S := Ini.ReadString('MySettings', 'Name', 'no value');
edMyValue.Text := S;
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.SaveSettings;
var
Ini : TMemIniFile;
S : String;
begin
S := DSKFileName;
Caption := 'Saving: ' + S;
Ini := TMemIniFile.Create(S);
try
Ini.WriteString('MySettings', 'Name', edMyValue.Text);
Ini.UpdateFile;
Ini.ReadSections(Memo2.Lines);
Memo2.Lines.Add('This file : ' + DSKFileName);
edMyValue.Text := '?';
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
SaveSettings;
end;
initialization
finalization
CloseDown;
end.

Add menu item to unit's tab context menu in Delphi IDE using ToolsAPI

I am looking to find out which services/interface I need to use to add an item to the right-click menu of a source file in the Delphi IDE.
For example, if I right-click on a unit's tab, it has items to "Close page", "Close all other pages", "Properties", etc. I want to add custom items to that menu, if possible.
I looked over the ToolsAPI unit but I have no clue where to begin. I assume there's an interface I can use to enumerate items and add items, but I dont know where to start looking.
If that's not possible, I'd settle for the code editor's context menu.
Maybe there's some samples online for this, but I'm still looking and have found none.
Any help appreciated.
Remy Lebeau has pointed you in exactly the right directions with his link to
the GExperts guide.
If you've not done this sort of stuff before, it can still
be a bit of a performance to get started on writing your own IDE add-in, so
I've set out below a minimal example of how to add an item to the code editor's
pop-up menu.
What you do, obviously, is to create a new package, add the unit below to it,
and then install the package in the IDE. The call to Register in the unit
does what's necessary to install the new item in the editor pop-up menu.
Make sure that the code editor is open at the time you install the package. The
reason is that, as you'll see, the code checks whether there is an active editor
at the time. I've left how to ensure that the pop-up item gets added even if there
is no code editor active at the time. Hint: if you look at the ToolsAPI.Pas unit for whichever
version of Delphi you're using, you'll find that it includes various kinds of notifier,
and you can use a notification from at least one of them to defer checking if there
is an editor active until one is likely to be.
Btw, the code adds the menu item to the context menu which pops up over the editor window itself rather than the active tab. Part of the fun with IDE add-ins is the fun of experimenting to see if you can get exactly what you want. I haven't tried it myself, but I doubt that adding the menu item to the context menu of one of the editor tabs would be that difficult - seeing as the Delphi IDE is a Delphi app, as you can see from the code below, you can use FindComponent (or just iterate over a Components collection) to find what you want. However, it is better, if you can, to locate things via the ToolsAPI interfaces. See Update below.
interface
uses
Classes, Windows, Menus, Dialogs, ToolsAPI;
type
TIDEMenuItem = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
function GetName: string;
function GetIDString: string;
function GetMenuText: string;
function GetState: TWizardState;
procedure Execute;
end;
TIDEMenuHandler = class(TObject)
procedure HandleClick(Sender: TObject);
end;
procedure Register;
implementation
var
MenuItem: TMenuItem;
IDEMenuHandler: TIDEMenuHandler;
EditorPopUpMenu : TPopUpMenu;
procedure TIDEMenuItem.Execute;
begin
ShowMessage('Execute');
end;
function TIDEMenuItem.GetIDString: string;
begin
Result := 'IDEMenuItemID';
end;
function TIDEMenuItem.GetMenuText: string;
begin
Result := 'IDEMenuItemText';
end;
function TIDEMenuItem.GetName: string;
begin
Result := 'IDEMenuItemName';
end;
function TIDEMenuItem.GetState: TWizardState;
begin
Result := [wsEnabled];
end;
procedure TIDEMenuHandler.HandleClick(Sender: TObject);
begin
ShowMessage(TIDEMenuItem(Sender).GetName + ' Clicked');
end;
procedure AddIDEMenu;
var
NTAServices: INTAServices40;
EditorServices: IOTAEditorServices;
EditView: IOTAEditView;
begin
NTAServices := BorlandIDEServices as INTAServices40;
EditorServices := BorlandIDEServices as IOTAEditorServices;
EditView := EditorServices.TopView;
if Assigned(EditView) then begin
EditorPopUpMenu := TPopUpMenu(EditView.GetEditWindow.Form.FindComponent('EditorLocalMenu'));
Assert(EditorPopUpMenu <>Nil);
IDEMenuHandler := TIDEMenuHandler.Create;
MenuItem := TMenuItem.Create(Nil);
MenuItem.Caption := 'Added IDE editor menu item';
MenuItem.OnClick := IDEMenuHandler.HandleClick;
EditorPopUpMenu.Items.Add(MenuItem)
end
else
ShowMessage('Code editor not active');
end;
procedure RemoveIDEMenu;
begin
if MenuItem <> Nil then begin
EditorPopUpMenu.Items.Remove(MenuItem);
FreeAndNil(MenuItem);
IDEMenuHandler.Free;
end;
end;
procedure Register;
begin
RegisterPackageWizard(TIDEMenuItem.Create);
AddIDEMenu;
end;
initialization
finalization
RemoveIDEMenu;
end.
Update: The following code finds the TabControl of the editor window and adds the menu item to its context menu. However, note that it does not account for there being a second editor window open.
procedure AddIDEMenu;
var
NTAServices: INTAServices40;
EditorServices: IOTAEditorServices;
EditView: IOTAEditView;
TabControl : TTabControl;
function FindTabControl(AComponent : TComponent) : TTabControl;
var
i : Integer;
begin
Result := Nil;
if CompareText(AComponent.ClassName, 'TXTabControl') = 0 then begin
Result := TTabControl(AComponent);
exit;
end
else begin
for i := 0 to AComponent.ComponentCount - 1 do begin
if CompareText(AComponent.Components[i].ClassName, 'TXTabControl') = 0 then begin
Result := TTabControl(AComponent.Components[i]);
exit;
end
else begin
Result := FindTabControl(AComponent.Components[i]);
if Result <> Nil then
exit;
end;
end;
end;
end;
begin
NTAServices := BorlandIDEServices as INTAServices40;
EditorServices := BorlandIDEServices as IOTAEditorServices;
EditView := EditorServices.TopView;
if Assigned(EditView) then begin
TabControl := FindTabControl(EditView.GetEditWindow.Form);
Assert(TabControl <> Nil, 'TabControl not found');
EditorPopUpMenu := TabControl.PopupMenu;
Assert(EditorPopUpMenu <> Nil, 'PopUP menu not found');
//EditorPopUpMenu := TPopUpMenu(EditView.GetEditWindow.Form.FindComponent('EditorLocalMenu'));
Assert(EditorPopUpMenu <>Nil);
IDEMenuHandler := TIDEMenuHandler.Create;
MenuItem := TMenuItem.Create(Nil);
MenuItem.Caption := 'Added IDE editor menu item';
MenuItem.OnClick := IDEMenuHandler.HandleClick;
EditorPopUpMenu.Items.Add(MenuItem)
end
else
ShowMessage('No editor active');
end;

Writing to the Windows Event Log using Delphi

How can my Delphi app easily write to the Windows Event Log?
What is the difference between TEventLogger and ReportEvent?
How do I use the ReportEvent function?
If you are writing a Windows Service and need to write to the local machine's Windows Event Log then you can call
TService.LogMessage as mentioned here.
//TMyTestService = class(TService)
procedure TMyTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
LogMessage('This is an error.');
LogMessage('This is another error.', EVENTLOG_ERROR_TYPE);
LogMessage('This is information.', EVENTLOG_INFORMATION_TYPE);
LogMessage('This is a warning.', EVENTLOG_WARNING_TYPE);
end;
For any other type of applications you can use the SvcMgr.TEventLogger undocumented helper class for TService to write the the local machine's Windows Event Log as mentioned here, here and here.
uses
SvcMgr;
procedure TForm1.EventLoggerExampleButtonClick(Sender: TObject);
begin
with TEventLogger.Create('My Test App Name') do
begin
try
LogMessage('This is an error.');
LogMessage('This is another error.', EVENTLOG_ERROR_TYPE);
LogMessage('This is information.', EVENTLOG_INFORMATION_TYPE);
LogMessage('This is a warning.', EVENTLOG_WARNING_TYPE);
finally
Free;
end;
end;
end;
You can also use the Windows API ReportEvent function as mentioned here and here.
I've created a simple class to make it easier, it is available on GitHub.
//----------------- EXAMPLE USAGE: ---------------------------------
uses
EventLog;
procedure TForm1.EventLogExampleButtonClick(Sender: TObject);
begin
TEventLog.Source := 'My Test App Name';
TEventLog.WriteError('This is an error.');
TEventLog.WriteInfo('This is information.');
TEventLog.WriteWarning('This is a warning.');
end;
//------------------------------------------------------------------
unit EventLog;
interface
type
TEventLog = class
private
class procedure CheckEventLogHandle;
class procedure Write(AEntryType: Word; AEventId: Cardinal; AMessage: string); static;
public
class var Source: string;
class destructor Destroy;
class procedure WriteInfo(AMessage: string); static;
class procedure WriteWarning(AMessage: string); static;
class procedure WriteError(AMessage: string); static;
class procedure AddEventSourceToRegistry; static;
end;
threadvar EventLogHandle: THandle;
implementation
uses Windows, Registry, SysUtils;
class destructor TEventLog.Destroy;
begin
if EventLogHandle > 0 then
begin
DeregisterEventSource(EventLogHandle);
end;
end;
class procedure TEventLog.WriteInfo(AMessage: string);
begin
Write(EVENTLOG_INFORMATION_TYPE, 2, AMessage);
end;
class procedure TEventLog.WriteWarning(AMessage: string);
begin
Write(EVENTLOG_WARNING_TYPE, 3, AMessage);
end;
class procedure TEventLog.WriteError(AMessage: string);
begin
Write(EVENTLOG_ERROR_TYPE, 4, AMessage);
end;
class procedure TEventLog.CheckEventLogHandle;
begin
if EventLogHandle = 0 then
begin
EventLogHandle := RegisterEventSource(nil, PChar(Source));
end;
if EventLogHandle <= 0 then
begin
raise Exception.Create('Could not obtain Event Log handle.');
end;
end;
class procedure TEventLog.Write(AEntryType: Word; AEventId: Cardinal; AMessage: string);
begin
CheckEventLogHandle;
ReportEvent(EventLogHandle, AEntryType, 0, AEventId, nil, 1, 0, #AMessage, nil);
end;
// This requires admin rights. Typically called once-off during the application's installation
class procedure TEventLog.AddEventSourceToRegistry;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + Source, True) then
begin
reg.WriteString('EventMessageFile', ParamStr(0)); // The application exe's path
reg.WriteInteger('TypesSupported', 7);
reg.CloseKey;
end
else
begin
raise Exception.Create('Error updating the registry. This action requires administrative rights.');
end;
finally
reg.Free;
end;
end;
initialization
TEventLog.Source := 'My Application Name';
end.
ReportEvent supports writing a log entry to either a local or remote machine's Event Log. For a remote example see John Kaster's EDN article.
Note that you would also have to create a message file and register your event source otherwise all your log messages will be starting with something like this:
The description for Event ID xxx from source xxxx cannot be
found. Either the component that raises this event is not installed on
your local computer or the installation is corrupted. You can install
or repair the component on the local computer.
If the event originated on another computer, the display information
had to be saved with the event.
The following information was included with the event:
1, For more information on how to create a message file see Finn Tolderlund's tutorial or Michael Hex's article
or you can use an existing MC and RES file included in the GitHub project.
2, Embed the RES file into your application by including the MessageFile.res in your DPR file. Alternatively you can create a dll for the messages.
program MyTestApp;
uses
Forms,
FormMain in 'FormMain.pas' {MainForm},
EventLog in 'EventLog.pas';
{$R *.res}
{$R MessageFile\MessageFile.res}
begin
Application.Initialize;
3, The once-off registration requires admin rights writing to the registry so it us usually done as part of your application's installation process.
//For example
AddEventSourceToRegistry('My Application Name', ParamStr(0));
//or
AddEventSourceToRegistry('My Application Name', 'C:\Program Files\MyApp\Messages.dll');
//--------------------------------------------------
procedure AddEventSourceToRegistry(ASource, AFilename: string);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + ASource, True) then
begin
reg.WriteString('EventMessageFile', AFilename);
reg.WriteInteger('TypesSupported', 7);
reg.CloseKey;
end
else
begin
raise Exception.Create('Error updating the registry. This action requires administrative rights.');
end;
finally
reg.Free;
end;
end;
If you have need Windows event logging and other logging requirements you can also use logging frameworks such as log4d and TraceTool
See here if you want to write to the Event Log window in the Delphi IDE.

How to open .pas file from another app in already open Delphi IDE and position to line#

Assuming I have the Delphi IDE open, how can I open a .pas file selected in another app and open it in the Delphi IDE, as well as positioning it to a specific line number?
I've seen some editing tools do this.
I'm not sure if it's just an option to a normal file open (eg., using default file association), or a command-line option, or you need DDE or COM or something entirely different.
Note that I don't want to close the project and reopen a new or fake project.
Also, I don't want the file added to the project. I just want to open it.
For example, When you <ctrl>-click on a varible or type, the IDE will open the file containing that symbol and go to the line where that symbol is declared. That's all I want to do -- but from an external app. (I'm not looking for a symbol, just a line.)
I'm using Delphi XE5 at the moment, so I'm interested in newer Delphi versions, not pre-XE2 or so.
(Part of the question is, how do I ensure that if the IDE is already open, the the file is opened in anew tab inside of the current IDE rather than in another instance of the IDE?)
The code below (for D7) shows how this can be done by way of an IDE add-in .Dpk compiled
into a Bpl. It started as just a "proof of concept", but it does actually work.
It comprises a "sender" application which uses WM_COPYDATA to send the FileName, LineNo & Column to a receiver hosted in the .Bpl file.
The sender sends the receiver a string like
Filename=d:\aaad7\ota\dskfilesu.pas
Line=8
Col=12
Comment=(* some comment or other*)
The Comment line is optional.
In the .Bpl, the receiver uses OTA services to open the requested file and positions the editor caret, then inserts the comment, if any.
The trickiest thing was to find out how to handle one particular complication, the case where the named file to be opened is one with an associated form. If so, in D7 (and, I assume, other IDE versions with the floating designer option enabled) when the IDE
opens the .Pas file, it also opens the .Dfm, and left to its own devices, that would leave the form editor in front of the code editor. Calling the IOTASourceEditor.Show for the .Pas file at least puts the IDE code editor in front of the .Dfm form, but that didn't satisfy me, because by now my curiosity was piqued - how do you get a form the IDE is displaying off the screen?
I spent a lot of time exploring various blind alleys, because the OTA + NTA services don't seem to provide any way to explicitly close an IOTAEditor or any of its descendants. In the end it turned out that the thing to do is simply get a reference to the form and just send it a WM_CLOSE(!) - see comments in the code.
Fwiw, being a novice at OTA, at first (before I found out how IOTAModules work) I found that far and away the most difficult part of this was discovering how to get hold of the IEditView interface needed to set the editor caret position, but as usual with these interfacey things, once you get the "magic spell" exactly right, it all works.
Good luck! And thanks for the fascinating challenge!
unit Receiveru;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI;
type
TOTAEditPosnForm = class(TForm)
Memo1: TMemo;
private
FEdLine: Integer;
FEdCol: Integer;
FEditorFileName: String;
FEditorInsert: String;
procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
procedure HandleCopyDataString(CopyDataStruct : PCopyDataStruct);
procedure OpenInIDEEditor;
property EditorFileName : String read FEditorFileName write FEditorFileName;
property EdLine : Integer read FEdLine write FEdLine;
property EdCol : Integer read FEdCol write FEdCol;
property EditorInsert : String read FEditorInsert write FEditorInsert;
end;
var
OTAEditPosnForm: TOTAEditPosnForm;
procedure Register;
implementation
{$R *.dfm}
procedure MonitorFiles;
begin
OTAEditPosnForm := TOTAEditPosnForm.Create(Nil);
OTAEditPosnForm.Show;
end;
procedure Register;
begin
MonitorFiles;
end;
procedure TOTAEditPosnForm.OpenInIDEEditor;
var
IServices : IOTAServices;
IActionServices : IOTAActionServices;
IModuleServices : IOTAModuleServices;
IEditorServices : IOTAEditorServices60;
IModule : IOTAModule;
i : Integer;
IEditor : IOTAEditor;
ISourceEditor : IOTASourceEditor;
IFormEditor : IOTAFormEditor;
IComponent : IOTAComponent;
INTAComp : INTAComponent;
AForm : TForm;
IEditView : IOTAEditView;
CursorPos : TOTAEditPos;
IEditWriter : IOTAEditWriter;
CharPos : TOTACharPos;
InsertPos : Longint;
FileName : String;
begin
IServices := BorlandIDEServices as IOTAServices;
Assert(Assigned(IServices), 'IOTAServices not available');
IServices.QueryInterface(IOTAACtionServices, IActionServices);
if IActionServices <> Nil then begin
IServices.QueryInterface(IOTAModuleServices, IModuleServices);
Assert(IModuleServices <> Nil);
// Close all files open in the IDE
IModuleServices.CloseAll;
if IActionServices.OpenFile(EditorFileName) then begin
// At this point, if the named file has an associated .DFM and
// we stopped here, the form designer would be in front of the
// code editor.
IModule := IModuleServices.Modules[0];
// IModule is the one holding our .Pas file and its .Dfm, if any
// So, iterate the IModule's editors until we find the one
// for the .Pas file and then call .Show on it. This will
// bring the code editor in front of the form editor.
ISourceEditor := Nil;
for i := 0 to IModule.ModuleFileCount - 1 do begin
IEditor := IModule.ModuleFileEditors[i];
FileName := IEditor.FileName;
Memo1.Lines.Add(Format('%d %s', [i, FileName]));
if CompareText(ExtractFileExt(IEditor.FileName), '.Pas') = 0 then begin
if ISourceEditor = Nil then begin
IEditor.QueryInterface(IOTASourceEditor, ISourceEditor);
IEditor.Show;
end
end
else begin
// Maybe the editor is a Form Editor. If it is
// close the form (the counterpart to the .Pas, that is}
IEditor.QueryInterface(IOTAFormEditor, IFormEditor);
if IFormEditor <> Nil then begin
IComponent := IFormEditor.GetRootComponent;
IComponent.QueryInterface(INTAComponent, INTAComp);
AForm := TForm(INTAComp.GetComponent);
//AForm.Close; < this does NOT close the on-screen form
// IActionServices.CloseFile(IEditor.FileName); <- neither does this
SendMessage(AForm.Handle, WM_Close, 0, 0); // But this does !
end;
end;
end;
// Next, place the editor caret where we want it ...
IServices.QueryInterface(IOTAEditorServices, IEditorServices);
Assert(IEditorServices <> Nil);
IEditView := IEditorServices.TopView;
Assert(IEditView <> Nil);
CursorPos.Line := edLine;
CursorPos.Col := edCol;
IEditView.SetCursorPos(CursorPos);
// and scroll the IEditView to the caret
IEditView.MoveViewToCursor;
// Finally, insert the comment, if any
if EditorInsert <> '' then begin
Assert(ISourceEditor <> Nil);
IEditView.ConvertPos(True, CursorPos, CharPos);
InsertPos := IEditView.CharPosToPos(CharPos);
IEditWriter := ISourceEditor.CreateUndoableWriter;
Assert(IEditWriter <> Nil, 'IEditWriter');
IEditWriter.CopyTo(InsertPos);
IEditWriter.Insert(PChar(EditorInsert));
IEditWriter := Nil;
end;
end;
end;
end;
procedure TOTAEditPosnForm.HandleCopyDataString(
CopyDataStruct: PCopyDataStruct);
begin
Memo1.Lines.Text := PChar(CopyDataStruct.lpData);
EditorFileName := Memo1.Lines.Values['FileName'];
edLine := StrToInt(Memo1.Lines.Values['Line']);
edCol := StrToInt(Memo1.Lines.Values['Col']);
EditorInsert := Trim(Memo1.Lines.Values['Comment']);
if EditorFileName <> '' then
OpenInIDEEditor;
end;
procedure TOTAEditPosnForm.WMCopyData(var Msg: TWMCopyData);
begin
HandleCopyDataString(Msg.CopyDataStruct);
msg.Result := Length(Memo1.Lines.Text);
end;
initialization
finalization
if Assigned(OTAEditPosnForm) then begin
OTAEditPosnForm.Close;
FreeAndNil(OTAEditPosnForm);
end;
end.
Code for sender:
procedure TSenderMainForm.btnSendClick(Sender: TObject);
begin
SendMemo;
end;
procedure TSenderMainForm.SendData(
CopyDataStruct: TCopyDataStruct);
var
HReceiver : THandle;
Res : integer;
begin
HReceiver := FindWindow(PChar('TOTAEditPosnForm'),PChar('OTAEditPosnForm'));
if HReceiver = 0 then begin
Caption := 'CopyData Receiver NOT found!';
end
else begin
Res := SendMessage(HReceiver, WM_COPYDATA, Integer(Handle), Integer(#CopyDataStruct));
if Res > 0 then
Caption := Format('Received %d characters', [Res]);
end;
end;
procedure TSenderMainForm.SendMemo;
var
MS : TMemoryStream;
CopyDataStruct : TCopyDataStruct;
S : String;
begin
MS := TMemoryStream.Create;
try
S := Memo1.Lines.Text + #0;
MS.Write(S[1], Length(S));
CopyDataStruct.dwData := 1;
CopyDataStruct.cbData := MS.Size;
CopyDataStruct.lpData := MS.Memory;
SendData(CopyDataStruct);
finally
MS.Free;
end;
end;

How to get the main source file name from an IOTAProject?

Since at least D2007 a project file can have a main source file with differing base name. The DevExpress demos make use of this: E.g. there is a single dpr file UnboundListDemo.dpr which serves as the main source for both UnboundListDemoD11.dproj and UnboundListDemoD12.dproj.
Now if I have a Project: IOTAProject then Project.FileName returns the dproj file name. I couldn't find an "official" way to get the dpr's file name. Is there any? One can get it from parsing the dproj file (see here) but I'd prefer a ToolsAPI method.
Edit: I came up with this code based on Jon's answer:
function IsProjectSource(const FileName: string): Boolean;
begin
Result := IsDpr(FileName) or IsBpr(FileName) or IsPackage(FileName);
end;
function GxOtaGetProjectFileName2(Project: IOTAProject; NormalizeBdsProj: Boolean = False): string;
var
i: Integer;
Module: IOTAModule;
Editor: IOTAEditor;
begin
Result := '';
if Assigned(Project) then begin
Result := Project.FileName;
if NormalizeBdsProj and IsBdsprojOrDproj(Result) then begin
Module := Project as IOTAModule;
for i := 0 to Module.ModuleFileCount - 1 do
begin
Editor := Module.ModuleFileEditors[i];
if IsProjectSource(Editor.FileName) then begin
Result := Editor.FileName;
Exit;
end;
end;
end;
end;
end;
where the Is... routines are from GX_GenericUtils.
Edit 2: How to create one of these situations:
Create new VCL application.
Save as MyProject.dproj.
Close project in IDE.
In Windows explorer, rename MyProject.dproj to MyProjectD11.dproj.
From now on be sure to open MyProjectD11.dproj, not MyProject.dpr!
If you iterate the editors on the IOTAProject instance, you'll probably find the dpr.
var
Module: IOTAModule;
Project: IOTAProject;
Editor: IOTAEditor;
begin
// Set Project Here....
Module := Project as IOTAModule;
for I := 0 to Module.ModuleFileCount - 1 do
begin
Editor := Module.ModuleFileEditors[I];
end;
end;

Resources