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.
Related
I have ported an application from ADO to FireDAC applying several RegExp replaces on the source code to convert the ADOQuery, ADOTables, ADOCommands, ADOStoredProcs, etc. ... to the corresponding FireDAC components.
It has worked fine, but now when running that application plenty of forms raise errors because of the type of the persistent fields being different than the type expected (the one defined from ADO when the persistent field was created).
I'm trying to make a list of those errors, creating an instance of all my forms and opening their datasets with persistent fields, and logging the errors. I can get the list of forms from the project source code, but when I try to use FindClass to create each form I get an error telling that the class has not been found.
Is there any other way to create a Form/DataModule from its class name ?.
This is my current code:
class procedure TfrmCheckFormularis.CheckDatasets(ProjecteFile: string);
var frmCheckFormularis: TfrmCheckFormularis;
Projecte: string;
rm: TMatch;
cc: TComponentClass;
c: TComponent;
i: integer;
Dataset: TFDQuery;
begin
Projecte := TFile.ReadAllText(ProjecteFile);
frmCheckFormularis := TfrmCheckFormularis.Create(Application);
try
with frmCheckFormularis do begin
Show;
qryForms.CreateDataSet;
qryErrors.CreateDataSet;
// I get a list of all the forms and datamodules on my project
for rm in TRegEx.Matches(Projecte, '^(?:.* in '')(?<File>.*)(?:'' {)(?<Class>.*)(?:},)', [roMultiline]) do begin
qryForms.AppendRecord([rm.Groups['File'].Value, rm.Groups['Class'].Value]);
end;
// Check every form and datamodule
qryForms.First;
while not qryForms.Eof do begin
cc := TComponentClass(FindClass(qryFormsClass.Value));
c := cc.Create(frmCheckFormularis);
try
for i := 0 to c.ComponentCount - 1 do begin
if c.Components[i] is TFDQuery then begin
Dataset := c.Components[i] as TFDQuery;
// When the Dataset has persistent fields, I open it to check if the persistent fields are correct
if Dataset.FieldDefs.Count > 1 then begin
try
Dataset.Open;
except
on E: Exception do qryErrors.AppendRecord([c.Name, Dataset.Name, E.Message]);
end;
end;
end;
end;
finally
c.Free;
end;
qryForms.Next;
end;
end;
finally
frmCheckFormularis.Free;
end;
end;
Thank you.
Using the "new" RTTI in Delphi is quite easy. The following code will (hopefully*) create one instance of each form in your application:
procedure TForm1.Button1Click(Sender: TObject);
var
Context: TRttiContext;
&Type: TRttiType;
InstanceType: TRttiInstanceType;
begin
Context := TRttiContext.Create;
for &Type in Context.GetTypes do
begin
if (&Type.TypeKind = tkClass) and &Type.IsInstance then
begin
InstanceType := TRttiInstanceType(&Type);
if InstanceType.MetaclassType.InheritsFrom(TForm) and (InstanceType.MetaclassType <> TForm) then
TFormClass(InstanceType.MetaclassType).Create(Application){.Show}; // optionally show it
end;
end;
end;
* Technically, it will create one instance of each proper descendant class of TForm.
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.
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 down load a file after clicking a download button programatically, and therefore not needing to know the url for the downloading file.
After a file has downloaded a prompt comes up and asks if you'd like to save the file, after pressing 'yes' another prompt asks where you'd like to save the file. So, the file is downloaded first, maybe into a buffer somewhere, after the initial download, the prompts appear.
So, once the button is clicked how do you capture the downloading stream and save it as a file somewhere, without the popup prompts appearing?
(Any method for clicking a button would be fine, the following should be fine.)
procedure TForm1.Button1Click(Sender: TObject);
var
x: integer;
ovLinks: OleVariant;
begin
WebBrowser1.Navigate('The web page');
//wait for page to down load
ovLinks := WebBrowser1.OleObject.Document.all.tags('A');
if ovLinks.Length > 0 then
begin
for x := 0 to ovLinks.Length-1 do
begin
if Pos('id of button', ovLinks.Item(x).id) > 0 then
//or if Pos('href of button', ovLinks.Item(x).href) > 0 then
begin
ovLinks.Item(x).click;
Break;
end;
end;
end;
end;
The reason for this question is: the url of a file can not always be found.
Eg: At this web site, I couldn't find the url programatically but after pressing the export button, using IE, the file was download into the 'Temporary Internet Files' folder. In the IE 'Temporary Internet Files' folder it has a column 'Internet adress' which shows the url. But in Chrome no such data exists. BUT, at this web site, I can find the url programatically, but when I download the file, by pressing 'here', the file doesn't appear in the IE 'Temporary Internet Files' folder. For other websites, the url can be found in the folder and by finding it programatically, but at other sites the url can not be found either way.
Implement the IDownloadManager interface with its Download method to your web browser control and you can simply control what you need. The Download method is called whenever you're going to download a file (only when the save as dialog pops up).
1. Embedded Web Browser
You can use the Embedded Web Browser control which has this interface already implemented and which fires the OnFileDownload that is different from the same named event in TWebBrowser. See for instance this thread on how to use it.
2. Do it yourself
Another option is that you can implement it to TWebBrowser by yourself. In the following example I've used interposed class just for showing the principle, but it's very easy to wrap it as a component (that's why I've made the OnBeforeFileDownload published).
2.1. OnBeforeFileDownload event
The only extension to TWebBrowser in this interposed class is the OnBeforeFileDownload event which fires when the file is going to be downloaded (before save as dialog pops up, but instead of the OnFileDownload event, not when the document itself is downloaded). If you won't write the event handler for it, the web browser control will behave as before (showing a save as dialog). If you write the event handler and return False to its Allowed declared parameter, the file saving will be cancelled. If you return True to the Allowed parameter (what is by default), the save as dialog will be shown.
Note that if you cancel downloading by setting Allowed to False, you'll need to download the file by yourself (as I did synchronously using Indy in this example). For this purpose there's the FileSource constant parameter, which contains the downloaded file URL. Here is the event parameters overview:
Sender (TObject) - event sender
FileSource (WideString) - source file URL
Allowed (Boolean) - declared boolean parameter, which decides if the file download will be allowed or not (default value is True)
2.2. IDownloadManager implementation
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, OleServer, OleCtrls, Dialogs, ActiveX, MSHTML, UrlMon, SHDocVw,
IdHTTP;
const
IID_IDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}';
SID_SDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}';
type
IDownloadManager = interface(IUnknown)
['{988934A4-064B-11D3-BB80-00104B35E7F9}']
function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD;
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar;
pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall;
end;
TBeforeFileDownloadEvent = procedure(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean) of object;
TWebBrowser = class(SHDocVw.TWebBrowser, IServiceProvider, IDownloadManager)
private
FFileSource: WideString;
FOnBeforeFileDownload: TBeforeFileDownloadEvent;
function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall;
function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD;
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar;
pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall;
protected
procedure InvokeEvent(ADispID: TDispID; var AParams: TDispParams); override;
published
property OnBeforeFileDownload: TBeforeFileDownloadEvent read FOnBeforeFileDownload write FOnBeforeFileDownload;
end;
type
TForm1 = class(TForm)
Button1: TButton;
WebBrowser1: TWebBrowser;
FileSourceLabel: TLabel;
FileSourceEdit: TEdit;
ShowDialogCheckBox: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure BeforeFileDownload(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TWebBrowser }
function TWebBrowser.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb,
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWideChar;
uiCP: UINT): HRESULT;
var
Allowed: Boolean;
begin
Result := E_NOTIMPL;
if Assigned(FOnBeforeFileDownload) then
begin
Allowed := True;
if pszRedir <> '' then
FFileSource := pszRedir;
FOnBeforeFileDownload(Self, FFileSource, Allowed);
if not Allowed then
Result := S_OK;
end;
end;
procedure TWebBrowser.InvokeEvent(ADispID: TDispID; var AParams: TDispParams);
begin
inherited;
// DispID 250 is the BeforeNavigate2 dispinterface and to the FFileSource here
// is stored the URL parameter (for cases, when the IDownloadManager::Download
// won't redirect the URL and pass empty string to the pszRedir)
if ADispID = 250 then
FFileSource := OleVariant(AParams.rgvarg^[5]);
end;
function TWebBrowser.QueryService(const rsid, iid: TGUID; out Obj): HRESULT;
begin
Result := E_NOINTERFACE;
Pointer(Obj) := nil;
if Assigned(FOnBeforeFileDownload) and IsEqualCLSID(rsid, SID_SDownloadManager) and
IsEqualIID(iid, IID_IDownloadManager) then
begin
if Succeeded(QueryInterface(IID_IDownloadManager, Obj)) and
Assigned(Pointer(Obj))
then
Result := S_OK;
end;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
HTMLWindow: IHTMLWindow2;
HTMLDocument: IHTMLDocument2;
begin
WebBrowser1.Navigate('http://financials.morningstar.com/income-statement/is.html?t=AAPL&ops=clear');
while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
if not Assigned(HTMLDocument) then
Exit;
HTMLWindow := HTMLDocument.parentWindow;
if Assigned(HTMLWindow) then
try
HTMLWindow.execScript('SRT_stocFund.Export()', 'JavaScript');
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutdown := True;
WebBrowser1.OnBeforeFileDownload := BeforeFileDownload;
end;
procedure TForm1.BeforeFileDownload(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean);
var
IdHTTP: TIdHTTP;
FileTarget: string;
FileStream: TMemoryStream;
begin
FileSourceEdit.Text := FileSource;
Allowed := ShowDialogCheckBox.Checked;
if not Allowed then
try
IdHTTP := TIdHTTP.Create(nil);
try
FileStream := TMemoryStream.Create;
try
IdHTTP.HandleRedirects := True;
IdHTTP.Get(FileSource, FileStream);
FileTarget := IdHTTP.URL.Document;
if FileTarget = '' then
FileTarget := 'File';
FileTarget := ExtractFilePath(ParamStr(0)) + FileTarget;
FileStream.SaveToFile(FileTarget);
finally
FileStream.Free;
end;
finally
IdHTTP.Free;
end;
ShowMessage('Downloading finished! File has been saved as:' + sLineBreak +
FileTarget);
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
end.
2.3. IDownloadManager project
You can download the above code (written in Delphi 2009) as a complete project from here.
I don't know if this will get you where you need to go, but it seems promising. With the TWebBrowser I have here (exported from "Microsoft Internet Controls version 1.1"), you can use the OnBeforeNavigate2 event to monitor all the URLs the web browser handles. The problem you have from there would be to determine what you need to do, capture the URL, and then handle it yourself. Here's a short example from the five minutes I was playing with the control on the first web site you presented.
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
Edit1.Text := String(URL);
if Pos('CSV', Edit1.Text) > 0 then
Cancel := true;
end;
As you can see, there's a lot of parms and you'd have to locate the documentation to see what those mean. But in my short example, what I do is put the navigated URLs to the Edit1.Text (probably better a TMemo if you really want to watch what is going on). Given your example, there's really nothing to indicate it's a directly downloaded file, but using the code above, I can cancel the browser from doing it's thing (show the download prompts, etc), and then have the URL there in the Edit1 box to act upon. If one were to dig further, I'm sure you can look at the headers in question and determine if the web site intends to send you a file that you should be downloading, since the URL in and of itself doesn't say "CSV file" (putting http://financials.morningstar.com/ajax/ReportProcess4CSV.html?t=AAPL®ion=usa&culture=us_EN&reportType=is&period=12&dataType=A&order=asc&columnYear=5&rounding=3&view=raw&productCode=USA&r=809199&denominatorView=raw&number=3 into a web browser will download the CSV file in question).
Hopefully it's a good start for you.
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)