Adding Active Scripting to your Delphi Win32 application

I know, I know. This has been done before and there are components out there that add this kind of capability to a Delphi application. What I wanted to do, however, was to show that nearly all the functionality to do this is already in the product you have right now (at least in Delphi 2007). Yes, this is based heavily on COM. Yes, COM is a huge, complicated technology. What is interesting is how well Delphi and the Object Pascal language on which it is based is suited to making your life so much easier when dealing with COM. The complete source to this demo project is available on CodeCentral right here.

Native Object Pascal language support for reference counted interfaces is only the start. There is a whole host of other things that Delphi provides in both the RTL and through a very little known technique of enabling extended meta-data on all public methods and properties of a class. Steve Trefethen has been hinting at a lot of this kind of support in his articles about creating a native compiled Win32 web “mash-up” with Google Maps. In nothing more than a couple of hours, I had a simple demo up and running that was running Java Script from within a Delphi application which would then access and manipulate various controls on a form. Let's get started.

First, we're going to examine the units from the Delphi RTL that are pertinent to making this happen. Looking in sourcewin32rtlcommon, you'll find an interesting unit, ObjAuto.pas. Take a moment to peruse this units. Looking in ObjAuto.pas there is some... how should I say this... very “interesting” code. I won't go into the gory details here since that would be a whole series of articles. Basically what this code does is allow a method of an object to be dynamically invoked through an IDispatch Invoke method call. This code also forms a lot of the basis for the implementation of Win32 SOAP servers and clients. The IDispatch angle is very important since that is how any Active Script code accesses stuff “on the outside.” There is another unit, ObjComAuto.dcu, for which we don't supply source (I'll work on rectifying that oversight), which contains the TObjectDispatch class and a couple of helper global functions.

Between ObjAuto.pas and ObjComAuto.pas nearly 80% of what is needed to make this all work is already there. All we need to do now is to provide a little bit of glue code to wire some of this stuff up. First up is to implement the IActiveScriptSite and IActiveScriptSiteWindow interfaces. You can find the declaration of these interfaces in AscrLib.pas down in sourcewin32websnap. You can read the documentation about them here.

First is IActiveScriptSite:

IActiveScriptSite = interface(IUnknown)
['{DB01A1E3-A42B-11CF-8F20-00805F2CD064}']
function GetLCID(out plcid: LongWord): HResult; stdcall;
function GetItemInfo(pstrName: PWideChar;
dwReturnMask: LongWord;
out ppiunkItem: IUnknown;
out ppti: IUnknown): HResult; stdcall;
function GetDocVersionString(out pbstrVersion: WideString): HResult; stdcall;
function OnScriptTerminate(var pvarResult: OleVariant;
var pexcepinfo: EXCEPINFO): HResult; stdcall;
function OnStateChange(ssScriptState: tagSCRIPTSTATE): HResult; stdcall;
function OnScriptError(const pscripterror: IActiveScriptError): HResult; stdcall;
function OnEnterScript: HResult; stdcall;
function OnLeaveScript: HResult; stdcall;
end;

Then there is IActiveScriptSiteWindow:

IActiveScriptSiteWindow = interface(IUnknown)
['{D10F6761-83E9-11CF-8F20-00805F2CD064}']
function GetWindow(out phwnd: wireHWND): HResult; stdcall;
function EnableModeless(fEnable: Integer): HResult; stdcall;
end;

These are the only two interfaces you need to implement for the running Active Script to communicate back to the hosting application. Let's get started on the actual demostration app. Create a new VCL Win32 application and drop a TMemo control and a TButton. Then drop a few other controls down on the form because these will be the ones manipulated by the Active Script (although you can manipulate all the controls on the form). Here's what mine looked like:



Now switch to the source view and add AscrLib to the uses clause and add IActiveScriptSite and IActiveScriptSiteWindow to the form declaration as interfaces to implement.

TForm3 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)

Then “implement” them:

TForm3 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
Memo1: TMemo;
Button1: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
ListBox1: TListBox;
ComboBox1: TComboBox;
Edit1: TEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
private
{ Private declarations }
{ IActiveScriptSite }
function GetLCID(out plcid: LongWord): HResult; stdcall;
function GetItemInfo(pstrName: PWideChar;
dwReturnMask: LongWord;
out ppiunkItem: IUnknown;
out ppti: IUnknown): HResult; stdcall;
function GetDocVersionString(out pbstrVersion: WideString): HResult; stdcall;
function OnScriptTerminate(var pvarResult: OleVariant;
var pexcepinfo: EXCEPINFO): HResult; stdcall;
function OnStateChange(ssScriptState: tagSCRIPTSTATE): HResult; stdcall;
function OnScriptError(const pscripterror: IActiveScriptError): HResult; stdcall;
function OnEnterScript: HResult; stdcall;
function OnLeaveScript: HResult; stdcall;
{ IActiveScriptSiteWindow }
function GetWindow(out phwnd: HWND): HResult; stdcall;
function EnableModeless(fEnable: Integer): HResult; stdcall;
public
{ Public declarations }
end;

Most of these functions we don't care at this point, so just put Result := S_OK; in the body of them. The methods GetItemInfo, GetWindow, and OnScriptError are the ones we're going to look at right now. Here's GetItemInfo:

function TForm3.GetItemInfo(pstrName: PWideChar; dwReturnMask: LongWord; out ppiunkItem,
ppti: IInterface): HResult;
begin
Result := S_FALSE;
if SameText('Application', pstrName) then
begin
if dwReturnMask and SCRIPTINFO_IUNKNOWN <> 0 then
begin
ppiunkItem := TAutoObjectDispatch.Create(TApplicationWrapper.Connect(Application)) as IInterface;
Result := S_OK;
Exit;
end;
if dwReturnMask and SCRIPTINFO_ITYPEINFO <> 0 then
begin
Result := TYPE_E_ELEMENTNOTFOUND;
Exit;
end;
end;
end;

This is really all that is needed in order for the Active Script to get access to the application's context. We'll discuss TAutoObjectDispatch and TApplicationWrapper in a moment. So what happens in the script when it refers to “Application“ that is an unknown identifier so the script engine calls out to the script site and asks for this object. In this case this will be the VCL application object, so we have to create a wrapper object and around that a dispatch object that provides the necessary IDispatch based late-binding for the script runtime. From here the real magic starts.

Now lets tell the Active Scripting engine to run a script. To do this we first need to create a CoClass that implements the IActiveScript interface. Through some judicious spelunking with Google, I was able to find the JavaScript and VBScript CLSID GUIDs.

const
CLSID_VBScript: TGUID = '{b54f3741-5b07-11cf-a4b0-00aa004a55e8}';
CLSID_JScript: TGUID = '{f414c260-6ac0-11cf-b6d1-00aa00bbbb58}';

Just put these at the top of the unit. Add two private fields to the form class of type IActiveScript and IActiveScriptParse. Add ComObj to the uses clause. Double click the form to create the OnCreate event and inject this code into it:

procedure TForm3.FormCreate(Sender: TObject);
begin
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
OleCheck(CoCreateInstance(CLSID_JScript, nil, CLSCTX_INPROC_SERVER, IID_IActiveScript, FScript));
OleCheck(FScript.SetScriptSite(Self as IActiveScriptSite));
OleCheck(FScript.AddNamedItem('Application', SCRIPTITEM_ISVISIBLE or SCRIPTITEM_ISSOURCE));
if Supports(FScript, IActiveScriptParse, FParse) then
OleCheck(FParse.InitNew);
end;

Note the AddNamedItem call. That adds the “Application” object to the namespace of the script. So now we're ready to execute some script. Double click the Button1 (the one next to the Memo1). Add the following code to the method body:

procedure TForm3.Button1Click(Sender: TObject);
var
Info: EXCEPINFO;
Code: WideString;
begin
Code := Memo1.Text;
OleCheck(FParse.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0,
SCRIPTITEM_ISVISIBLE or SCRIPTITEM_ISPERSISTENT, nil, Info));
OleCheck(FScript.SetScriptState(SCRIPTSTATE_CONNECTED));
OleCheck(FScript.SetScriptState(SCRIPTSTATE_DISCONNECTED));
end;

Now run the application and enter the following into the Memo:

function main() {
var Component
var MainForm = Application.MainForm
for (var i = 0; i < MainForm.ComponentCount; i++) {
Component = MainForm.GetComponent(i)
MainForm.ListBox1.Items.Add(Component.Name)
}
}

main()

Press Button1. The Listbox should now fill up with all the names of the components on the form. So what the blazes happened!?? Remember the TAutoObjectDispatch class and the TApplicationWrapper from the GetItemInfo function? TAutoObjectDispatch is a descendant of the TObjectDispatch class in the ObjComAuto.dcu unit. Here's the basic declaration of TObjectDispatch:

TObjectDispatch = class(TInterfacedObject, IDispatch)
protected
function GetObjectDispatch(Obj: TObject): TObjectDispatch; virtual;
function GetMethodInfo(const AName: ShortString; var AInstance: TObject): PMethodInfoHeader; virtual;
function GetPropInfo(const AName: string; var AInstance: TObject; var CompIndex: Integer): PPropInfo; virtual;
property Instance: TObject read FInstance;
public
{ IDispatch }
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount: Integer; LocaleID: Integer; DispIDs: Pointer): HRESULT;
virtual; stdcall;
function GetTypeInfo(Index: Integer; LocaleID: Integer;
out TypeInfo): HRESULT; stdcall;
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
ArgErr: Pointer): HRESULT; virtual; stdcall;
public
constructor Create(Instance: TObject; Owned: Boolean = True);
destructor Destroy; override;
end;

We're going to create a descendant, TAutoObjectDispatch, that overrides GetObjectDispatch, GetMethodInfo, and GetPropInfo. In GetObjectDispatch, we'll look up a registered “wrapper” class for the given object, create that wrapper, and then place that back into another instance of TAutoObjectDispatch. I've already done a lot of this in an Automation.pas unit that is included with this project. There are also a bunch of “wrapper” classes for various VCL objects. Remember where I mentioned extended meta-data on public methods? Well the wrappers are where this is handled. The base wrapper class is declared within the {$METHODINFO ON} directive which will tell the compiler to generate extra method RTTI on all public methods of this class and all descendants of that class. It is this extra information that the dynamic invocation code uses to call the functions.

When the scripting engine calls GetItemInfo asking for an interface to the “Application” item, an IDispatch is returned. Then it calls GetIDsOfNames asking for the “MainForm” property. It then calls Invoke to get another IDispatch representing the MainForm, and the process starts all over again. By using the object wrappers you can control with fine detail everything that you want the script to have access to. Keep in mind that all published properties are always available, however you can still control this access by overriding GetPropInfo on TObjectDispatch.

In the next installment, I'll show how you can wire an event directly up to a script function. In the mean-time, take a close look at CreateMethodPointer in ObjComAuto.int contained within the demo for a clue as to how this will be done.

Again, the CodeCentral demo can be found here: http://cc.codegear.com/item/24664