Оформил: DeeCo

Автор: Акуличев Дмитрий

Возникало ли у вас желание изменить поведение своей программы без перекомпиляции? Просили пользователи вашего приложения сделать так, чтобы "мы сами могли что-то там изменить"? Вы перерыли всю Сокровищницу в поисках лучшего "парсера математических выражений"? Возможно, здесь вы найдете что-то полезное для себя.

Технология Active Script предоставляет простой способ оснастить любое приложение поддержкой сценариев (scripts). Сценарии – нечто большее чем еще один способ представления программного кода, но речь сейчас не о том. Возможно, что понимание для чего использовать тот или иной инструмент станет более ясным после ответа на вопрос как использовать этот инструмент. Это и будет темой настоящей статьи.

Сразу оговорюсь, что при написании статьи не ставилась цель дать перевод или пересказ фирменной документации. Вместо этого я постараюсь дать простой, но приближенный к реальности практический пример. Настоятельно рекомендую прямо сейчас скачать прилагаемый к статье архив. В нем вы найдете необходимый интерфейсный модуль, файл справки, который можно подключить к контекстной справке Delphi, и тексты рассматриваемого учебного приложения.

Итак, в путь!

Шаг 0: Собираясь в дорогу.

Прежде всего, нам понадобится описание всех необходимых интерфейсов, типов и констант. Все описания, относящиеся непосредственно к Active Script содержатся в модуле activescp.pas в прилагаемом архиве. Все остальное, что может нам потребоваться, можно найти в стандартных модулях ComObj и ActiveX.

Использование Active Script предполагает взаимодействие двух элементов: машины сценариев (script engine) и носителя сценария (script host). Машина сценариев предоставляется, как правило, сторонним поставщиком. К примеру, Microsoft поставляет в комплекте с браузером Internet Explorer (а фактически в составе операционной системы) целых две скрипт-машины: Visual Basic Scripting Edition (VBScript) и совместимый со стандартом ECMA JScript. Интерфейсы машины сценариев мы подробнее рассмотрим позже, а сейчас самое время создать каркас носителя сценария.

Носитель сценария должен реализовывать обязательный интерфейс IActiveScriptSite и может реализовывать дополнительный интерфейс IActiveScriptSiteWindow. Интерфейс IActiveScriptSite – основной путь взаимодействия машины сценария и носителя. Через этот интерфейс скрипт-машина получает от носителя информацию о прикладных объектах, уведомляет об изменениях своего состояния и ошибках в сценарии. Полностью интерфейс IActiveScriptSite выглядит следующим образом:

IActiveScriptSite = interface(IUnknown)
  function GetLCID(// Запрос языка носителя
    out plcid: LCID
    ): HResult; stdcall;
  function GetItemInfo(// Запрос прикладного объекта
    pstrName: LPCOLESTR; // имя объекта
    dwReturnMask: DWORD; // запрашиваемая информация
    out ppiunkItem: IUnknown; // интерфейс объекта
    out ppti: ITypeInfo // инфомация о типе объекта
    ): HResult; stdcall;
  function GetDocVersionString(// Запрос версии сценария
    out pbstrVersion: WideString
    ): HResult; stdcall;
  function OnScriptTerminate(// Уведомление о завершении
    var pvarResult: OleVariant; // возвращаемое значение
    var pexcepinfo: EXCEPINFO // информация об ошибке
    ): HResult; stdcall;
  function OnStateChange(// Уведомление об изменении состояния
    ssScriptState: SCRIPTSTATE // новое состояние
    ): HResult; stdcall;
  function OnScriptError(// Уведомление об ошибке
    const pscripterror: IActiveScriptError
    ): HResult; stdcall;
  // Начало исполнения
  function OnEnterScript: HResult; stdcall;
  // Окончание исполнения
  function OnLeaveScript: HResult; stdcall;
end;

Реализация интерфейса IActiveScriptSiteWindow может потребоваться в том случае, если машина сценариев предоставляет возможность сценарию создавать интерактивные элементы (например, функция MsgBox в VBScript). Интерфейс очень простой:

IActiveScriptSiteWindow = interface(IUnknown)
  function GetWindow(out phwnd: HWND): HResult; stdcall;
  function EnableModeless(fEnable: BOOL): HResult; stdcall;
end;

Метод GetWindow должен вернуть дескриптор окна, которое будет родительским для всех дополнительных окон (например, диалогов), которые может создавать сценарий. Метод EnableModeless вызывается как уведомление о том, что сценарий собирается отображать модальный диалог.

Реализацию интерфейсов носителя сценария можно, в принципе, возложить на любой объект в приложении, но в нашем случае простого учебного проекта имеет смысл реализовать эти интерфейсы в главной форме. Добавим модули activescp и ActiveX в список модулей, и изменим описание класса формы следующим образом:

TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
private
  { Private declarations }
protected
  {IActiveScriptSite}
  function GetLCID(out plcid: LCID): HResult; stdcall;
  function GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD;
    out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult; stdcall;
  function GetDocVersionString(
    out pbstrVersion: WideString): HResult; stdcall;
  function OnScriptTerminate(var pvarResult: OleVariant;
    var pexcepinfo: EXCEPINFO): HResult; stdcall;
  function OnStateChange(
    ssScriptState: SCRIPTSTATE): HResult; stdcall;
  function OnScriptError(
    const pscripterror: IActiveScriptError): HResult; stdcall;
  function OnEnterScript: HResult; stdcall;
  function OnLeaveScript: HResult; stdcall;
protected
  {IActiveSriptSiteWindow}
  function GetWindow(out phwnd: HWND): HResult; stdcall;
  function EnableModeless(fEnable: BOOL): HResult; stdcall;
public
  { Public declarations }
end;

Реализацию части методов можно выполнить сразу:

function TForm1.GetLCID(out plcid: LCID): HResult;
begin
  plcid := GetSystemDefaultLCID;
  Result := S_OK;
end;

function TForm1.GetWindow(out phwnd: HWND): HResult;
begin
  phwnd := Handle;
  Result := S_OK;
end;

Это будет их полная и неизменная реализация. Для остальных же методов пока используем заглушки. Методы запроса информации пометим как нереализованные:

function TForm1.GetDocVersionString(
  out pbstrVersion: WideString): HResult;
begin
  Result := E_NOTIMPL;
end;

function TForm1.GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD;
  out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

Остальные методы представляют собой уведомления, поэтому в их реализации просто вернем S_OK, в будущем в них будет, возможно, более серьёзная реакция. Полностью каркас носителя сценария можно найти в папке Step0 прилагаемого архива.

Шаг 1: Поехали!

Теперь у нас все готово для серьезного дела. Начнем же мы с создания и завершения машины сценариев. Как уже было сказано, в системе может быть установлено несколько скрипт-машин, поэтому имеет смысл все связанное с выбором конкретного языка сценария и реализации скрипт-машины выделить в отдельный модуль. В архиве находится готовый модуль Scripts, содержимое его достаточно тривиально, просто включите его в проект. Скажу только, что при желании использовать машины сценариев сторонних производителей достаточно только расширить перечислимый тип TScriptLanguage и массив ScriptProgIDs.

Добавим в описание класса формы следующие объявления:

TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
  ...
  private
  FEngine: IActiveScript;
  FParser: IActiveScriptParse;
  procedure CreateScriptEngine(Language: TScriptLanguage);
  procedure CloseScriptEngine;
  ...
end;

Поле FEngine будет содержать ссылку на основной интерфейс машины сценариев, а поле FParser будет содержать ссылку на дополнительный интерфейс интерпретатора сценария.

В метод CreateScriptEngine поместим код создания COM-объекта машины сценариев, запроса интерфейсов, установка ссылки на носитель и инициализации:

procedure TForm1.CreateScriptEngine(Language: TScriptLanguage);
begin
  CloseScriptEngine;
  FEngine := CreateComObject(ScriptCLSIDs[Language]) as IActiveScript;
  FParser := FEngine as IActiveScriptParse;
  FEngine.SetScriptSite(Self);
  FParser.InitNew;
end;

procedure TForm1.CloseScriptEngine;
begin
  FParser := nil;
  if FEngine <> nil then
    FEngine.Close;
  FEngine := nil;
end;

Осталось только добавить запуск и остановку в обработчики событий OnCreate и OnDestroy формы. Разумеется, пока что лишь исключительно в тестовых целях:

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseScriptEngine;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateScriptEngine(slVBScript);
  // на выбор
  // CreateScriptEngine(slJScript);
end;

Полный текст проекта находится в папке Step1 архива. Что можно полезного извлечь из такого приложения? Выполнить в отладчике и наблюдать вызов методов TForm1.GetLCID при выполнении FEngine.SetScriptSite и TForm1.OnStateChange с параметрами SCRIPTSTATE_INITIALIZED (5) и SCRIPTSTATE_CLOSED (4) при выполнении FParser.InitNew и FEngine.Close соответственно.

Шаг 2: Первый работающий сценарий.

Сейчас наш проект довольно значительно усложнится. Для начала добавим к форме несколько компонентов:

Имена компонентов (слева направо, сверху вниз): ExpressionButton, ExpressionEdit, ScriptButton, ScriptMemo, LanguageRadioGroup, TestButton. По нажатию ExpressionButton будем вычислять выражение из ExpressionEdit и показывать результат:

procedure TForm1.ExpressionButtonClick(Sender: TObject);
var
  Language: TScriptLanguage;
  Code: WideString;
  Result: OleVariant;
  ExcepInfo: TEXCEPINFO;
begin
  Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
  CreateScriptEngine(Language);
  Code := ExpressionEdit.Text;
  if FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0,
    SCRIPTTEXT_ISEXPRESSION, Result, ExcepInfo) = S_OK then
    ShowMessage(Result);
end;

Выражение может содержать константы, операции, встроенные функции, все то, что обычно может использоваться в правой части оператора присваивания в языке. К примеру, при выборе языка VBScript можно попробовать вычислить выражение

Sin(0.15) * 5.3 + Cos(0.23) / 0.5

По нажатию ScriptButton будем выполнять сценарий из ScriptMemo:

procedure TForm1.ScriptButtonClick(Sender: TObject);
var
  Language: TScriptLanguage;
  Code: WideString;
  Result: OleVariant;
  ExcepInfo: TEXCEPINFO;
begin
  Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
  CreateScriptEngine(Language);
  Code := ScriptMemo.Text;
  FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
    ExcepInfo);
end;

Исполняемый сценарий может содержать непосредственно исполняемые операторы, функции, глобальные переменные, в общем, все что угодно, например такой сценарий (VBScript):

Public Function Test(X, Str)
  Test = "X=" & X & vbCrLf & "Str=" & Str
End Function

Dim FloatVar
Dim StrVar

FloatVar = 7.89
StrVar = "Hello, world."
MsgBox Test(FloatVar, StrVar)

Этот сценарий нам еще пригодится: по нажатию TestButton мы будем вызывать из уже загруженного сценария функцию Test с использованием великолепной возможности Delphi – вызова методов COM-объектов с поздним связыванием:

procedure TForm1.TestButtonClick(Sender: TObject);
var
  Disp: IDispatch;
  VarDisp,
    VarResult: OleVariant;
begin
  if FEngine = nil then
    Exit;
  FEngine.GetScriptDispatch(nil, Disp);
  VarDisp := Disp;
  VarResult := VarDisp.Test(1.23, 'abc');
  ShowMessage(VarToStr(VarResult));
end;

С использованием позднего связывания можно получить доступ не только к глобальным функциям сценария, но и к глобальным переменным, они будут доступны как свойства. Например, в вышеприведенном сценарии можно прочитать и записать значения переменных FloatVar и StrVar:

VarDisp.FloatVar := < выражение > ;
< переменная > := VarDisp.StrVar;

Естественно, имена функций и переменных в этом случае будут жестко заданными, имена объектов в сценарии должны будут подчиняться некоторым требованиям со стороны приложения. Как получить доступ к любым объектам в сценарии будет показано дальше.

Шаг 3: Обработка ошибок.

Все ошибки сценария, как времени исполнения, так и ошибки разбора текста, обрабатываются централизовано через вызов метода OnScriptError интерфейса IActiveScriptSite. Условимся, что в нашем проекте реакцией на ошибку сценария будет показ формы с подробным описанием.

Добавим в проект новую форму TErrorForm (модуль errfrm.pas в папке Step3 архива). В описание класса формы добавим одно свойство:

TErrorForm = class(TForm)
  ...
  private
  FScriptError: IActiveScriptError;
public
  property ScriptError: IActiveScriptError read FScriptError
    write FScriptError;
end;

Вспомогательный интерфейс IActiveScriptError служит для получения детальной информации об ошибке сценария:

IActiveScriptError = interface(IUnknown)
  function GetExceptionInfo(// Получить описание ошибки
    out pexcepinfo: EXCEPINFO
    ): HResult; stdcall;
  function GetSourcePosition(// Получить позицию ошибки в тексте
    out pdwSourceContext: DWORD; // контекст (см. ParseSriptText)
    out pulLineNumber: ULONG; // номер строки
    out plCharacterPosition: Integer // номер символа в строке
    ): HResult; stdcall;
  function GetSourceLineText(// Строка кода, вызвавшая ошибку
    out pbstrSourceLine: WideString
    ): HResult; stdcall;
end;

Ссылка на этот интерфейс передается в вызов IActiveScriptSite.OnScriptError. Этот интерфейс мы будем передавать форме TErrorForm и в событии OnShow будем заполнять элементы управления:

procedure TErrorForm.FormShow(Sender: TObject);
var
  ei: EXCEPINFO;
  Context: DWORD;
  Line: UINT;
  Pos: integer;
  SourceLineW: WideString;
  SourceLine: string;
begin
  if FScriptError = nil then
    exit;
  FScriptError.GetExceptionInfo(ei);
  if @ei.pfnDeferredFillIn <> nil then
    ei.pfnDeferredFillIn(@ei);
  FScriptError.GetSourcePosition(Context, Line, Pos);
  FScriptError.GetSourceLineText(SourceLineW);
  SourceLine := SourceLineW;
  DescriptionLabel.Caption := ei.bstrDescription;
  Caption := ei.bstrSource;
  DetailStatic.Caption := Format('Строка: %d'#13#10'Позиция: %d'#13#10'%s'    , [Line
    + 1, Pos + 1, SourceLine]);
  FScriptError := nil;
  MessageBeep(MB_ICONHAND);
end;

Теперь код метода OnScriptError будет совсем простой:

function TForm1.OnScriptError(
  const pscripterror: IActiveScriptError): HResult;
begin
  Result := S_OK;
  with TErrorForm.Create(nil) do
  begin
    ScriptError := pscripterror;
    ShowModal;
    Free;
  end;
end;

Насладившись реакцией интерпретатора на японские хоку вместо привычного бейсика перейдем к делам поважнее.

Шаг 4: Первый прикладной объект.

Исполнение сценария в автономном режиме, вызов функций с известными именами и получение значений – сами по себе, несомненно, мощные возможности, но они ничто по сравнению с возможностью сценария управлять непосредственно объектами приложения.

Получить такую возможность можно, оформив прикладные объекты как программируемые объекты (Automation object) и сделав их доступными сценарию. В общем случае программируемые объекты – это COM-объекты, реализующие двойной интерфейс (dual interface) т.е. обычный интерфейс для прямых вызовов и IDispatch для позднего связывания. В простейшем случае достаточно только IDispatch, тогда обращение к объекту возможно только с использованием позднего связывания.

Какой же объект выбрать на роль первопроходца? С одной стороны он должен быть достаточно простым (проект у нас ведь как-никак исследовательский), а с другой – достаточно полезным (иначе не интересно). Кто работал с VBA (хотя бы в том же MS Office), знаком с объектом Debug. Вот аналог такого объекта мы и попробуем сделать.

Итак, объект Debug. У объекта один единственный метод Print, принимающий произвольное количество параметров любого типа (вернее, все параметры типа Variant). Реализация такого метода возможна только с использованием позднего связывания, а так как других методов у объекта нет, то кроме поддержки IDispatch такому объекту больше ничего не нужно. Вообще-то, тот путь, которым мы собираемся пойти, не совсем обычный: мы собираемся добраться до самых “косточек” реализации диспинтерфейсов. Обычно так COM-объекты не пишут (хотя магического запрета и нет), есть мастера и высокоуровневые классы, но в нашем случае такой подход будет простым и эффективным.

Добавим к проекту новый модуль (dbgobj.pas в папке Step4), в нем опишем класс:

TDebug = class(TInterfacedObject, IDispatch)
private
  FLines: TStrings;
protected
  function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  function GetTypeInfo(Index, LocaleID: Integer;
    out TypeInfo): HResult; stdcall;
  function GetIDsOfNames(const IID: TGUID; Names: Pointer;
    NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
    Flags: Word; var Params; VarResult, ExcepInfo,
    ArgErr: Pointer): HResult; stdcall;
public
  constructor Create(ALines: TStrings);
end;

Как видно, кроме реализации интерфейса IDispatch в классе содержится еще только ссылка на список строк, в который и будут записываться результаты вызовов метода Print.

Информацию о типе наш объект не поддерживает, поэтому первые два метода будут просто заглушками:

function TDebug.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result := S_OK;
end;

function TDebug.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  Pointer(TypeInfo) := nil;
  Result := E_NOTIMPL;
end;

Следующие два метода ответственны за реализацию позднего связывания. Метод GetIDsOfNames должен вернуть идентификаторы (DispID) для метода и именованных аргументов метода. В нашем случае в задачу метода входит определить обращение к имени “Print” и вернуть код ошибки для всех остальных имен:

function TDebug.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
  LocaleID: Integer; DispIDs: Pointer): HResult;
type
  TDispIDsArray = array[0..0] of TDISPID;
  PDispIDsArray = ^TDispIDsArray;
var
  IDs: PDispIDsArray absolute DispIDs;
  i: integer;
  Name: WideString;
begin
  // Не поддерживаем именованные аргументы
  if NameCount > 1 then
    Result := DISP_E_UNKNOWNNAME
  else if NameCount < 1 then
    Result := E_INVALIDARG
  else
    Result := S_OK;
  for i := 0 to NameCount - 1 do
    IDs[i] := DISPID_UNKNOWN;
  if NameCount = 1 then
  begin
    Name := PWideChar(Names^);
    if UpperCase(Name) = 'PRINT' then
      IDs[0] := 1
    else
      Result := DISP_E_UNKNOWNNAME;
  end;
end;

Для метода Print возвращается DispID = 1. Это значение будет потом использоваться в функции Invoke при выполнении метода:

const // этих констант нет в модулях Delphi
  VARIANT_ALPHABOOL = 2; // Лог. значения представлять литералами
  VARIANT_LOCALBOOL = 16; // Лог. литералы на местном языке

function TDebug.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var
  P: TDISPPARAMS absolute Params;
  i: integer;
  S: string;
  V: OleVariant;
begin
  if (DispID = DISPID_PRINT) and (Flags = DISPATCH_METHOD) then
  begin
    S := '';
    // Параметры в массиве в обратном порядке!
    for i := P.cArgs - 1 downto 0 do
    begin
      // Преобразуем параметр в строку
      Result := VariantChangeType(V, OleVariant(P.rgvarg[i]),
        VARIANT_ALPHABOOL or VARIANT_LOCALBOOL, VT_BSTR);
      // Ошибку преобразования вернем как ошибку метода
      if Result <> S_OK then
        exit;
      if S <> '' then
        S := S + ' ';
      S := S + V;
    end;
    FLines.Add(S);
    Result := S_OK;
  end
  else
    Result := DISP_E_MEMBERNOTFOUND;
end;

Итак, объект готов. Как же сделать его доступным сценарию? Для этого служат методы IActiveScript.AddNamedItem и IActiveScriptSite.GetItemInfo. Первый вызывается приложением для регистрации именованного объекта в пространстве имен сценария, а второй вызывается машиной сценариев для получения информации об объекте, в первую очередь интерфейса объекта. Так как в реальном приложении может быть большое число объектов, имеет смысл организовать их в какую-нибудь регулярную структуру.

Добавим к проекту новый модуль (nmitems.pas в папке Step4). В интерфейсной части модуля опишем класс TNamedItemList:

TNamedItemList = class(TObjectList)
public
  constructor Create;
  procedure AddItem(const Name: string; Item: TInterfacedObject);
  function GetItemIUnknown(const Name: string): IUnknown;
end;

Этот класс будет хранить список именованных объектов, представленных в пространстве имен сценария. Элементами списка будут экземпляры класса (описанного в секции реализации):

TNamedItem = class
protected
  FTypeInfo: ITypeInfo;
  FUnknown: IUnknown;
  FName: string;
end;

Выбор такой организации хранения именованных объектов обусловлен стремлением свести к минимуму заботы по управлению структурой: класс TObjectList сам управляет временем жизни хранимых экземпляров, а уничтожение экземпляров автоматически освобождает ссылки на интерфейсы в полях.

Теперь можно перейти непосредственно к реализации прикладных объектов в сценарии. Для начала немного изменим главную форму проекта. Уберем кнопку и строку редактирования для простых выражений и добавим еще один редактор (TMemo) – это будет окно вывода объекта Debug:

Добавим в список модулей dbgobj и nmitems и изменим описание класса фомы:

TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
  ...
  private
  ...
    FNamedItems: TNamedItemList;
  procedure AddNamedItem(const Name: string; Flags: DWORD; Item:
    TInterfacedObject);
  ...
end;

Естественно, не забудем вставить в обработчики OnCreate и OnDestroy формы создание и удаление списка. Добавление объектов в пространство имен сценария будем выполнять методом AddNamedItem:

procedure TForm1.AddNamedItem(const Name: string; Flags: DWORD; Item:
  TInterfacedObject);
var
  NameW: WideString;
begin
  FNamedItems.AddItem(Name, Item);
  NameW := Name;
  FEngine.AddNamedItem(PWideChar(NameW), Flags);
end;

В метод CloseScriptEngine добавим строку

FNamedItems.Clear;

Изменим обработку ScriptButton для регистрации объекта Debug:

procedure TForm1.ScriptButtonClick(Sender: TObject);
var
  Language: TScriptLanguage;
  Code: WideString;
  Result: OleVariant;
  ExcepInfo: TEXCEPINFO;
begin
  Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
  CreateScriptEngine(Language);
  AddNamedItem('Debug', SCRIPTITEM_ISVISIBLE, TDebug.Create(DebugMemo.Lines));
  Code := ScriptMemo.Text;
  FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
    ExcepInfo);
end;

Ну вот, первый прикладной объект готов, можно приступать к натурным испытаниям:

Dim X
Debug.Print "Разные значения: "
Debug.Print "Строка ", "abcd"
Debug.Print "Целое ", 1234
Debug.Print "Вещественное", Sin(0.123)
Debug.Print "Логическое ", 1 > 0
Debug.Print " = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = "
Debug.Print "x", vbTab, "sin(x)"
Debug.Print " = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = "
for X = -1 to 1 Step 0.1
  Debug.Print FormatNumber(X, 2), vbTab, Sin(X)
  Next

Разумеется, реальные прикладные объекты будут мало похожи на предыдущий, хотя и полезный, но экзотический объект. Реальные объекты будут иметь по доброму десятку свойств и методов, а так же будут являться источниками событий, обрабатывать которые тоже может код сценария. Последняя возможность представляется мне наиболее важной, ради которой и стоит оснащать приложение поддержкой сценариев.

Но прежде чем пустить в ход тяжелую артиллерию полноценных Automation-объектов нам придется немного доработать инфраструктуру нашего приложения. Прежде всего, обновим список именованных объектов (модуль nmitems.pas, папка Step5) для использования не только простейших объектов, но и полноценных Automation-объектов:

TNamedItemList = class(TObjectList)
public
  constructor Create;
  procedure AddItem(const Name: string; Item: TInterfacedObject); overload;
  procedure AddItem(const Name: string; Item: TComObject); overload;
  function GetItemIUnknown(const Name: string): IUnknown;
  function GetItemITypeInfo(const Name: string): ITypeInfo;
end;

Для того чтобы сценарий мог обрабатывать события от прикладных объектов, объекты должны предоставлять информацию о типе посредством интерфейса ITypeInfo. Поэтому предусмотрим получение и хранение ссылки на этот интерфейс в списке именованных объектов:

procedure TNamedItemList.AddItem(const Name: string; Item: TComObject);
var
  I: TNamedItem;
begin
  I := TNamedItem.Create;
  if Item is TTypedComObject then
    I.FTypeInfo := TTypedComObjectFactory(Item.Factory).ClassInfo
  else
    I.FTypeInfo := nil;
  I.FUnknown := Item;
  I.FName := AnsiUpperCase(Name);
  Add(I);
end;

Добавим в класс формы перегруженную версию функции AddNamedItem:

TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
  ...
  private
  ...
    procedure AddNamedItem(const Name: string; Flags: DWORD; Item:
      TInterfacedObject); overload;
  procedure AddNamedItem(const Name: string; Flags: DWORD; Item: TComObject);
    overload;
end;

Реализация новой версии функции текстуально полностью идентична версии для простого объекта. Изменим реализацию GetItemInfo для возврата информации о типе, и приложение практически готово к использованию полноценных программируемых объектов:

function TForm1.GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD;
  out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult;
begin
  if @ppiunkItem <> nil then
    Pointer(ppiunkItem) := nil;
  if @ppti <> nil then
    Pointer(ppti) := nil;
  if (dwReturnMask and SCRIPTINFO_IUNKNOWN) <> 0 then
    ppiunkItem := FNamedItems.GetItemIUnknown(pstrName);
  if (dwReturnMask and SCRIPTINFO_ITYPEINFO) <> 0 then
    ppti := FNamedItems.GetItemITypeInfo(pstrName);
  Result := S_OK;
end;

Вот мы и подошли вплотную к созданию прикладного объекта. Давайте сделаем доступной сценарию, например, кнопку. Для этого нам понадобится OLE-оболочка для VCL-объекта. Положим, что мы желаем сделать доступными одно свойство для чтения/записи (Caption), один метод (SetBounds) и одно событие (естественно, OnClick). Набор невелик, но представителен.

Воспользуемся мастером Automation Object с вкладки AtiveX. Поля мастера заполним следующим образом: CoClassName – Button; Instancing – Internal; Threading Model – Apartment. Установим флажок “Generate Event support code”. Мастер добавит в проект библиотеку типов и создаст модуль реализации COM-объекта. Сохраним его под именем Wrapper (папка Step5 архива). Откроем редактор библиотеки типов (меню View | Type Library), добавим в интерфейсу IButton свойство Caption (тип BSTR) и метод SetBounds, а в диспинтерфейс IButtonEvents – метод OnClick. В модуле Wrapper добавим в список модулей StdCtrls и изменим описания:

type
  TVCLButton = StdCtrls.TButton;
  TButton = class(TAutoObject, IConnectionPointContainer, IButton)
  private
    ...
      FButton: TVCLButton;
    procedure ButtonClick(Sender: TObject);
  public
    ...
      constructor Create(AButton: TVCLButton);
    destructor Destroy; override;
    ...
  end;
  TButtonWrapper = TButton;

Осталось реализовать методы, и наш объект готов. Никакой сложной работы не предвидится – ведь это всего лишь обертка:

constructor TButton.Create(AButton: TVCLButton);
begin
  inherited Create;
  FButton := AButton;
  if FButton <> nil then
    FButton.OnClick := ButtonClick;
end;

destructor TButton.Destroy;
begin
  if FButton <> nil then
    FButton.OnClick := nil;
  inherited Destroy;
end;

function TButton.Get_Caption: WideString;
begin
  if FButton <> nil then
    Result := FButton.Caption;
end;

procedure TButton.Set_Caption(const Value: WideString);
begin
  if FButton <> nil then
    FButton.Caption := Value;
end;

procedure TButton.ButtonClick(Sender: TObject);
begin
  if FEvents <> nil then
    FEvents.OnClick;
end;

procedure TButton.SetBounds(Left, Top, Width, Height: Integer);
begin
  if FButton <> nil then
    FButton.SetBounds(Left, Top, Width, Height);
end;

Вернемся к главной форме нашего проекта. Прежде всего вернем на место кнопку TestButton – это и будет наш прикладной объект, управлять которым мы будем из сценария. В список модулей (в секции реализации, чтобы не вызвать конфликт имен) добавим модуль Wrapper. Осталось только изменить процедуру загрузки сценария:

procedure TForm1.ScriptButtonClick(Sender: TObject);
var
  Language: TScriptLanguage;
  Code: WideString;
  Result: OleVariant;
  ExcepInfo: TEXCEPINFO;
begin
  Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
  CreateScriptEngine(Language);
  AddNamedItem('Debug', SCRIPTITEM_ISVISIBLE, TDebug.Create(DebugMemo.Lines));
  AddNamedItem('Button', SCRIPTITEM_ISVISIBLE or SCRIPTITEM_ISSOURCE,
    TButtonWrapper.Create(TestButton));
  Code := ScriptMemo.Text;
  FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
    ExcepInfo);
  FEngine.SetScriptState(SCRIPTSTATE_CONNECTED);
end;

Здесь следует обратить внимание на два отличия от предыдущего варианта. Первое: флаги в вызове AddNamedItem. Если объект является источником событий, то необходимо указывать флаг SCRIPTITEM_ISSOURCE. Второе: вызов SetScriptState. Перевод машины сценариев в состояние SCRIPTSTATE_CONNECTED вызывает запрос информации о типе (вызов GetItemInfo с флагом SCRIPTINFO_ITYPEINFO) и подключение к источнику событий (вызов интерфейса IConnectionPointContainer объекта).

Теперь можно испытать, как все это будет работать:

// Button "OnClick" event handler
Sub Button_OnClick
Debug.Print Button
end Sub

// Startup code
with Button
  .SetBounds 5, 120, 90, 90
  Debug.Print.Caption
  .Caption = "Click me!"
end with

Вроде бы все работает, кнопка изменила размеры и надпись. Попробуем нажать? Ой! Мы забыли дописать обращение к свойству при вызове метода Print. Можно просто исправить текст

Debug.Print Button.Caption

перезагрузить сценарий и забыть. Но здесь есть над чем подумать.

Вспомним, что для объектов OLE Automation существует механизм свойств по умолчанию. К примеру, для надписей, строк редактирования, кнопок и т.п. объектов свойством по умолчанию обычно являются Text или Caption, для поля таблицы свойством по умолчанию может быть Value. Как правило, свойством по умолчанию является интуитивно ассоциируемое с объектом значение, и обычно это оказывается наиболее часто используемое свойство. В чем смысл использования свойств по умолчанию? Вспомним, что языки сценариев – это чаще всего языки с поздним связыванием. Т.е. для вызова любого метода или свойства машине сценариев приходится осуществлять два вызова интерфейса IDispatch объекта. Первым вызовом GetIDsOfNames по имени метода или свойства определяется его числовой идентификатор (DispID), а потом вызовом Invoke осуществляется исполнение метода или доступ к свойству. Для свойства по умолчанию DispID фиксирован и известен заранее, поэтому интерпретатор сценария может сразу вызвать Invoke с известным DispID. Реализация свойства по умолчанию очень проста: в описании интерфейса свойству необходимо назначить специальное значение DISPID_VALUE (0). В редакторе библиотеки типов это можно сделать, вписав числовое значение (0) в поле ID на вкладке Attributes.

Шаг 6: Чем дальше в лес...

Итак, мы уже умеем запускать машину сценариев, исполнять сценарии, работать с объектами и событиями, казалось бы, чего же больше? Вероятно, не хватает только возможности заглянуть во внутренности сценария: перечислить глобальные переменные, функции и их параметры, просмотреть и изменить значения переменных, вызвать функции.

Ранее мы уже рассматривали доступ к переменным и функциям с использованием раннего связывания, но были ограничены необходимостью знать имена объектов заранее. А если имена заранее неизвестны? Можно ли получить, к примеру, список глобальных переменных или функций? Да, можно.

Вспомним, что интерфейс IDispatch может предоставлять информацию о типе. Для этого служит интерфейс ITypeInfo и методы GetTypeInfoCount и GetTypeInfo интерфейса IDispatch, а интерфейс IDispatch для всего сценария можно получить вызовом IActiveScript.GetScriptDispatch.

Предлагаю читателю самостоятельно разобраться с проектом в папке Step6 архива. Приложение несет всю ранее рассмотренную функциональность. Кроме того, добавлена форма, с помощью которой можно просмотреть список глобальных переменных и функций, просмотреть и задать значения переменных и вызвать функции.

Напоследок.

Вот и подошла к концу наша прогулка, вернее, наш совместный путь. А чтобы не скучать в одиночестве, маленький подарок, который вы найдете в папке Bonus. Это программа построения параметрически заданных кривых. Точки кривой, естественно, рассчитываются сценарием. Сценарий должен содержать следующие объекты:

В папке содержатся так же примеры сценариев VBScript и JScript.