Проблема с присвоением методом объектов друг другу.
Если создать простой 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 на указанном присвоении приводят к тому же результату.
