Our VCL Delphi application has a number of grids that we need to start to interact with via UIAutomation. There are a number of issues, not least that the TStringGrid doesn't implement any of the IUIAutomation patterns (IGridProvider or ITableProvider, or for that matter even IValueProvider).
I am trying to find out what I need to added to a TStringGrid to allow it to implement the providers (which in the System.Windows.Automation.Provider namespace in .NET).
Here are my steps ...
(The actual files are too large to post all of them, so this is a distillation of the major points).
ALSO - This still has major issues, probably of my own making, but it is enough for me to make progress.
Get the UIAutomationCore.idl (mine was as part of a Visual Studio installation).
Run midl.exe to create the type library.
Run tlibimp.exe from the command-line (as Delphi doesn't seem to like the .tlb created in step 3), and create the UIAutomationCore_TLB.pas file. This ends up being a rather large file, with all of the COM parts of UIAutomationCore defined in pascal.
There are methods in the original DLL that are not COM, and these need to be defined as well. These I added to the generated file from Step 3 - although probably they should be defined elsewhere in case this file is regenerated.
function UiaHostProviderFromHwnd(hwnd: HWND; provider: IRawElementProviderSimple): LRESULT; stdcall; external 'UIAutomationCore.dll' name 'UiaHostProviderFromHwnd';
function UiaReturnRawElementProvider(hwnd: HWND; wParam: WPARAM; lParam: LPARAM; element : IRawElementProviderSimple) : LRESULT; stdcall; external 'UIAutomationCore.dll' name 'UiaReturnRawElementProvider';
The component needs to implement the IRawElementProviderSimple interface, as well as any other providers - in the example case I have used ISelectionProvide, in order to illustrate what I did.
// IRawElementProviderSimple
function Get_ProviderOptions(out pRetVal: ProviderOptions): HResult; stdcall;
function GetPatternProvider(patternId: SYSINT; out pRetVal: IUnknown): HResult; stdcall;
function GetPropertyValue(propertyId: SYSINT; out pRetVal: OleVariant): HResult; stdcall;
function Get_HostRawElementProvider(out pRetVal: IRawElementProviderSimple): HResult; stdcall;
// ISelectionProvider
function GetSelection(out pRetVal: PSafeArray): HResult; stdcall;
function Get_CanSelectMultiple(out pRetVal: Integer): HResult; stdcall;
function Get_IsSelectionRequired(out pRetVal: Integer): HResult; stdcall;
These are implemented as follows ..
function TAutomationStringGrid.Get_ProviderOptions(
out pRetVal: ProviderOptions): HResult;
begin
pRetVal:= ProviderOptions_ClientSideProvider;
Result := S_OK;
end;
function TAutomationStringGrid.GetPatternProvider(patternId: SYSINT;
out pRetVal: IInterface): HResult;
begin
pRetval := nil;
if (patternID = UIA_SelectionPatternId) then
begin
result := QueryInterface(ISelectionProvider, pRetVal);
end
else
result := S_OK;
end;
function TAutomationStringGrid.GetPropertyValue(propertyId: SYSINT;
out pRetVal: OleVariant): HResult;
begin
if(propertyId = UIA_ControlTypePropertyId) then
begin
TVarData(pRetVal).VType := varWord;
TVarData(pRetVal).VWord := UIA_DataGridControlTypeId;
end;
result := S_OK;
end;
function TAutomationStringGrid.Get_HostRawElementProvider(
out pRetVal: IRawElementProviderSimple): HResult;
begin
result := UiaHostProviderFromHwnd (self.Handle, pRetVal);
end;
function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
begin
end;
function TAutomationStringGrid.Get_CanSelectMultiple(
out pRetVal: Integer): HResult;
begin
end;
function TAutomationStringGrid.Get_IsSelectionRequired(
out pRetVal: Integer): HResult;
begin
end;
In order to actually get the control, the WM_GETOBJECT message needs to be handled ...
procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
This is implemented as follows ..
procedure TAutomationStringGrid.WMGetObject(var Message: TMessage);
begin
if (Message.Msg = WM_GETOBJECT) then
begin
QueryInterface(IID_IRawElementProviderSimple, FRawElementProviderSimple);
message.Result := UiaReturnRawElementProvider(self.Handle, Message.WParam, Message.LParam, FRawElementProviderSimple);
end
else
Message.Result := DefWindowProc(self.Handle, Message.Msg, Message.WParam, Message.LParam);
end;
Although I cannot provide the specific steps required to implement the automation capabilities you require on TStringGrid, I can say that based on the comments you have almost everything you need.
The article you found describing the basic implementation of UI Automation support for Win32 Unmanaged code is a good place to start.
The questions over what is and is not exposed through the IDL in UIAutomationCore.DLL are then addressed by the fact that the DLL in question is itself intended to be consumed by unmanaged code. It contains no managed code itself. At least not that is involved in an unmanaged use case.
What is does contain is a COM interface described by IDL, but also some functions simply exported by the DLL. As far as I know, IDL does not describe the exports table of a DLL. Even if it is capable of doing so, in the case of this DLL it does not (at least not in all cases).
For example, the UiaHostProviderFromHwnd() function that you have mentioned is a simple DLL export. Some of the additional functions exported in this way are described in this MSDN blog post describing creating a .net interop interface for this library. In that article they are called "flat API methods".
Using PE Explorer I can see 81 such functions exported by the UIAutomationCore.dll library.
Unfortunately a DLL exports table does not describe the parameters or return types of any exported function, only the names. So, in addition to the type library (produced from the IDL) you will also need to locate and convert the UIAutomationCore.h header file for use with Delphi (i.e. Pascal).
You should then have everything need to implement the UI Automation capabilities for any VCL control you desire.
Related
AS. since closing related questions - more examples added below.
The below simple code (which finds a top-level Ie window and enumerates its children) works Ok with a '32-bit Windows' target platform. There's no problem with earlier versions of Delphi as well:
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
EnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
I've inserted an Assert to indicate where it fails with a '64-bit Windows' target platform. There's no problem with the code if I un-nest the callback.
I'm not sure if the erroneous values passed with the parameters are just garbage or are due to some mis-placed memory addresses (calling convention?). Is nesting callbacks infact something that I should never do in the first place? Or is this just a defect that I have to live with?
edit:
In response to David's answer, the same code having EnumChildWindows declared with a typed callback. Works fine with 32-bit:
(edit: The below does not really test what David says since I still used the '#' operator. It works fine with the operator, but if I remove it, it indeed does not compile unless I un-nest the callback)
type
TFNEnumChild = function(hwnd: HWND; lParam: LPARAM): Bool; stdcall;
function TypedEnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNEnumChild;
lParam: LPARAM): BOOL; stdcall; external user32 name 'EnumChildWindows';
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
TypedEnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
Actually this limitation is not specific to a Windows API callbacks, but the same problem happens when taking address of that function into a variable of procedural type and passing it, for example, as a custom comparator to TList.Sort.
http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types
procedure TForm2.btn1Click(Sender: TObject);
var s : TStringList;
function compare(s : TStringList; i1, i2 : integer) : integer;
begin
result := CompareText(s[i1], s[i2]);
end;
begin
s := TStringList.Create;
try
s.add('s1');
s.add('s2');
s.add('s3');
s.CustomSort(#compare);
finally
s.free;
end;
end;
It works as expected when compiled as 32-bit, but fails with Access Violation when compiled for Win64. For 64-bit version in function compare, s = nil and i2 = some random value;
It also works as expected even for Win64 target, if one extracts compare function outside of btn1Click function.
This trick was never officially supported by the language and you have been getting away with it to date due to the implementation specifics of the 32 bit compiler. The documentation is clear:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values.
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment. In 64 bit code the extra parameter is always passed.
Of course a big part of the problem is that the Windows unit uses untyped procedure types for its callback parameters. If typed procedures were used the compiler could reject your code. In fact I view this as justification for the belief that the trick you used was never legal. With typed callbacks a nested procedure can never be used, even in the 32 bit compiler.
Anyway, the bottom line is that you cannot pass a nested function as parameter to another function in the 64 bit compiler.
Can I call a method which is placed in main application from dll code?
seems there is only one way to do it - create a callback object.
in your application you have to declare interface, wich describes your method, for example:
IMyMethodInterface = interface(IInterface)
procedure MyMethod(); stdcall;
end;
next you have to create class, wich implements this interface (and your method):
TMyMethodObject = class(TInterfacedObject, IMyMethodInterface)
public
procedure MyMethod(); stdcall;
end;
when you load DLL, you have to create TMyMethodObject instance and pass its IMyMethodInterface to dll; of course dll has to have corresponding method and export it (wich takes interface as parameter) SetMethodCallback wich stores interface reference:
vars:
var mmo : IMyMethodInterface;
dllHandle : THandle;
smc : procedure (mmi : IMyMethodInterface); stdcall;
code:
mmo := TMyMethodObject.Create();
dllHandle := LoadLibrary('mydll.dll');
smc := GetProcAddress(dllHandle, 'SetMethodCallback');
if assigned(smc) then
smc(mmo);
now, you can use IMyMethodInterface reference in your dll to call method.
of course you can statically link dll and use it directly:
procedure SetMethodInteface(mmi : IMyMethodInterface); stdcall; external 'mydll.dll';
here is an DLL sample code:
library Project3;
// uses YourMethodIntf.pas
{$R *.res}
var AppMethod : IMyMethodInterface;
procedure SetAppMethodCallback(mmi : IMyMethodInterface); stdcall;
begin
AppMethod := mmi;
end;
procedure AnotherDllMethod();
begin
//here you can use AppMethod.MyMethod();
end;
exports
SetAppMethodCallback name 'SetMethodcallback';
begin
end.
take into account that your mmo object (TMyMethodInterface) will not be destroyed until you set AppMethod in dll to nil (or FreeLibrary dll ), so be careful
First of all, I'm not too comfortable with DLL's. I've done them before, but know very little and always have problems.
This DLL I'm building requires passing a windows form handle (HWND) into the DLL function, and the DLL shall call a Windows API function using that handle. I keep getting an access violation when trying to call any function (starting from Win7InitTaskbar) - as if it failed to even call the function. That made me conclude that it must be the HWND parameter making it crash... I think...
library Win7;
uses
//Do I need ShareMem?
//ShareMem, //<---
Windows,
Forms,
JDWin7,
SysUtils,
Classes;
{$R *.res}
function Win7InitTaskbar(const FormHandle: HWND): Bool; stdcall;
begin
Result:= InitializeTaskbarAPI(FormHandle);
end;
function Win7InitForm(const FormHandle: HWND): Bool; stdcall;
begin
end;
function Win7SetTaskbarState(const AState: Cardinal): Bool; stdcall;
begin
Result:= SetTaskbarProgressState(AState);
end;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool; stdcall;
begin //is UInt64 Safe for DLL?
Result:= SetTaskbarProgressValue(ACurrent, AMax);
end;
exports
Win7InitTaskbar,
Win7InitForm,
Win7SetTaskbarState,
Win7SetTaskbarValue;
begin
end.
Implementation of DLL functions:
function Win7InitTaskbar(const FormHandle: HWND): Bool;
external W7DLL;
function Win7SetTaskbarState(const AState: Cardinal): Bool;
external W7DLL;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool;
external W7DLL;
I had this problem whether I used ShareMem or not (Which, I also do not want to use). Is it safe to publish the function with a HWND parameter? I tried LongWord as well, still no luck. The internal function InitializeTaskbarAPI does in fact work perfectly outside of the DLL, if i were to use it directly inside the app. But in this case, I want to put these in a shared DLL.
Also, is it safe to pass UInt64 into a DLL? One of the functions was already published with this parameter type when I got the source.
Your problem here appears to me to be unrelated to using Sharemem or passing Form.Handle to an HWND parameter.
It is simply a calling convention mismatch. You export as stdcall but then import as register. Whenever you do that, runtime errors are sure to follow.
You need to do it like this:
function Win7InitTaskbar(const FormHandle: HWND): Bool;
stdcall; external W7DLL;
function Win7SetTaskbarState(const AState: Cardinal): Bool;
stdcall; external W7DLL;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool;
stdcall; external W7DLL;
And for what it is worth, you don't need Sharemem here. You only need that when you allocate memory in one module but free it in a different one. And passing Form.Handle to an HWND parameter in a DLL is not a problem. You do this all then time when you call Windows API functions.
I know Delphi XE2 has the new TVirtualInterface for creating implementations of an interface at runtime. Unfortunately I am not using XE2 and I'm wondering what kind of hackery is involved in doing this sort of thing in older versions of Delphi.
Lets say I have the following interface:
IMyInterface = interface
['{8A827997-0058-4756-B02D-8DCDD32B7607}']
procedure Go;
end;
Is it possible to bind to this interface at runtime without the help of the compiler?
TMyClass = class(TObject, IInterface)
public
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
procedure Go; //I want to dynamically bind IMyInterface.Go here
end;
I've tried a simple hard cast:
var MyInterface: IMyInterface;
begin
MyInterface := IMyInterface(TMyClass.Create);
end;
but the compiler prevents this.
Then I tried an as cast and it at least compiled:
MyInterface := TMyClass.Create as IMyInterface;
So I imagine the key is to get QueryInterface to return a valid pointer to an Implementation of the interface being queried. How would I go about constructing one at runtime?
I've dug through System.pas so I'm at least vaguely familiar with how GetInterface, GetInterfaceEntry and InvokeImplGetter work. (thankfully Embacadero chose to leave the pascal source along with the optimized assembly). I may not be reading it right but it appears that there can be interface entries with an offset of zero in which case there is an alternative means of assigning the interface using InvokeImplGetter.
My ultimate goal is to simulate some of the abilities of dynamic proxies and mocks that are available in languages with reflection support. If I can successfully bind to an object that has the same method names and signatures as the interface it would be a big first step. Is this even possible or am I barking up the wrong tree?
Adding support for an interface to an existing class at runtime can theoretically be done, but it would be really tricky, and it would require D2010 or later for RTTI support.
Each class has a VMT, and the VMT has an interface table pointer. (See the implementation of TObject.GetInterfaceTable.) The interface table contains interface entries, which contain some metadata, including the GUID, and a pointer to the interface vtable itself. If you really wanted to, you could create a copy of the interface table, (DO NOT do this the original one; you're likely to end up corrupting memory!) add a new entry to it containing a new interface vtable with the pointers pointing to the correct methods, (which you could match by looking them up with RTTI,) and then change the class's interface table pointer to point to the new table.
Be very careful. This sort of work is really not for the faint of heart, and it seems to me it's of kind of limited utility. But yes, it's possible.
I'm not sure, what you want to accomplish and why you want to dynamically bind that interface, but here is a way to do it (don't know if it fits your need):
type
IMyInterface = interface
['{8A827997-0058-4756-B02D-8DCDD32B7607}']
procedure Go;
end;
TMyClass = class(TInterfacedObject, IInterface)
private
FEnabled: Boolean;
protected
property Enabled: Boolean read FEnabled;
public
constructor Create(AEnabled: Boolean);
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
procedure Go; //I want to dynamically bind IMyInterface.Go here
end;
TMyInterfaceWrapper = class(TAggregatedObject, IMyInterface)
private
FMyClass: TMyClass;
protected
property MyClass: TMyClass read FMyClass implements IMyInterface;
public
constructor Create(AMyClass: TMyClass);
end;
constructor TMyInterfaceWrapper.Create(AMyClass: TMyClass);
begin
inherited Create(AMyClass);
FMyClass := AMyClass;
end;
constructor TMyClass.Create(AEnabled: Boolean);
begin
inherited Create;
FEnabled := AEnabled;
end;
procedure TMyClass.Go;
begin
ShowMessage('Go');
end;
function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if Enabled and (IID = IMyInterface) then begin
IMyInterface(obj) := TMyInterfaceWrapper.Create(Self);
result := 0;
end
else begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
end;
And this is the corresponding test code:
var
intf: IInterface;
my: IMyInterface;
begin
intf := TMyClass.Create(false);
if Supports(intf, IMyInterface, my) then
ShowMessage('wrong');
intf := TMyClass.Create(true);
if Supports(intf, IMyInterface, my) then
my.Go;
end;
Are there any side effects to changing a class hierarchy's ancestor from TObject to TInterfacedObject so that I can implement interfaces further down the inheritance chain?
I've programmed in Delphi for several years but never encountered interfaces. I became accustomed to using them in other languages. Now that I'm involved in a Delphi project again I'd like to start taking advantage of them but I know they work a bit differently than in Java or C#.
If you already have existing code using the class you will probably have to modify a lot of it to keep references to interfaces instead of object instances. Interfaces are reference counted and released automatically, as a result, any reference to the implementor instance will become an invalid pointer.
This will work fine as long as you inherit from the class below at the top (bottom?) of your hierarchy. This code ensures that your new classes dont free themselves - as is the default behaviour of TInterfaceObject - you are presumably already freeing them yourself and want to preserve this. This activity is actually exactly what TComponent in the VCL does - it supports interfaces but is not reference counted.
type
TYourAncestor = class( TInterfacedObject )
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
implementation
function TYourAncestor.QueryInterface(const IID: TGUID; out Obj): HResult;
const
E_NOINTERFACE = HResult($80004002);
begin
if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;
function TYourAncestor._AddRef: Integer;
begin
Result := -1 // -1 indicates no reference counting is taking place
end;
function TYourAncestor._Release: Integer;
begin
Result := -1 // -1 indicates no reference counting is taking place
end;
Aside from a few extra bytes in your instance size, no. That's probably the best way to do it.