I'm trying to automate an application (Windows 8, Delphi XE.) For my testing I'm doing the following:
Created a small test application, consisting of a form and a memo (Form1)
Added a new ActiveX Object, CoClass name TestOLE, Threading mode Apartment, Instancing Multiple (as per this article.)
Added one method Method1 which only adds some text to the memo control in Form1
I then start the application and double click on a file named test.vbs which contains the following code:
dim obj
set obj = GetObject("", "Project1.TestOLE")
obj.AddSomeText "Hola mundo"
When the application is running, I see that a new form is created, the text is added and then it exits.
What I want to accomplish is that the opened application should have its memo text changed.
I've repeated creating new projects with both MultipleInstance and SingleInstance, and in an outburst of heuristic anger, I even changed the threading model to single, to no avail.
I see two flags in the type library editor: "Replaceable" and "Aggregatable." However, selecting "Replaceable" ends up in an error in the generated RIDL file.
I've been reading a lot about GetObject. It appears that its documentation is even wrong (it says you can omit the first parameter but I've found that doesn't work).
Is this the right way to write an automation server in Delphi that can be reused?
Well, I got it working (I hope.)
Reading more of the same article cited above, found the following:
Know how to implement servers that support GetActiveObject.
Adding a global object, and registering in the Running Object Table (ROT) accomplishes the desired task of having the COM call passed to the running application:
Project file:
program TestOLEProject3;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
TestOLEProject3_TLB in 'TestOLEProject3_TLB.pas',
Unit2 in 'Unit2.pas' {TestOLE: CoClass},
Unit3 in 'Unit3.pas';
{$R *.TLB}
{$R *.res}
begin
Application.Initialize;
RegisterGlobalTestOLE;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Unit2.pas:
unit Unit2;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, TestOLEProject3_TLB, StdVcl;
type
TTestOLE = class(TAutoObject, ITestOLE)
protected
procedure Method1; safecall;
procedure Quit; safecall;
end;
implementation
uses ComServ, Unit1, Unit3;
procedure TTestOLE.Method1;
begin
Form1.Memo1.Lines.Add('Wheeee');
end;
procedure TTestOLE.Quit;
begin
RevokeGlobalTestOLE;
end;
initialization
TAutoObjectFactory.Create(ComServer, TTestOLE, CLASS_TestOLE, ciMultiInstance,
tmApartment);
end.
Unit3.pas (functions to register and unregister the global object):
unit Unit3;
interface
procedure RegisterGlobalTestOLE;
procedure RevokeGlobalTestOLE;
implementation
uses TestOLEProject3_TLB, ComObj, ActiveX;
var
GlobalTestOLEHandle: longint = 0;
procedure RegisterGlobalTestOLE;
var
GlobalTestOLE: ITestOLE;
begin
GlobalTestOLE := CoTestOLE.Create;
OleCheck(RegisterActiveObject(GlobalTestOLE, CLASS_TestOLE,
ACTIVEOBJECT_STRONG, GlobalTestOLEHandle));
end;
procedure RevokeGlobalTestOLE;
begin
if (GlobalTestOLEHandle <> 0) then
begin
OleCheck(RevokeActiveObject(GlobalTestOLEHandle, nil));
GlobalTestOLEHandle := 0;
end;
end;
end.
Related
I was trying to understand how to use units in my main 'modules test unit'. they are 'module1.pas', and 'module2.pas'.
This is a console program and I would like for both units to be displayed and used in my main unit modules_test:
program modules_test;
uses
SysUtils, module1, module2;
procedure modules_display;
begin
module1;
module2;
end;
end.
here's unit module1:
unit module1;
interface
uses
Classes, SysUtils;
implementation
begin
writeln('this is module 1....');
end.
And module2:
unit module2;
interface
uses
Classes, SysUtils;
implementation
begin
writeln('this is module 2....');
end.
As I'm fairly certain that I'm missing a few things, as well as the errors I get, what would I need to use for this to execute properly?
program modules_test;
{$APPTYPE CONSOLE}
uses
SysUtils, module1, module2;
procedure modules_display;
begin
module1.Test; // Fully qualify the name of the procedure
module2.Test;
end;
begin
modules_display;
ReadLn;
end.
unit module1;
interface
// Declare a procedure that can be called from outside of this unit
procedure Test;
implementation
uses
// Unit references that are exclusively used in the implementation section
Classes, SysUtils;
// This is the implementation of the procedure
procedure Test;
begin
writeln('this is module 1....');
end;
end.
unit module2;
interface
// Declare a procedure that can be called from outside of this unit
procedure Test;
implementation
uses
// Unit references that are exclusively used in the implementation section
Classes, SysUtils;
// This is the implementation of the procedure
procedure Test;
begin
writeln('this is module 2....');
end;
end.
See some documentation, Programs and Units.
I'm developing a DLL file that will be loaded by my EXE... So the EXE will call the first DLL procedure and when this procedure get loaded I want to keep it openned even if the EXE get closed. The example is, I have a DLL with timer showing a 'Hello World' message.
DLL Code:
uses
SysUtils,
Classes,
Dialogs,
ExtCtrls;
{$R *.res}
type
TMyTimer = Class(TTimer)
public
procedure OnMyTimer(Sender: TObject);
end;
procedure DllMessage; export;
var
MyTimer: TMyTimer;
begin
MyTimer := TMyTimer.Create(nil);
MyTimer.Interval := 10000;
MyTimer.OnTimer := MyTimer.OnMyTimer;
end;
procedure TMyTimer.OnMyTimer(Sender: TObject);
begin
ShowMessage('Hello World');
end;
exports DllMessage;
begin
end.
The EXE is loading like this:
procedure DllMessage; external 'Message.dll'
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
DllMessage;
end;
When I close the EXE I want the DLL keep running and showing the message every 10 seconds... Is that possible?
DLLs are loaded into processes and cannot exist without a process to host them. So what you ask is not possible.
If you want to close your process, but continue to execute code, you will need to start a new and separate process to execute that code.
u need Atach a A DLL to another process,
and hook ur code to execute on your processs !
this method is called Dll Injection and Code Hook,
easy ways using madcodehook component
athttp://www.madshi.net/
example injection
http://help.madshi.net/DllInjecting.htm
example code hooking
http://help.madshi.net/ApiCodeHooking.htm
or
creanting ur ways
http://www.codeproject.com/Articles/4610/Three-Ways-to-Inject-Your-Code-into-Another-Proces
I have a delphi application that, on startup, checks to see if a process is already running, if it is running, I pass data over to that process and terminate the current process. The problem: In terminating the current process, the window of the app flashes for a split second prior to termination. All the code is in the application initialization, before that main form is even created, so I don't understand how it could show the form for a split second. I have tried numerous things like making the window invisible, nothing seems to work. Is there something I am doing wrong.
You are apparently not terminating soon enough. I'd do something like
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
function PrevInstance: boolean;
begin
...
end;
procedure PassData;
begin
...
end;
begin
if PrevInstance then
begin
PassData;
Exit;
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Update: I believe you do something like
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure MyInitProc;
begin
if true then Application.Terminate;
end;
initialization
InitProc := #MyInitProc;
end.
This will not work, because Application.Terminate doesn't terminate the application immediately. Instead, it simply posts a WM_QUIT message. This message will be received and acted upon after all initialisation is completed.
I built the code below using Delphi XE2. It creates Form1, and Form1 immediately creates an instance of Form2. When I press the button on Form2 a second Form2 is created.
Now if I hover the mouse over the button on this second, topmost, Form2 and wait for the tooltip to appear, the moment the tooltip appears, the first Form2 comes to the front, stealing focus.
The problem occurs only if Application.MainFormOnTaskbar is True. It also relies on the first Form2 being created from Form1's FormCreate method. If I use PostMessage() to delay the creation of the first Form2 until the application has finished initialising, the problem goes away.
I'd like to understand why this is happening. I have already learned that Delphi's Application object handles a lot of things including hint display, and I know that Delphi can recreate a window's handle during initialisation, but I haven't been able to follow this through to explain fully the behaviour described above (or indeed whether the above two facts are even relevant).
Project1.dpr
program Project1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True; // False makes problem go away
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Unit1.pas
unit Unit1;
interface
uses
Vcl.Forms, Unit2;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
procedure CreateForm2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateForm2;
end;
procedure TForm1.CreateForm2;
var
frm : TForm2;
begin
frm := TForm2.Create(Application); // (Could pass Self - makes no difference)
frm.Show;
end;
end.
Unit2.pas
unit Unit2;
interface
uses
Vcl.Forms, System.Classes, Vcl.Controls, Vcl.StdCtrls, WinApi.Windows;
type
TForm2 = class(TForm)
Button1: TButton; // This button has a hint
procedure Button1Click(Sender: TObject);
end;
var
Form2: TForm2;
implementation
uses
System.SysUtils, Unit1;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
Form1.CreateForm2;
end;
end.
The key issue here is that the first instance of TForm2 is created as window that is owned by the application window, Application.Handle. And here I am referring to the Windows meaning of owner. In VCL language this is known as the popup parent.
Now, when you create that first TForm2 instance, the Application.MainForm property is still nil. And because you did not explicitly assign PopupParent, the code in TCustomForm.CreateParams sets the owner to be the application window.
You simply do not want your windows to be owned by the hidden application window. This is the reason why that first TForm2 instance sometimes appears behind all the other windows, in particular behind your main form. It has simply been created with the wrong owner.
The form that is owned by Application.Handle gets shown in THintWindow.ActivateHint. That happens due to the line that reads ParentWindow := Application.Handle. This is followed by a call to SetWindowPos(Handle, ...) which results in the incorrectly owned form coming to the front. Presumably that form comes to the front because it is also owned by Application.Handle. Right now I don't have a clear explanation for the precise mechanism, but I don't find that terribly interesting because the form is clearly setup wrongly.
In any case, the fundamental problem is that you have created a window that is incorrectly owned. The solution therefore is to make sure that the window is owned correctly. Do that by assigning the PopupParent. For example:
procedure TForm1.CreateForm2;
var
frm : TForm2;
begin
frm := TForm2.Create(Application); // (Could pass Self - makes no difference)
frm.PopupParent := Self;
frm.Show;
end;
I got a very serious problem when I'm trying to access TDictionary variable in host program from a dynamicly loaded dll. Here is the complete code, anyone can give some help? thanks!
===========main program project source code===================
program main;
uses
ShareMem,
Forms,
uMain in 'uMain.pas' {Form1},
uCommon in 'uCommon.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
==============unit uMain================
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uCommon;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
Tfoo = function(ADic: TMyDic): string; stdcall;
procedure TForm1.Button1Click(Sender: TObject);
var
Dic: TMyDic;
HLib: THandle;
foo: Tfoo;
begin
Dic := TMyDic.Create;
try
Dic.Add(1, 'World!');
Dic.Add(2, 'Hello, ');
HLib := LoadLibrary('Mydll.dll');
try
#foo := GetProcAddress(HLib, 'foo');
ShowMessage(foo(Dic));
finally
FreeLibrary(HLib);
end;
finally
Dic.Free;
end;
end;
end.
=================dll project source code=====================
library MyDll;
uses
ShareMem,
SysUtils,
Classes,
uCommon in 'uCommon.pas';
function foo(ADic: TMyDic):string; stdcall;
var
I: Integer;
S: string;
begin
for I in ADic.Keys do
begin
S := S + ADic[I];
end;
Result := s;
end;
exports
foo;
end.
================unit uCommon==============
unit uCommon;
interface
uses
SysUtils, Generics.Collections;
type
TMyDic = TDictionary<Integer, string>;
implementation
end.
Are you getting exceptions? Maybe access violations or invalid pointer operations?
You can't share strings and objects between Delphi and a DLL if the DLL has its own memory manager. Since you're using Delphi 2010, you should have FastMM installed by default. Add "SimpleShareMem" as the first thing in the uses list for both the DLL and the EXE, and see if that doesn't fix the problem?
EDIT: In response to additional information from the poster:
You're calling dic.free after you unload the DLL. Even if you share memory managers, that's going to give you an access violation. Here's why.
Free calls TObject.Destroy, which is a virtual method. The compiler generates code to look it up in the object's Virtual Method Table. But the VMT is stored in static memory that's specific to the module, not in shared memory allocated by the memory manager. You unloaded the DLL and pulled the rug out from underneath the VMT pointer in the object, and so when it tries to call a virtual method you get an access violation.
You can fix this by making sure to call Free before unloading the DLL. Or you can use runtime packages instead of a DLL, which gets around this problem by putting the VMT for the object in an external package that won't be unloaded before you're done with it.
I would strongly discourage passing object instances between an executable and a regular DLL. Mainly for the exact reasons you are are encountering. What happens if the DLL is rebuilt and you've changed the object in some incompatible subtle way?
As Mason points out, packages are the preferred way to partition your application into modules.
I finally found what the real problem is! It seems like this: "For..in keys" loop will cause TDictionary create an instance for its data field FKeyCollection:
function TDictionary<TKey,TValue>.GetKeys: TKeyCollection;
begin
if FKeyCollection = nil then
FKeyCollection := TKeyCollection.Create(Self);
Result := FKeyCollection;
end;
So when the dll is unloaded, the memory that FKeyCollection pointed is also freed, thus left a "dangling pointer".
destructor TDictionary<TKey,TValue>.Destroy;
begin
Clear;
FKeyCollection.Free; //here will throw an exception
FValueCollection.Free;
inherited;
end;