vbscript: Added CreateObject tests (based on jscript ActiveXObject tests).
[wine] / dlls / vbscript / vbscript.c
1 /*
2  * Copyright 2011 Jacek Caban for CodeWeavers
3  *
4  * This library is free software; you can redistribute it and/or
5  * modify it under the terms of the GNU Lesser General Public
6  * License as published by the Free Software Foundation; either
7  * version 2.1 of the License, or (at your option) any later version.
8  *
9  * This library is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12  * Lesser General Public License for more details.
13  *
14  * You should have received a copy of the GNU Lesser General Public
15  * License along with this library; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17  */
18
19
20 #include <assert.h>
21
22 #include "vbscript.h"
23 #include "objsafe.h"
24
25 #include "wine/debug.h"
26
27 WINE_DEFAULT_DEBUG_CHANNEL(vbscript);
28
29 #ifdef _WIN64
30
31 #define CTXARG_T DWORDLONG
32 #define IActiveScriptParseVtbl IActiveScriptParse64Vtbl
33
34 #else
35
36 #define CTXARG_T DWORD
37 #define IActiveScriptParseVtbl IActiveScriptParse32Vtbl
38
39 #endif
40
41 struct VBScript {
42     IActiveScript IActiveScript_iface;
43     IActiveScriptParse IActiveScriptParse_iface;
44     IObjectSafety IObjectSafety_iface;
45
46     LONG ref;
47
48     DWORD safeopt;
49     SCRIPTSTATE state;
50     IActiveScriptSite *site;
51     script_ctx_t *ctx;
52     LONG thread_id;
53     LCID lcid;
54 };
55
56 static void change_state(VBScript *This, SCRIPTSTATE state)
57 {
58     if(This->state == state)
59         return;
60
61     This->state = state;
62     if(This->site)
63         IActiveScriptSite_OnStateChange(This->site, state);
64 }
65
66 static inline BOOL is_started(VBScript *This)
67 {
68     return This->state == SCRIPTSTATE_STARTED
69         || This->state == SCRIPTSTATE_CONNECTED
70         || This->state == SCRIPTSTATE_DISCONNECTED;
71 }
72
73 static HRESULT exec_global_code(script_ctx_t *ctx, vbscode_t *code)
74 {
75     HRESULT hres;
76
77     code->global_executed = TRUE;
78
79     IActiveScriptSite_OnEnterScript(ctx->site);
80     hres = exec_script(ctx, &code->global_code, NULL, NULL, NULL);
81     IActiveScriptSite_OnLeaveScript(ctx->site);
82
83     return hres;
84 }
85
86 static void exec_queued_code(script_ctx_t *ctx)
87 {
88     vbscode_t *iter;
89
90     LIST_FOR_EACH_ENTRY(iter, &ctx->code_list, vbscode_t, entry) {
91         if(!iter->global_executed)
92             exec_global_code(ctx, iter);
93     }
94 }
95
96 static HRESULT set_ctx_site(VBScript *This)
97 {
98     HRESULT hres;
99
100     This->ctx->lcid = This->lcid;
101
102     hres = init_global(This->ctx);
103     if(FAILED(hres))
104         return hres;
105
106     IActiveScriptSite_AddRef(This->site);
107     This->ctx->site = This->site;
108
109     change_state(This, SCRIPTSTATE_INITIALIZED);
110     return S_OK;
111 }
112
113 static void destroy_script(script_ctx_t *ctx)
114 {
115     collect_objects(ctx);
116
117     while(!list_empty(&ctx->code_list))
118         release_vbscode(LIST_ENTRY(list_head(&ctx->code_list), vbscode_t, entry));
119
120     while(!list_empty(&ctx->named_items)) {
121         named_item_t *iter = LIST_ENTRY(list_head(&ctx->named_items), named_item_t, entry);
122
123         list_remove(&iter->entry);
124         if(iter->disp)
125             IDispatch_Release(iter->disp);
126         heap_free(iter->name);
127         heap_free(iter);
128     }
129
130     if(ctx->host_global)
131         IDispatch_Release(ctx->host_global);
132     if(ctx->secmgr)
133         IInternetHostSecurityManager_Release(ctx->secmgr);
134     if(ctx->site)
135         IActiveScriptSite_Release(ctx->site);
136     if(ctx->err_obj)
137         IDispatchEx_Release(&ctx->err_obj->IDispatchEx_iface);
138     if(ctx->global_obj)
139         IDispatchEx_Release(&ctx->global_obj->IDispatchEx_iface);
140     if(ctx->script_obj)
141         IDispatchEx_Release(&ctx->script_obj->IDispatchEx_iface);
142     vbsheap_free(&ctx->heap);
143     heap_free(ctx);
144 }
145
146 static void decrease_state(VBScript *This, SCRIPTSTATE state)
147 {
148     switch(This->state) {
149     case SCRIPTSTATE_CONNECTED:
150         change_state(This, SCRIPTSTATE_DISCONNECTED);
151         if(state == SCRIPTSTATE_DISCONNECTED)
152             return;
153         /* FALLTHROUGH */
154     case SCRIPTSTATE_STARTED:
155     case SCRIPTSTATE_DISCONNECTED:
156         if(This->state == SCRIPTSTATE_DISCONNECTED)
157             change_state(This, SCRIPTSTATE_INITIALIZED);
158         if(state == SCRIPTSTATE_INITIALIZED)
159             break;
160         /* FALLTHROUGH */
161     case SCRIPTSTATE_INITIALIZED:
162     case SCRIPTSTATE_UNINITIALIZED:
163         change_state(This, state);
164
165         if(This->site) {
166             IActiveScriptSite_Release(This->site);
167             This->site = NULL;
168         }
169
170         This->thread_id = 0;
171
172         if(state == SCRIPTSTATE_CLOSED) {
173             destroy_script(This->ctx);
174             This->ctx = NULL;
175         }
176
177         break;
178     default:
179         assert(0);
180     }
181 }
182
183 static inline VBScript *impl_from_IActiveScript(IActiveScript *iface)
184 {
185     return CONTAINING_RECORD(iface, VBScript, IActiveScript_iface);
186 }
187
188 static HRESULT WINAPI VBScript_QueryInterface(IActiveScript *iface, REFIID riid, void **ppv)
189 {
190     VBScript *This = impl_from_IActiveScript(iface);
191
192     if(IsEqualGUID(riid, &IID_IUnknown)) {
193         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
194         *ppv = &This->IActiveScript_iface;
195     }else if(IsEqualGUID(riid, &IID_IActiveScript)) {
196         TRACE("(%p)->(IID_IActiveScript %p)\n", This, ppv);
197         *ppv = &This->IActiveScript_iface;
198     }else if(IsEqualGUID(riid, &IID_IActiveScriptParse)) {
199         TRACE("(%p)->(IID_IActiveScriptParse %p)\n", This, ppv);
200         *ppv = &This->IActiveScriptParse_iface;
201     }else if(IsEqualGUID(riid, &IID_IObjectSafety)) {
202         TRACE("(%p)->(IID_IObjectSafety %p)\n", This, ppv);
203         *ppv = &This->IObjectSafety_iface;
204     }else {
205         FIXME("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
206         *ppv = NULL;
207         return E_NOINTERFACE;
208     }
209
210     IUnknown_AddRef((IUnknown*)*ppv);
211     return S_OK;
212 }
213
214 static ULONG WINAPI VBScript_AddRef(IActiveScript *iface)
215 {
216     VBScript *This = impl_from_IActiveScript(iface);
217     LONG ref = InterlockedIncrement(&This->ref);
218
219     TRACE("(%p) ref=%d\n", This, ref);
220
221     return ref;
222 }
223
224 static ULONG WINAPI VBScript_Release(IActiveScript *iface)
225 {
226     VBScript *This = impl_from_IActiveScript(iface);
227     LONG ref = InterlockedDecrement(&This->ref);
228
229     TRACE("(%p) ref=%d\n", iface, ref);
230
231     if(!ref) {
232         if(This->site)
233             IActiveScriptSite_Release(This->site);
234         heap_free(This);
235     }
236
237     return ref;
238 }
239
240 static HRESULT WINAPI VBScript_SetScriptSite(IActiveScript *iface, IActiveScriptSite *pass)
241 {
242     VBScript *This = impl_from_IActiveScript(iface);
243     LCID lcid;
244     HRESULT hres;
245
246     TRACE("(%p)->(%p)\n", This, pass);
247
248     if(!pass)
249         return E_POINTER;
250
251     if(This->site)
252         return E_UNEXPECTED;
253
254     if(InterlockedCompareExchange(&This->thread_id, GetCurrentThreadId(), 0))
255         return E_UNEXPECTED;
256
257     This->site = pass;
258     IActiveScriptSite_AddRef(This->site);
259
260     hres = IActiveScriptSite_GetLCID(This->site, &lcid);
261     if(hres == S_OK)
262         This->lcid = lcid;
263
264     return This->ctx ? set_ctx_site(This) : S_OK;
265 }
266
267 static HRESULT WINAPI VBScript_GetScriptSite(IActiveScript *iface, REFIID riid,
268                                             void **ppvObject)
269 {
270     VBScript *This = impl_from_IActiveScript(iface);
271     FIXME("(%p)->()\n", This);
272     return E_NOTIMPL;
273 }
274
275 static HRESULT WINAPI VBScript_SetScriptState(IActiveScript *iface, SCRIPTSTATE ss)
276 {
277     VBScript *This = impl_from_IActiveScript(iface);
278
279     TRACE("(%p)->(%d)\n", This, ss);
280
281     if(This->thread_id && GetCurrentThreadId() != This->thread_id)
282         return E_UNEXPECTED;
283
284     if(ss == SCRIPTSTATE_UNINITIALIZED) {
285         if(This->state == SCRIPTSTATE_CLOSED)
286             return E_UNEXPECTED;
287
288         decrease_state(This, SCRIPTSTATE_UNINITIALIZED);
289         return S_OK;
290     }
291
292     if(!This->ctx)
293         return E_UNEXPECTED;
294
295     switch(ss) {
296     case SCRIPTSTATE_STARTED:
297     case SCRIPTSTATE_CONNECTED: /* FIXME */
298         if(This->state == SCRIPTSTATE_CLOSED)
299             return E_UNEXPECTED;
300
301         exec_queued_code(This->ctx);
302         break;
303     case SCRIPTSTATE_INITIALIZED:
304         FIXME("unimplemented SCRIPTSTATE_INITIALIZED\n");
305         return S_OK;
306     default:
307         FIXME("unimplemented state %d\n", ss);
308         return E_NOTIMPL;
309     }
310
311     change_state(This, ss);
312     return S_OK;
313 }
314
315 static HRESULT WINAPI VBScript_GetScriptState(IActiveScript *iface, SCRIPTSTATE *pssState)
316 {
317     VBScript *This = impl_from_IActiveScript(iface);
318
319     TRACE("(%p)->(%p)\n", This, pssState);
320
321     if(!pssState)
322         return E_POINTER;
323
324     if(This->thread_id && This->thread_id != GetCurrentThreadId())
325         return E_UNEXPECTED;
326
327     *pssState = This->state;
328     return S_OK;
329 }
330
331 static HRESULT WINAPI VBScript_Close(IActiveScript *iface)
332 {
333     VBScript *This = impl_from_IActiveScript(iface);
334
335     TRACE("(%p)->()\n", This);
336
337     if(This->thread_id && This->thread_id != GetCurrentThreadId())
338         return E_UNEXPECTED;
339
340     decrease_state(This, SCRIPTSTATE_CLOSED);
341     return S_OK;
342 }
343
344 static HRESULT WINAPI VBScript_AddNamedItem(IActiveScript *iface, LPCOLESTR pstrName, DWORD dwFlags)
345 {
346     VBScript *This = impl_from_IActiveScript(iface);
347     named_item_t *item;
348     IDispatch *disp = NULL;
349     HRESULT hres;
350
351     TRACE("(%p)->(%s %x)\n", This, debugstr_w(pstrName), dwFlags);
352
353     if(This->thread_id != GetCurrentThreadId() || !This->ctx || This->state == SCRIPTSTATE_CLOSED)
354         return E_UNEXPECTED;
355
356     if(dwFlags & SCRIPTITEM_GLOBALMEMBERS) {
357         IUnknown *unk;
358
359         hres = IActiveScriptSite_GetItemInfo(This->site, pstrName, SCRIPTINFO_IUNKNOWN, &unk, NULL);
360         if(FAILED(hres)) {
361             WARN("GetItemInfo failed: %08x\n", hres);
362             return hres;
363         }
364
365         hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&disp);
366         IUnknown_Release(unk);
367         if(FAILED(hres)) {
368             WARN("object does not implement IDispatch\n");
369             return hres;
370         }
371
372         if(This->ctx->host_global)
373             IDispatch_Release(This->ctx->host_global);
374         IDispatch_AddRef(disp);
375         This->ctx->host_global = disp;
376     }
377
378     item = heap_alloc(sizeof(*item));
379     if(!item) {
380         if(disp)
381             IDispatch_Release(disp);
382         return E_OUTOFMEMORY;
383     }
384
385     item->disp = disp;
386     item->flags = dwFlags;
387     item->name = heap_strdupW(pstrName);
388     if(!item->name) {
389         if(disp)
390             IDispatch_Release(disp);
391         heap_free(item);
392         return E_OUTOFMEMORY;
393     }
394
395     list_add_tail(&This->ctx->named_items, &item->entry);
396     return S_OK;
397 }
398
399 static HRESULT WINAPI VBScript_AddTypeLib(IActiveScript *iface, REFGUID rguidTypeLib,
400         DWORD dwMajor, DWORD dwMinor, DWORD dwFlags)
401 {
402     VBScript *This = impl_from_IActiveScript(iface);
403     FIXME("(%p)->()\n", This);
404     return E_NOTIMPL;
405 }
406
407 static HRESULT WINAPI VBScript_GetScriptDispatch(IActiveScript *iface, LPCOLESTR pstrItemName, IDispatch **ppdisp)
408 {
409     VBScript *This = impl_from_IActiveScript(iface);
410
411     TRACE("(%p)->(%p)\n", This, ppdisp);
412
413     if(!ppdisp)
414         return E_POINTER;
415
416     if(This->thread_id != GetCurrentThreadId() || !This->ctx->script_obj) {
417         *ppdisp = NULL;
418         return E_UNEXPECTED;
419     }
420
421     *ppdisp = (IDispatch*)&This->ctx->script_obj->IDispatchEx_iface;
422     IDispatch_AddRef(*ppdisp);
423     return S_OK;
424 }
425
426 static HRESULT WINAPI VBScript_GetCurrentScriptThreadID(IActiveScript *iface,
427                                                        SCRIPTTHREADID *pstridThread)
428 {
429     VBScript *This = impl_from_IActiveScript(iface);
430     FIXME("(%p)->()\n", This);
431     return E_NOTIMPL;
432 }
433
434 static HRESULT WINAPI VBScript_GetScriptThreadID(IActiveScript *iface,
435                                                 DWORD dwWin32ThreadId, SCRIPTTHREADID *pstidThread)
436 {
437     VBScript *This = impl_from_IActiveScript(iface);
438     FIXME("(%p)->()\n", This);
439     return E_NOTIMPL;
440 }
441
442 static HRESULT WINAPI VBScript_GetScriptThreadState(IActiveScript *iface,
443         SCRIPTTHREADID stidThread, SCRIPTTHREADSTATE *pstsState)
444 {
445     VBScript *This = impl_from_IActiveScript(iface);
446     FIXME("(%p)->()\n", This);
447     return E_NOTIMPL;
448 }
449
450 static HRESULT WINAPI VBScript_InterruptScriptThread(IActiveScript *iface,
451         SCRIPTTHREADID stidThread, const EXCEPINFO *pexcepinfo, DWORD dwFlags)
452 {
453     VBScript *This = impl_from_IActiveScript(iface);
454     FIXME("(%p)->()\n", This);
455     return E_NOTIMPL;
456 }
457
458 static HRESULT WINAPI VBScript_Clone(IActiveScript *iface, IActiveScript **ppscript)
459 {
460     VBScript *This = impl_from_IActiveScript(iface);
461     FIXME("(%p)->()\n", This);
462     return E_NOTIMPL;
463 }
464
465 static const IActiveScriptVtbl VBScriptVtbl = {
466     VBScript_QueryInterface,
467     VBScript_AddRef,
468     VBScript_Release,
469     VBScript_SetScriptSite,
470     VBScript_GetScriptSite,
471     VBScript_SetScriptState,
472     VBScript_GetScriptState,
473     VBScript_Close,
474     VBScript_AddNamedItem,
475     VBScript_AddTypeLib,
476     VBScript_GetScriptDispatch,
477     VBScript_GetCurrentScriptThreadID,
478     VBScript_GetScriptThreadID,
479     VBScript_GetScriptThreadState,
480     VBScript_InterruptScriptThread,
481     VBScript_Clone
482 };
483
484 static inline VBScript *impl_from_IActiveScriptParse(IActiveScriptParse *iface)
485 {
486     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParse_iface);
487 }
488
489 static HRESULT WINAPI VBScriptParse_QueryInterface(IActiveScriptParse *iface, REFIID riid, void **ppv)
490 {
491     VBScript *This = impl_from_IActiveScriptParse(iface);
492     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
493 }
494
495 static ULONG WINAPI VBScriptParse_AddRef(IActiveScriptParse *iface)
496 {
497     VBScript *This = impl_from_IActiveScriptParse(iface);
498     return IActiveScript_AddRef(&This->IActiveScript_iface);
499 }
500
501 static ULONG WINAPI VBScriptParse_Release(IActiveScriptParse *iface)
502 {
503     VBScript *This = impl_from_IActiveScriptParse(iface);
504     return IActiveScript_Release(&This->IActiveScript_iface);
505 }
506
507 static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
508 {
509     VBScript *This = impl_from_IActiveScriptParse(iface);
510     script_ctx_t *ctx, *old_ctx;
511
512     TRACE("(%p)\n", This);
513
514     if(This->ctx)
515         return E_UNEXPECTED;
516
517     ctx = heap_alloc_zero(sizeof(script_ctx_t));
518     if(!ctx)
519         return E_OUTOFMEMORY;
520
521     ctx->safeopt = This->safeopt;
522     vbsheap_init(&ctx->heap);
523     list_init(&ctx->objects);
524     list_init(&ctx->code_list);
525     list_init(&ctx->named_items);
526
527     old_ctx = InterlockedCompareExchangePointer((void**)&This->ctx, ctx, NULL);
528     if(old_ctx) {
529         destroy_script(ctx);
530         return E_UNEXPECTED;
531     }
532
533     return This->site ? set_ctx_site(This) : S_OK;
534 }
535
536 static HRESULT WINAPI VBScriptParse_AddScriptlet(IActiveScriptParse *iface,
537         LPCOLESTR pstrDefaultName, LPCOLESTR pstrCode, LPCOLESTR pstrItemName,
538         LPCOLESTR pstrSubItemName, LPCOLESTR pstrEventName, LPCOLESTR pstrDelimiter,
539         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags,
540         BSTR *pbstrName, EXCEPINFO *pexcepinfo)
541 {
542     VBScript *This = impl_from_IActiveScriptParse(iface);
543     FIXME("(%p)->(%s %s %s %s %s %s %s %u %x %p %p)\n", This, debugstr_w(pstrDefaultName),
544           debugstr_w(pstrCode), debugstr_w(pstrItemName), debugstr_w(pstrSubItemName),
545           debugstr_w(pstrEventName), debugstr_w(pstrDelimiter), wine_dbgstr_longlong(dwSourceContextCookie),
546           ulStartingLineNumber, dwFlags, pbstrName, pexcepinfo);
547     return E_NOTIMPL;
548 }
549
550 static HRESULT WINAPI VBScriptParse_ParseScriptText(IActiveScriptParse *iface,
551         LPCOLESTR pstrCode, LPCOLESTR pstrItemName, IUnknown *punkContext,
552         LPCOLESTR pstrDelimiter, CTXARG_T dwSourceContextCookie, ULONG ulStartingLine,
553         DWORD dwFlags, VARIANT *pvarResult, EXCEPINFO *pexcepinfo)
554 {
555     VBScript *This = impl_from_IActiveScriptParse(iface);
556     vbscode_t *code;
557     HRESULT hres;
558
559     TRACE("(%p)->(%s %s %p %s %s %u %x %p %p)\n", This, debugstr_w(pstrCode),
560           debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
561           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLine, dwFlags, pvarResult, pexcepinfo);
562
563     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
564         return E_UNEXPECTED;
565
566     hres = compile_script(This->ctx, pstrCode, &code);
567     if(FAILED(hres))
568         return hres;
569
570     return is_started(This) ? exec_global_code(This->ctx, code) : S_OK;
571 }
572
573 static const IActiveScriptParseVtbl VBScriptParseVtbl = {
574     VBScriptParse_QueryInterface,
575     VBScriptParse_AddRef,
576     VBScriptParse_Release,
577     VBScriptParse_InitNew,
578     VBScriptParse_AddScriptlet,
579     VBScriptParse_ParseScriptText
580 };
581
582 static inline VBScript *impl_from_IObjectSafety(IObjectSafety *iface)
583 {
584     return CONTAINING_RECORD(iface, VBScript, IObjectSafety_iface);
585 }
586
587 static HRESULT WINAPI VBScriptSafety_QueryInterface(IObjectSafety *iface, REFIID riid, void **ppv)
588 {
589     VBScript *This = impl_from_IObjectSafety(iface);
590     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
591 }
592
593 static ULONG WINAPI VBScriptSafety_AddRef(IObjectSafety *iface)
594 {
595     VBScript *This = impl_from_IObjectSafety(iface);
596     return IActiveScript_AddRef(&This->IActiveScript_iface);
597 }
598
599 static ULONG WINAPI VBScriptSafety_Release(IObjectSafety *iface)
600 {
601     VBScript *This = impl_from_IObjectSafety(iface);
602     return IActiveScript_Release(&This->IActiveScript_iface);
603 }
604
605 #define SUPPORTED_OPTIONS (INTERFACESAFE_FOR_UNTRUSTED_DATA|INTERFACE_USES_DISPEX|INTERFACE_USES_SECURITY_MANAGER)
606
607 static HRESULT WINAPI VBScriptSafety_GetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
608         DWORD *pdwSupportedOptions, DWORD *pdwEnabledOptions)
609 {
610     VBScript *This = impl_from_IObjectSafety(iface);
611
612     TRACE("(%p)->(%s %p %p)\n", This, debugstr_guid(riid), pdwSupportedOptions, pdwEnabledOptions);
613
614     if(!pdwSupportedOptions || !pdwEnabledOptions)
615         return E_POINTER;
616
617     *pdwSupportedOptions = SUPPORTED_OPTIONS;
618     *pdwEnabledOptions = This->safeopt;
619     return S_OK;
620 }
621
622 static HRESULT WINAPI VBScriptSafety_SetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
623         DWORD dwOptionSetMask, DWORD dwEnabledOptions)
624 {
625     VBScript *This = impl_from_IObjectSafety(iface);
626
627     TRACE("(%p)->(%s %x %x)\n", This, debugstr_guid(riid), dwOptionSetMask, dwEnabledOptions);
628
629     if(dwOptionSetMask & ~SUPPORTED_OPTIONS)
630         return E_FAIL;
631
632     This->safeopt = (dwEnabledOptions & dwOptionSetMask) | (This->safeopt & ~dwOptionSetMask) | INTERFACE_USES_DISPEX;
633     return S_OK;
634 }
635
636 static const IObjectSafetyVtbl VBScriptSafetyVtbl = {
637     VBScriptSafety_QueryInterface,
638     VBScriptSafety_AddRef,
639     VBScriptSafety_Release,
640     VBScriptSafety_GetInterfaceSafetyOptions,
641     VBScriptSafety_SetInterfaceSafetyOptions
642 };
643
644 HRESULT WINAPI VBScriptFactory_CreateInstance(IClassFactory *iface, IUnknown *pUnkOuter, REFIID riid, void **ppv)
645 {
646     VBScript *ret;
647     HRESULT hres;
648
649     TRACE("(%p %s %p)\n", pUnkOuter, debugstr_guid(riid), ppv);
650
651     ret = heap_alloc_zero(sizeof(*ret));
652     if(!ret)
653         return E_OUTOFMEMORY;
654
655     ret->IActiveScript_iface.lpVtbl = &VBScriptVtbl;
656     ret->IActiveScriptParse_iface.lpVtbl = &VBScriptParseVtbl;
657     ret->IObjectSafety_iface.lpVtbl = &VBScriptSafetyVtbl;
658
659     ret->ref = 1;
660     ret->state = SCRIPTSTATE_UNINITIALIZED;
661     ret->safeopt = INTERFACE_USES_DISPEX;
662
663     hres = IActiveScript_QueryInterface(&ret->IActiveScript_iface, riid, ppv);
664     IActiveScript_Release(&ret->IActiveScript_iface);
665     return hres;
666 }
667
668 typedef struct {
669     IServiceProvider IServiceProvider_iface;
670
671     LONG ref;
672
673     IServiceProvider *sp;
674 } AXSite;
675
676 static inline AXSite *impl_from_IServiceProvider(IServiceProvider *iface)
677 {
678     return CONTAINING_RECORD(iface, AXSite, IServiceProvider_iface);
679 }
680
681 static HRESULT WINAPI AXSite_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
682 {
683     AXSite *This = impl_from_IServiceProvider(iface);
684
685     if(IsEqualGUID(&IID_IUnknown, riid)) {
686         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
687         *ppv = &This->IServiceProvider_iface;
688     }else if(IsEqualGUID(&IID_IServiceProvider, riid)) {
689         TRACE("(%p)->(IID_IServiceProvider %p)\n", This, ppv);
690         *ppv = &This->IServiceProvider_iface;
691     }else {
692         TRACE("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
693         *ppv = NULL;
694         return E_NOINTERFACE;
695     }
696
697     IUnknown_AddRef((IUnknown*)*ppv);
698     return S_OK;
699 }
700
701 static ULONG WINAPI AXSite_AddRef(IServiceProvider *iface)
702 {
703     AXSite *This = impl_from_IServiceProvider(iface);
704     LONG ref = InterlockedIncrement(&This->ref);
705
706     TRACE("(%p) ref=%d\n", This, ref);
707
708     return ref;
709 }
710
711 static ULONG WINAPI AXSite_Release(IServiceProvider *iface)
712 {
713     AXSite *This = impl_from_IServiceProvider(iface);
714     LONG ref = InterlockedDecrement(&This->ref);
715
716     TRACE("(%p) ref=%d\n", This, ref);
717
718     if(!ref)
719         heap_free(This);
720
721     return ref;
722 }
723
724 static HRESULT WINAPI AXSite_QueryService(IServiceProvider *iface,
725         REFGUID guidService, REFIID riid, void **ppv)
726 {
727     AXSite *This = impl_from_IServiceProvider(iface);
728
729     TRACE("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
730
731     return IServiceProvider_QueryService(This->sp, guidService, riid, ppv);
732 }
733
734 static IServiceProviderVtbl AXSiteVtbl = {
735     AXSite_QueryInterface,
736     AXSite_AddRef,
737     AXSite_Release,
738     AXSite_QueryService
739 };
740
741 IUnknown *create_ax_site(script_ctx_t *ctx)
742 {
743     IServiceProvider *sp;
744     AXSite *ret;
745     HRESULT hres;
746
747     hres = IActiveScriptSite_QueryInterface(ctx->site, &IID_IServiceProvider, (void**)&sp);
748     if(FAILED(hres)) {
749         ERR("Could not get IServiceProvider iface: %08x\n", hres);
750         return NULL;
751     }
752
753     ret = heap_alloc(sizeof(*ret));
754     if(!ret) {
755         IServiceProvider_Release(sp);
756         return NULL;
757     }
758
759     ret->IServiceProvider_iface.lpVtbl = &AXSiteVtbl;
760     ret->ref = 1;
761     ret->sp = sp;
762
763     return (IUnknown*)&ret->IServiceProvider_iface;
764 }