COM-объекты в MS Script Control. Присвоение метода одного объекта другому объекту. - Общие вопросы Delphi

Антон Ю.Б. · 23.03.2009, 16:29

Работаем в программе с MS Script Control, в который включаю свой объект из программы. Для возможности обращения (и назначения) несуществующих полей у этого объекта в скрипте (JScript) реализуем в этом своем объекте IDispatch, где делаем свою реализацию GetIDsOfNames и Invoke. Следуем Тенцеру, но у него рассмотрено только присвоение неопределенных свойств, но не методов. Если мы делаем что-то типа MyObj.a=function(){return 2;}; или MyObj.a=JSObj.b, (где справа стоит некий существующий объект скрипта) то эти ситуации обработать достаточно просто. Проблема возникает при попытке присвоения типа MyObj.b=OtherCOMObj.AnyMethod (где справа стоит другой внедренный COM-объект). Само присвоение проходит нормально в том смысле, что в Invoke в качестве сохраняемого значения запоминаем во вспомогательной структуре PVariantArray( Parms.rgvarg )^[0], который потом на флаге DISPATCH_METHOD в Invoke возвращаем в OleVariant( VarResult^ ):=... Если после этого сделать вызов MyObj.b(); (тестируем на методе без параметров), то получаем "Could not convert Variant of Type (Dispatch) into Type (String)". Если же выполнить вот такую последовательность: MyObj.b=OtherCOMObj.AnyMethod;var TempJSObj = new Object();TempJSObj.b=MyObj.b; то вызов TempJSObj.b(); ошибок уже не дает, но возвращает пустой результат. Соответственно, вопрос - можно ли как-то добиться возможности прямого вызова MyObj.b(); или хотя бы вызова TempJSObj.b(); с ожидаемым результатом?

P.S. Если, например, сделать в браузере document.bb=document.toString();ale rt(document.bb()); то получим ожидаемое "[object]". Если внедрить в скрипт IHTMLDocument2, то вычисление document.bb(); (после упомянутого присвоения) вернет пустую строку.
P.P.S. Для MS Script Control используем обертку psvActiveScript и параллельно MSScriptControl_TLB (в последнем случае вылетов больше).

Антон Ю.Б. · 04.04.2009, 13:41

Разверну вопрос наглядным (и более простым) примером. Так как времени прошло много, да и объем примера значителен, то прошу модераторов не засчитывать даблпостинг.

Итак, если создать простой HTML файл:

Код:

<body>
<script>
document.bb=document.toString;
alert(document.bb());
</script>
</body>

то в браузере мы увидим ожидаемое: "[Object HTMLDocument]".
Попробуем повторить этот пример в Delphi с помощью стандартной обертки для MS Script Control, полученной через инструмент Import ActiveX Control:

Код:

TMyThread = class( TThread )
  private
    Doc: IHTMLDocument2;
    ScriptControl: TScriptControl;
  public
    constructor ACreate;
    procedure Execute; override;
  end;


procedure TMyThread.Execute;
var
  v: Variant;
begin
  CoInitializeEx( nil, COINIT_APARTMENTTHREADED );

  ScriptControl := TScriptControl.Create( nil );
  ScriptControl.Language:='JScript';
  ScriptControl.UseSafeSubset := False;
  ScriptControl.AllowUI := true;
  ScriptControl.TimeOut := -1;
  ScriptControl.Reset;

  CoCreateInstance( mshtml.CLASS_HTMLDocument,
                    nil,
                    CLSCTX_INPROC_SERVER,
                    IID_IHTMLDocument2,
                    Doc );
  Doc.designMode := 'on';
  v := VarArrayCreate( [0, 0], varVariant );
  v[0] := '<html><head></head><body><form name=frm action="#"></form></body></html>';
  Doc.Clear;
  while ( Doc.readyState <> 'complete' ) do
  begin
    Application.ProcessMessages;
  end;
  Doc.Write( PSafeArray( TVarData( v ).VArray ) );
  Doc.Close;
  while ( Doc.readyState <> 'complete' ) do
  begin
    Application.ProcessMessages;
  end;

  ScriptControl.AddObject( 'Document', IDispatch(Doc), true );
  ScriptControl.ExecuteStatement( 'Document.bb=Document.toString;' );
  ScriptControl.ExecuteStatement( 'Document.bb();' );

  CoUninitialize;
end;

или как вариант:

Код:

procedure TMyThread.Execute;
var
  v: Variant;
begin
  CoInitializeEx( nil, COINIT_APARTMENTTHREADED );

  ScriptControl := TScriptControl.Create( nil );
  ScriptControl.Language:='JScript';
  ScriptControl.UseSafeSubset := False;
  ScriptControl.AllowUI := true;
  ScriptControl.TimeOut := -1;
  ScriptControl.Reset;

  ScriptControl.ExecuteStatement( 'var Document = new ActiveXObject("htmlfile");' );
  ScriptControl.ExecuteStatement( 'Document.bb=Document.toString;' );
  ScriptControl.ExecuteStatement( 'var s=Document.bb();' );

  CoUninitialize;
end;

Для чистоты эксперимента последний вариант можно проверить также и в браузере (и мы получим уже описанный результат), однако, оба варианта в Delphi на присвоении var s=Document.bb(); дают Exception class EOleException with message 'Разрешение отклонено'. Может ли кто-то пояснить такую разность поведений?

P.S. CoInitializeEx( nil, COINIT_MULTITHREADED ); невозможно, так как программа тогда осыпается на ScriptControl.Reset; Но все эксперименты с другими обертками над MS Script Control, где возможно COINIT_MULTITHREADED на указанном присвоении приводят к тому же результату.

23.03.2009, 16:29	#1
Антон Ю.Б. Форумчанин Регистрация: 03.01.2009 Сообщений: 116	COM-объекты в MS Script Control. Присвоение метода одного объекта другому объекту. Работаем в программе с MS Script Control, в который включаю свой объект из программы. Для возможности обращения (и назначения) несуществующих полей у этого объекта в скрипте (JScript) реализуем в этом своем объекте IDispatch, где делаем свою реализацию GetIDsOfNames и Invoke. Следуем Тенцеру, но у него рассмотрено только присвоение неопределенных свойств, но не методов. Если мы делаем что-то типа MyObj.a=function(){return 2;}; или MyObj.a=JSObj.b, (где справа стоит некий существующий объект скрипта) то эти ситуации обработать достаточно просто. Проблема возникает при попытке присвоения типа MyObj.b=OtherCOMObj.AnyMethod (где справа стоит другой внедренный COM-объект). Само присвоение проходит нормально в том смысле, что в Invoke в качестве сохраняемого значения запоминаем во вспомогательной структуре PVariantArray( Parms.rgvarg )^[0], который потом на флаге DISPATCH_METHOD в Invoke возвращаем в OleVariant( VarResult^ ):=... Если после этого сделать вызов MyObj.b(); (тестируем на методе без параметров), то получаем "Could not convert Variant of Type (Dispatch) into Type (String)". Если же выполнить вот такую последовательность: MyObj.b=OtherCOMObj.AnyMethod;var TempJSObj = new Object();TempJSObj.b=MyObj.b; то вызов TempJSObj.b(); ошибок уже не дает, но возвращает пустой результат. Соответственно, вопрос - можно ли как-то добиться возможности прямого вызова MyObj.b(); или хотя бы вызова TempJSObj.b(); с ожидаемым результатом? P.S. Если, например, сделать в браузере document.bb=document.toString();ale rt(document.bb()); то получим ожидаемое "[object]". Если внедрить в скрипт IHTMLDocument2, то вычисление document.bb(); (после упомянутого присвоения) вернет пустую строку. P.P.S. Для MS Script Control используем обертку psvActiveScript и параллельно MSScriptControl_TLB (в последнем случае вылетов больше).

04.04.2009, 13:41	#2
Антон Ю.Б. Форумчанин Регистрация: 03.01.2009 Сообщений: 116	Разверну вопрос наглядным (и более простым) примером. Так как времени прошло много, да и объем примера значителен, то прошу модераторов не засчитывать даблпостинг. Итак, если создать простой HTML файл: Код: `<body> <script> document.bb=document.toString; alert(document.bb()); </script> </body>` то в браузере мы увидим ожидаемое: "[Object HTMLDocument]". Попробуем повторить этот пример в Delphi с помощью стандартной обертки для MS Script Control, полученной через инструмент Import ActiveX Control: Код: TMyThread = class( TThread ) private Doc: IHTMLDocument2; ScriptControl: TScriptControl; public constructor ACreate; procedure Execute; override; end; procedure TMyThread.Execute; var v: Variant; begin CoInitializeEx( nil, COINIT_APARTMENTTHREADED ); ScriptControl := TScriptControl.Create( nil ); ScriptControl.Language:='JScript'; ScriptControl.UseSafeSubset := False; ScriptControl.AllowUI := true; ScriptControl.TimeOut := -1; ScriptControl.Reset; CoCreateInstance( mshtml.CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER, IID_IHTMLDocument2, Doc ); Doc.designMode := 'on'; v := VarArrayCreate( [0, 0], varVariant ); v[0] := '<html><head></head><body><form name=frm action="#"></form></body></html>'; Doc.Clear; while ( Doc.readyState <> 'complete' ) do begin Application.ProcessMessages; end; Doc.Write( PSafeArray( TVarData( v ).VArray ) ); Doc.Close; while ( Doc.readyState <> 'complete' ) do begin Application.ProcessMessages; end; ScriptControl.AddObject( 'Document', IDispatch(Doc), true ); ScriptControl.ExecuteStatement( 'Document.bb=Document.toString;' ); ScriptControl.ExecuteStatement( 'Document.bb();' ); CoUninitialize; end; или как вариант: Код: procedure TMyThread.Execute; var v: Variant; begin CoInitializeEx( nil, COINIT_APARTMENTTHREADED ); ScriptControl := TScriptControl.Create( nil ); ScriptControl.Language:='JScript'; ScriptControl.UseSafeSubset := False; ScriptControl.AllowUI := true; ScriptControl.TimeOut := -1; ScriptControl.Reset; ScriptControl.ExecuteStatement( 'var Document = new ActiveXObject("htmlfile");' ); ScriptControl.ExecuteStatement( 'Document.bb=Document.toString;' ); ScriptControl.ExecuteStatement( 'var s=Document.bb();' ); CoUninitialize; end; Для чистоты эксперимента последний вариант можно проверить также и в браузере (и мы получим уже описанный результат), однако, оба варианта в Delphi на присвоении var s=Document.bb(); дают Exception class EOleException with message 'Разрешение отклонено'. Может ли кто-то пояснить такую разность поведений? P.S. CoInitializeEx( nil, COINIT_MULTITHREADED ); невозможно, так как программа тогда осыпается на ScriptControl.Reset; Но все эксперименты с другими обертками над MS Script Control, где возможно COINIT_MULTITHREADED на указанном присвоении приводят к тому же результату.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Присваивание объекту родительского класса объекта дочернего	Викдон	Общие вопросы Delphi	0	07.02.2009 15:27
Отмена прокрутки при переходе от одного компонента к другому	sim_84	Компоненты Delphi	1	03.02.2009 20:34
С помощью методов и свойств объекта осуществляется управление терминалом. Имя (идентификатор) объекта	User>lia	Общие вопросы Delphi	4	16.01.2009 16:37
Как поменять одну из текстур объекта не меняя все остальные и без повторной загрузки объекта в GLScene	DomKr@t	Мультимедиа в Delphi	0	14.12.2008 01:52
Присвоение значения одного поля другому	frai	БД в Delphi	2	20.09.2007 15:03