xref: /reactos/dll/win32/vbscript/vbscript.c (revision 431643b9)
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 IActiveScriptDebugVtbl IActiveScriptDebug64Vtbl
33 #define IActiveScriptParseVtbl IActiveScriptParse64Vtbl
34 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_64Vtbl
35 
36 #else
37 
38 #define CTXARG_T DWORD
39 #define IActiveScriptDebugVtbl IActiveScriptDebug32Vtbl
40 #define IActiveScriptParseVtbl IActiveScriptParse32Vtbl
41 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_32Vtbl
42 
43 #endif
44 
45 struct VBScript {
46     IActiveScript IActiveScript_iface;
47     IActiveScriptDebug IActiveScriptDebug_iface;
48     IActiveScriptParse IActiveScriptParse_iface;
49     IActiveScriptParseProcedure2 IActiveScriptParseProcedure2_iface;
50     IObjectSafety IObjectSafety_iface;
51 
52     LONG ref;
53 
54     DWORD safeopt;
55     SCRIPTSTATE state;
56     IActiveScriptSite *site;
57     script_ctx_t *ctx;
58     LONG thread_id;
59     LCID lcid;
60 };
61 
62 static void change_state(VBScript *This, SCRIPTSTATE state)
63 {
64     if(This->state == state)
65         return;
66 
67     This->state = state;
68     if(This->site)
69         IActiveScriptSite_OnStateChange(This->site, state);
70 }
71 
72 static inline BOOL is_started(VBScript *This)
73 {
74     return This->state == SCRIPTSTATE_STARTED
75         || This->state == SCRIPTSTATE_CONNECTED
76         || This->state == SCRIPTSTATE_DISCONNECTED;
77 }
78 
79 static HRESULT exec_global_code(script_ctx_t *ctx, vbscode_t *code)
80 {
81     HRESULT hres;
82 
83     code->pending_exec = FALSE;
84 
85     IActiveScriptSite_OnEnterScript(ctx->site);
86     hres = exec_script(ctx, &code->main_code, NULL, NULL, NULL);
87     IActiveScriptSite_OnLeaveScript(ctx->site);
88 
89     return hres;
90 }
91 
92 static void exec_queued_code(script_ctx_t *ctx)
93 {
94     vbscode_t *iter;
95 
96     LIST_FOR_EACH_ENTRY(iter, &ctx->code_list, vbscode_t, entry) {
97         if(iter->pending_exec)
98             exec_global_code(ctx, iter);
99     }
100 }
101 
102 IDispatch *lookup_named_item(script_ctx_t *ctx, const WCHAR *name, unsigned flags)
103 {
104     named_item_t *item;
105     HRESULT hres;
106 
107     LIST_FOR_EACH_ENTRY(item, &ctx->named_items, named_item_t, entry) {
108         if((item->flags & flags) == flags && !strcmpiW(item->name, name)) {
109             if(!item->disp) {
110                 IUnknown *unk;
111 
112                 hres = IActiveScriptSite_GetItemInfo(ctx->site, item->name,
113                                                      SCRIPTINFO_IUNKNOWN, &unk, NULL);
114                 if(FAILED(hres)) {
115                     WARN("GetItemInfo failed: %08x\n", hres);
116                     continue;
117                 }
118 
119                 hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&item->disp);
120                 IUnknown_Release(unk);
121                 if(FAILED(hres)) {
122                     WARN("object does not implement IDispatch\n");
123                     continue;
124                 }
125             }
126 
127             return item->disp;
128         }
129     }
130 
131     return NULL;
132 }
133 
134 static HRESULT set_ctx_site(VBScript *This)
135 {
136     HRESULT hres;
137 
138     This->ctx->lcid = This->lcid;
139 
140     hres = init_global(This->ctx);
141     if(FAILED(hres))
142         return hres;
143 
144     IActiveScriptSite_AddRef(This->site);
145     This->ctx->site = This->site;
146 
147     change_state(This, SCRIPTSTATE_INITIALIZED);
148     return S_OK;
149 }
150 
151 static void release_script(script_ctx_t *ctx)
152 {
153     class_desc_t *class_desc;
154 
155     collect_objects(ctx);
156 
157     release_dynamic_vars(ctx->global_vars);
158     ctx->global_vars = NULL;
159 
160     while(!list_empty(&ctx->named_items)) {
161         named_item_t *iter = LIST_ENTRY(list_head(&ctx->named_items), named_item_t, entry);
162 
163         list_remove(&iter->entry);
164         if(iter->disp)
165             IDispatch_Release(iter->disp);
166         heap_free(iter->name);
167         heap_free(iter);
168     }
169 
170     while(ctx->procs) {
171         class_desc = ctx->procs;
172         ctx->procs = class_desc->next;
173 
174         heap_free(class_desc);
175     }
176 
177     if(ctx->host_global) {
178         IDispatch_Release(ctx->host_global);
179         ctx->host_global = NULL;
180     }
181 
182     if(ctx->secmgr) {
183         IInternetHostSecurityManager_Release(ctx->secmgr);
184         ctx->secmgr = NULL;
185     }
186 
187     if(ctx->site) {
188         IActiveScriptSite_Release(ctx->site);
189         ctx->site = NULL;
190     }
191 
192     if(ctx->err_obj) {
193         IDispatchEx_Release(&ctx->err_obj->IDispatchEx_iface);
194         ctx->err_obj = NULL;
195     }
196 
197     if(ctx->global_obj) {
198         IDispatchEx_Release(&ctx->global_obj->IDispatchEx_iface);
199         ctx->global_obj = NULL;
200     }
201 
202     if(ctx->script_obj) {
203         ScriptDisp *script_obj = ctx->script_obj;
204 
205         ctx->script_obj = NULL;
206         script_obj->ctx = NULL;
207         IDispatchEx_Release(&script_obj->IDispatchEx_iface);
208     }
209 
210     heap_pool_free(&ctx->heap);
211     heap_pool_init(&ctx->heap);
212 }
213 
214 static void destroy_script(script_ctx_t *ctx)
215 {
216     while(!list_empty(&ctx->code_list))
217         release_vbscode(LIST_ENTRY(list_head(&ctx->code_list), vbscode_t, entry));
218 
219     release_script(ctx);
220     heap_free(ctx);
221 }
222 
223 static void decrease_state(VBScript *This, SCRIPTSTATE state)
224 {
225     switch(This->state) {
226     case SCRIPTSTATE_CONNECTED:
227         change_state(This, SCRIPTSTATE_DISCONNECTED);
228         if(state == SCRIPTSTATE_DISCONNECTED)
229             return;
230         /* FALLTHROUGH */
231     case SCRIPTSTATE_STARTED:
232     case SCRIPTSTATE_DISCONNECTED:
233         if(This->state == SCRIPTSTATE_DISCONNECTED)
234             change_state(This, SCRIPTSTATE_INITIALIZED);
235         if(state == SCRIPTSTATE_INITIALIZED)
236             break;
237         /* FALLTHROUGH */
238     case SCRIPTSTATE_INITIALIZED:
239     case SCRIPTSTATE_UNINITIALIZED:
240         change_state(This, state);
241 
242         if(This->site) {
243             IActiveScriptSite_Release(This->site);
244             This->site = NULL;
245         }
246 
247         if(This->ctx)
248             release_script(This->ctx);
249 
250         This->thread_id = 0;
251         break;
252     case SCRIPTSTATE_CLOSED:
253         break;
254     DEFAULT_UNREACHABLE;
255     }
256 }
257 
258 static inline VBScript *impl_from_IActiveScript(IActiveScript *iface)
259 {
260     return CONTAINING_RECORD(iface, VBScript, IActiveScript_iface);
261 }
262 
263 static HRESULT WINAPI VBScript_QueryInterface(IActiveScript *iface, REFIID riid, void **ppv)
264 {
265     VBScript *This = impl_from_IActiveScript(iface);
266 
267     if(IsEqualGUID(riid, &IID_IUnknown)) {
268         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
269         *ppv = &This->IActiveScript_iface;
270     }else if(IsEqualGUID(riid, &IID_IActiveScript)) {
271         TRACE("(%p)->(IID_IActiveScript %p)\n", This, ppv);
272         *ppv = &This->IActiveScript_iface;
273     }else if(IsEqualGUID(riid, &IID_IActiveScriptDebug)) {
274         TRACE("(%p)->(IID_IActiveScriptDebug %p)\n", This, ppv);
275         *ppv = &This->IActiveScriptDebug_iface;
276     }else if(IsEqualGUID(riid, &IID_IActiveScriptParse)) {
277         TRACE("(%p)->(IID_IActiveScriptParse %p)\n", This, ppv);
278         *ppv = &This->IActiveScriptParse_iface;
279     }else if(IsEqualGUID(riid, &IID_IActiveScriptParseProcedure2)) {
280         TRACE("(%p)->(IID_IActiveScriptParseProcedure2 %p)\n", This, ppv);
281         *ppv = &This->IActiveScriptParseProcedure2_iface;
282     }else if(IsEqualGUID(riid, &IID_IObjectSafety)) {
283         TRACE("(%p)->(IID_IObjectSafety %p)\n", This, ppv);
284         *ppv = &This->IObjectSafety_iface;
285     }else {
286         FIXME("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
287         *ppv = NULL;
288         return E_NOINTERFACE;
289     }
290 
291     IUnknown_AddRef((IUnknown*)*ppv);
292     return S_OK;
293 }
294 
295 static ULONG WINAPI VBScript_AddRef(IActiveScript *iface)
296 {
297     VBScript *This = impl_from_IActiveScript(iface);
298     LONG ref = InterlockedIncrement(&This->ref);
299 
300     TRACE("(%p) ref=%d\n", This, ref);
301 
302     return ref;
303 }
304 
305 static ULONG WINAPI VBScript_Release(IActiveScript *iface)
306 {
307     VBScript *This = impl_from_IActiveScript(iface);
308     LONG ref = InterlockedDecrement(&This->ref);
309 
310     TRACE("(%p) ref=%d\n", iface, ref);
311 
312     if(!ref) {
313         if(This->ctx) {
314             decrease_state(This, SCRIPTSTATE_CLOSED);
315             destroy_script(This->ctx);
316             This->ctx = NULL;
317         }
318         if(This->site)
319             IActiveScriptSite_Release(This->site);
320         heap_free(This);
321     }
322 
323     return ref;
324 }
325 
326 static HRESULT WINAPI VBScript_SetScriptSite(IActiveScript *iface, IActiveScriptSite *pass)
327 {
328     VBScript *This = impl_from_IActiveScript(iface);
329     LCID lcid;
330     HRESULT hres;
331 
332     TRACE("(%p)->(%p)\n", This, pass);
333 
334     if(!pass)
335         return E_POINTER;
336 
337     if(This->site)
338         return E_UNEXPECTED;
339 
340     if(InterlockedCompareExchange(&This->thread_id, GetCurrentThreadId(), 0))
341         return E_UNEXPECTED;
342 
343     This->site = pass;
344     IActiveScriptSite_AddRef(This->site);
345 
346     hres = IActiveScriptSite_GetLCID(This->site, &lcid);
347     if(hres == S_OK)
348         This->lcid = lcid;
349 
350     return This->ctx ? set_ctx_site(This) : S_OK;
351 }
352 
353 static HRESULT WINAPI VBScript_GetScriptSite(IActiveScript *iface, REFIID riid,
354                                             void **ppvObject)
355 {
356     VBScript *This = impl_from_IActiveScript(iface);
357     FIXME("(%p)->()\n", This);
358     return E_NOTIMPL;
359 }
360 
361 static HRESULT WINAPI VBScript_SetScriptState(IActiveScript *iface, SCRIPTSTATE ss)
362 {
363     VBScript *This = impl_from_IActiveScript(iface);
364 
365     TRACE("(%p)->(%d)\n", This, ss);
366 
367     if(This->thread_id && GetCurrentThreadId() != This->thread_id)
368         return E_UNEXPECTED;
369 
370     if(ss == SCRIPTSTATE_UNINITIALIZED) {
371         if(This->state == SCRIPTSTATE_CLOSED)
372             return E_UNEXPECTED;
373 
374         decrease_state(This, SCRIPTSTATE_UNINITIALIZED);
375         return S_OK;
376     }
377 
378     if(!This->ctx)
379         return E_UNEXPECTED;
380 
381     switch(ss) {
382     case SCRIPTSTATE_STARTED:
383     case SCRIPTSTATE_CONNECTED: /* FIXME */
384         if(This->state == SCRIPTSTATE_CLOSED)
385             return E_UNEXPECTED;
386 
387         exec_queued_code(This->ctx);
388         break;
389     case SCRIPTSTATE_INITIALIZED:
390         FIXME("unimplemented SCRIPTSTATE_INITIALIZED\n");
391         return S_OK;
392     case SCRIPTSTATE_DISCONNECTED:
393         FIXME("unimplemented SCRIPTSTATE_DISCONNECTED\n");
394         return S_OK;
395     default:
396         FIXME("unimplemented state %d\n", ss);
397         return E_NOTIMPL;
398     }
399 
400     change_state(This, ss);
401     return S_OK;
402 }
403 
404 static HRESULT WINAPI VBScript_GetScriptState(IActiveScript *iface, SCRIPTSTATE *pssState)
405 {
406     VBScript *This = impl_from_IActiveScript(iface);
407 
408     TRACE("(%p)->(%p)\n", This, pssState);
409 
410     if(!pssState)
411         return E_POINTER;
412 
413     if(This->thread_id && This->thread_id != GetCurrentThreadId())
414         return E_UNEXPECTED;
415 
416     *pssState = This->state;
417     return S_OK;
418 }
419 
420 static HRESULT WINAPI VBScript_Close(IActiveScript *iface)
421 {
422     VBScript *This = impl_from_IActiveScript(iface);
423 
424     TRACE("(%p)->()\n", This);
425 
426     if(This->thread_id && This->thread_id != GetCurrentThreadId())
427         return E_UNEXPECTED;
428 
429     decrease_state(This, SCRIPTSTATE_CLOSED);
430     return S_OK;
431 }
432 
433 static HRESULT WINAPI VBScript_AddNamedItem(IActiveScript *iface, LPCOLESTR pstrName, DWORD dwFlags)
434 {
435     VBScript *This = impl_from_IActiveScript(iface);
436     named_item_t *item;
437     IDispatch *disp = NULL;
438     HRESULT hres;
439 
440     TRACE("(%p)->(%s %x)\n", This, debugstr_w(pstrName), dwFlags);
441 
442     if(This->thread_id != GetCurrentThreadId() || !This->ctx || This->state == SCRIPTSTATE_CLOSED)
443         return E_UNEXPECTED;
444 
445     if(dwFlags & SCRIPTITEM_GLOBALMEMBERS) {
446         IUnknown *unk;
447 
448         hres = IActiveScriptSite_GetItemInfo(This->site, pstrName, SCRIPTINFO_IUNKNOWN, &unk, NULL);
449         if(FAILED(hres)) {
450             WARN("GetItemInfo failed: %08x\n", hres);
451             return hres;
452         }
453 
454         hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&disp);
455         IUnknown_Release(unk);
456         if(FAILED(hres)) {
457             WARN("object does not implement IDispatch\n");
458             return hres;
459         }
460 
461         if(This->ctx->host_global)
462             IDispatch_Release(This->ctx->host_global);
463         IDispatch_AddRef(disp);
464         This->ctx->host_global = disp;
465     }
466 
467     item = heap_alloc(sizeof(*item));
468     if(!item) {
469         if(disp)
470             IDispatch_Release(disp);
471         return E_OUTOFMEMORY;
472     }
473 
474     item->disp = disp;
475     item->flags = dwFlags;
476     item->name = heap_strdupW(pstrName);
477     if(!item->name) {
478         if(disp)
479             IDispatch_Release(disp);
480         heap_free(item);
481         return E_OUTOFMEMORY;
482     }
483 
484     list_add_tail(&This->ctx->named_items, &item->entry);
485     return S_OK;
486 }
487 
488 static HRESULT WINAPI VBScript_AddTypeLib(IActiveScript *iface, REFGUID rguidTypeLib,
489         DWORD dwMajor, DWORD dwMinor, DWORD dwFlags)
490 {
491     VBScript *This = impl_from_IActiveScript(iface);
492     FIXME("(%p)->()\n", This);
493     return E_NOTIMPL;
494 }
495 
496 static HRESULT WINAPI VBScript_GetScriptDispatch(IActiveScript *iface, LPCOLESTR pstrItemName, IDispatch **ppdisp)
497 {
498     VBScript *This = impl_from_IActiveScript(iface);
499 
500     TRACE("(%p)->(%p)\n", This, ppdisp);
501 
502     if(!ppdisp)
503         return E_POINTER;
504 
505     if(This->thread_id != GetCurrentThreadId() || !This->ctx || !This->ctx->script_obj) {
506         *ppdisp = NULL;
507         return E_UNEXPECTED;
508     }
509 
510     *ppdisp = (IDispatch*)&This->ctx->script_obj->IDispatchEx_iface;
511     IDispatch_AddRef(*ppdisp);
512     return S_OK;
513 }
514 
515 static HRESULT WINAPI VBScript_GetCurrentScriptThreadID(IActiveScript *iface,
516                                                        SCRIPTTHREADID *pstridThread)
517 {
518     VBScript *This = impl_from_IActiveScript(iface);
519     FIXME("(%p)->()\n", This);
520     return E_NOTIMPL;
521 }
522 
523 static HRESULT WINAPI VBScript_GetScriptThreadID(IActiveScript *iface,
524                                                 DWORD dwWin32ThreadId, SCRIPTTHREADID *pstidThread)
525 {
526     VBScript *This = impl_from_IActiveScript(iface);
527     FIXME("(%p)->()\n", This);
528     return E_NOTIMPL;
529 }
530 
531 static HRESULT WINAPI VBScript_GetScriptThreadState(IActiveScript *iface,
532         SCRIPTTHREADID stidThread, SCRIPTTHREADSTATE *pstsState)
533 {
534     VBScript *This = impl_from_IActiveScript(iface);
535     FIXME("(%p)->()\n", This);
536     return E_NOTIMPL;
537 }
538 
539 static HRESULT WINAPI VBScript_InterruptScriptThread(IActiveScript *iface,
540         SCRIPTTHREADID stidThread, const EXCEPINFO *pexcepinfo, DWORD dwFlags)
541 {
542     VBScript *This = impl_from_IActiveScript(iface);
543     FIXME("(%p)->()\n", This);
544     return E_NOTIMPL;
545 }
546 
547 static HRESULT WINAPI VBScript_Clone(IActiveScript *iface, IActiveScript **ppscript)
548 {
549     VBScript *This = impl_from_IActiveScript(iface);
550     FIXME("(%p)->()\n", This);
551     return E_NOTIMPL;
552 }
553 
554 static const IActiveScriptVtbl VBScriptVtbl = {
555     VBScript_QueryInterface,
556     VBScript_AddRef,
557     VBScript_Release,
558     VBScript_SetScriptSite,
559     VBScript_GetScriptSite,
560     VBScript_SetScriptState,
561     VBScript_GetScriptState,
562     VBScript_Close,
563     VBScript_AddNamedItem,
564     VBScript_AddTypeLib,
565     VBScript_GetScriptDispatch,
566     VBScript_GetCurrentScriptThreadID,
567     VBScript_GetScriptThreadID,
568     VBScript_GetScriptThreadState,
569     VBScript_InterruptScriptThread,
570     VBScript_Clone
571 };
572 
573 static inline VBScript *impl_from_IActiveScriptDebug(IActiveScriptDebug *iface)
574 {
575     return CONTAINING_RECORD(iface, VBScript, IActiveScriptDebug_iface);
576 }
577 
578 static HRESULT WINAPI VBScriptDebug_QueryInterface(IActiveScriptDebug *iface, REFIID riid, void **ppv)
579 {
580     VBScript *This = impl_from_IActiveScriptDebug(iface);
581     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
582 }
583 
584 static ULONG WINAPI VBScriptDebug_AddRef(IActiveScriptDebug *iface)
585 {
586     VBScript *This = impl_from_IActiveScriptDebug(iface);
587     return IActiveScript_AddRef(&This->IActiveScript_iface);
588 }
589 
590 static ULONG WINAPI VBScriptDebug_Release(IActiveScriptDebug *iface)
591 {
592     VBScript *This = impl_from_IActiveScriptDebug(iface);
593     return IActiveScript_Release(&This->IActiveScript_iface);
594 }
595 
596 static HRESULT WINAPI VBScriptDebug_GetScriptTextAttributes(IActiveScriptDebug *iface,
597         LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
598 {
599     VBScript *This = impl_from_IActiveScriptDebug(iface);
600     FIXME("(%p)->(%s %u %s %#x %p)\n", This, debugstr_w(code), len,
601           debugstr_w(delimiter), flags, attr);
602     return E_NOTIMPL;
603 }
604 
605 static HRESULT WINAPI VBScriptDebug_GetScriptletTextAttributes(IActiveScriptDebug *iface,
606         LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
607 {
608     VBScript *This = impl_from_IActiveScriptDebug(iface);
609     FIXME("(%p)->(%s %u %s %#x %p)\n", This, debugstr_w(code), len,
610           debugstr_w(delimiter), flags, attr);
611     return E_NOTIMPL;
612 }
613 
614 static HRESULT WINAPI VBScriptDebug_EnumCodeContextsOfPosition(IActiveScriptDebug *iface,
615         CTXARG_T source, ULONG offset, ULONG len, IEnumDebugCodeContexts **ret)
616 {
617     VBScript *This = impl_from_IActiveScriptDebug(iface);
618     FIXME("(%p)->(%s %u %u %p)\n", This, wine_dbgstr_longlong(source), offset, len, ret);
619     return E_NOTIMPL;
620 }
621 
622 static const IActiveScriptDebugVtbl VBScriptDebugVtbl = {
623     VBScriptDebug_QueryInterface,
624     VBScriptDebug_AddRef,
625     VBScriptDebug_Release,
626     VBScriptDebug_GetScriptTextAttributes,
627     VBScriptDebug_GetScriptletTextAttributes,
628     VBScriptDebug_EnumCodeContextsOfPosition,
629 };
630 
631 static inline VBScript *impl_from_IActiveScriptParse(IActiveScriptParse *iface)
632 {
633     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParse_iface);
634 }
635 
636 static HRESULT WINAPI VBScriptParse_QueryInterface(IActiveScriptParse *iface, REFIID riid, void **ppv)
637 {
638     VBScript *This = impl_from_IActiveScriptParse(iface);
639     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
640 }
641 
642 static ULONG WINAPI VBScriptParse_AddRef(IActiveScriptParse *iface)
643 {
644     VBScript *This = impl_from_IActiveScriptParse(iface);
645     return IActiveScript_AddRef(&This->IActiveScript_iface);
646 }
647 
648 static ULONG WINAPI VBScriptParse_Release(IActiveScriptParse *iface)
649 {
650     VBScript *This = impl_from_IActiveScriptParse(iface);
651     return IActiveScript_Release(&This->IActiveScript_iface);
652 }
653 
654 static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
655 {
656     VBScript *This = impl_from_IActiveScriptParse(iface);
657     script_ctx_t *ctx, *old_ctx;
658 
659     TRACE("(%p)\n", This);
660 
661     if(This->ctx)
662         return E_UNEXPECTED;
663 
664     ctx = heap_alloc_zero(sizeof(script_ctx_t));
665     if(!ctx)
666         return E_OUTOFMEMORY;
667 
668     ctx->safeopt = This->safeopt;
669     heap_pool_init(&ctx->heap);
670     list_init(&ctx->objects);
671     list_init(&ctx->code_list);
672     list_init(&ctx->named_items);
673 
674     old_ctx = InterlockedCompareExchangePointer((void**)&This->ctx, ctx, NULL);
675     if(old_ctx) {
676         destroy_script(ctx);
677         return E_UNEXPECTED;
678     }
679 
680     return This->site ? set_ctx_site(This) : S_OK;
681 }
682 
683 static HRESULT WINAPI VBScriptParse_AddScriptlet(IActiveScriptParse *iface,
684         LPCOLESTR pstrDefaultName, LPCOLESTR pstrCode, LPCOLESTR pstrItemName,
685         LPCOLESTR pstrSubItemName, LPCOLESTR pstrEventName, LPCOLESTR pstrDelimiter,
686         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags,
687         BSTR *pbstrName, EXCEPINFO *pexcepinfo)
688 {
689     VBScript *This = impl_from_IActiveScriptParse(iface);
690     FIXME("(%p)->(%s %s %s %s %s %s %s %u %x %p %p)\n", This, debugstr_w(pstrDefaultName),
691           debugstr_w(pstrCode), debugstr_w(pstrItemName), debugstr_w(pstrSubItemName),
692           debugstr_w(pstrEventName), debugstr_w(pstrDelimiter), wine_dbgstr_longlong(dwSourceContextCookie),
693           ulStartingLineNumber, dwFlags, pbstrName, pexcepinfo);
694     return E_NOTIMPL;
695 }
696 
697 static HRESULT WINAPI VBScriptParse_ParseScriptText(IActiveScriptParse *iface,
698         LPCOLESTR pstrCode, LPCOLESTR pstrItemName, IUnknown *punkContext,
699         LPCOLESTR pstrDelimiter, CTXARG_T dwSourceContextCookie, ULONG ulStartingLine,
700         DWORD dwFlags, VARIANT *pvarResult, EXCEPINFO *pexcepinfo)
701 {
702     VBScript *This = impl_from_IActiveScriptParse(iface);
703     IDispatch *context = NULL;
704     vbscode_t *code;
705     HRESULT hres;
706 
707     TRACE("(%p)->(%s %s %p %s %s %u %x %p %p)\n", This, debugstr_w(pstrCode),
708           debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
709           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLine, dwFlags, pvarResult, pexcepinfo);
710 
711     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
712         return E_UNEXPECTED;
713 
714     if(pstrItemName) {
715         context = lookup_named_item(This->ctx, pstrItemName, 0);
716         if(!context) {
717             WARN("Inknown context %s\n", debugstr_w(pstrItemName));
718             return E_INVALIDARG;
719         }
720     }
721 
722     hres = compile_script(This->ctx, pstrCode, pstrDelimiter, &code);
723     if(FAILED(hres))
724         return hres;
725 
726     if(context)
727         IDispatch_AddRef(code->context = context);
728 
729     if(!is_started(This)) {
730         code->pending_exec = TRUE;
731         return S_OK;
732     }
733 
734     return exec_global_code(This->ctx, code);
735 }
736 
737 static const IActiveScriptParseVtbl VBScriptParseVtbl = {
738     VBScriptParse_QueryInterface,
739     VBScriptParse_AddRef,
740     VBScriptParse_Release,
741     VBScriptParse_InitNew,
742     VBScriptParse_AddScriptlet,
743     VBScriptParse_ParseScriptText
744 };
745 
746 static inline VBScript *impl_from_IActiveScriptParseProcedure2(IActiveScriptParseProcedure2 *iface)
747 {
748     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParseProcedure2_iface);
749 }
750 
751 static HRESULT WINAPI VBScriptParseProcedure_QueryInterface(IActiveScriptParseProcedure2 *iface, REFIID riid, void **ppv)
752 {
753     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
754     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
755 }
756 
757 static ULONG WINAPI VBScriptParseProcedure_AddRef(IActiveScriptParseProcedure2 *iface)
758 {
759     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
760     return IActiveScript_AddRef(&This->IActiveScript_iface);
761 }
762 
763 static ULONG WINAPI VBScriptParseProcedure_Release(IActiveScriptParseProcedure2 *iface)
764 {
765     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
766     return IActiveScript_Release(&This->IActiveScript_iface);
767 }
768 
769 static HRESULT WINAPI VBScriptParseProcedure_ParseProcedureText(IActiveScriptParseProcedure2 *iface,
770         LPCOLESTR pstrCode, LPCOLESTR pstrFormalParams, LPCOLESTR pstrProcedureName,
771         LPCOLESTR pstrItemName, IUnknown *punkContext, LPCOLESTR pstrDelimiter,
772         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags, IDispatch **ppdisp)
773 {
774     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
775     vbscode_t *code;
776     HRESULT hres;
777 
778     TRACE("(%p)->(%s %s %s %s %p %s %s %u %x %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
779           debugstr_w(pstrProcedureName), debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
780           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLineNumber, dwFlags, ppdisp);
781 
782     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
783         return E_UNEXPECTED;
784 
785     hres = compile_script(This->ctx, pstrCode, pstrDelimiter, &code);
786     if(FAILED(hres))
787         return hres;
788 
789     return create_procedure_disp(This->ctx, code, ppdisp);
790 }
791 
792 static const IActiveScriptParseProcedure2Vtbl VBScriptParseProcedureVtbl = {
793     VBScriptParseProcedure_QueryInterface,
794     VBScriptParseProcedure_AddRef,
795     VBScriptParseProcedure_Release,
796     VBScriptParseProcedure_ParseProcedureText,
797 };
798 
799 static inline VBScript *impl_from_IObjectSafety(IObjectSafety *iface)
800 {
801     return CONTAINING_RECORD(iface, VBScript, IObjectSafety_iface);
802 }
803 
804 static HRESULT WINAPI VBScriptSafety_QueryInterface(IObjectSafety *iface, REFIID riid, void **ppv)
805 {
806     VBScript *This = impl_from_IObjectSafety(iface);
807     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
808 }
809 
810 static ULONG WINAPI VBScriptSafety_AddRef(IObjectSafety *iface)
811 {
812     VBScript *This = impl_from_IObjectSafety(iface);
813     return IActiveScript_AddRef(&This->IActiveScript_iface);
814 }
815 
816 static ULONG WINAPI VBScriptSafety_Release(IObjectSafety *iface)
817 {
818     VBScript *This = impl_from_IObjectSafety(iface);
819     return IActiveScript_Release(&This->IActiveScript_iface);
820 }
821 
822 #define SUPPORTED_OPTIONS (INTERFACESAFE_FOR_UNTRUSTED_DATA|INTERFACE_USES_DISPEX|INTERFACE_USES_SECURITY_MANAGER)
823 
824 static HRESULT WINAPI VBScriptSafety_GetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
825         DWORD *pdwSupportedOptions, DWORD *pdwEnabledOptions)
826 {
827     VBScript *This = impl_from_IObjectSafety(iface);
828 
829     TRACE("(%p)->(%s %p %p)\n", This, debugstr_guid(riid), pdwSupportedOptions, pdwEnabledOptions);
830 
831     if(!pdwSupportedOptions || !pdwEnabledOptions)
832         return E_POINTER;
833 
834     *pdwSupportedOptions = SUPPORTED_OPTIONS;
835     *pdwEnabledOptions = This->safeopt;
836     return S_OK;
837 }
838 
839 static HRESULT WINAPI VBScriptSafety_SetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
840         DWORD dwOptionSetMask, DWORD dwEnabledOptions)
841 {
842     VBScript *This = impl_from_IObjectSafety(iface);
843 
844     TRACE("(%p)->(%s %x %x)\n", This, debugstr_guid(riid), dwOptionSetMask, dwEnabledOptions);
845 
846     if(dwOptionSetMask & ~SUPPORTED_OPTIONS)
847         return E_FAIL;
848 
849     This->safeopt = (dwEnabledOptions & dwOptionSetMask) | (This->safeopt & ~dwOptionSetMask) | INTERFACE_USES_DISPEX;
850     return S_OK;
851 }
852 
853 static const IObjectSafetyVtbl VBScriptSafetyVtbl = {
854     VBScriptSafety_QueryInterface,
855     VBScriptSafety_AddRef,
856     VBScriptSafety_Release,
857     VBScriptSafety_GetInterfaceSafetyOptions,
858     VBScriptSafety_SetInterfaceSafetyOptions
859 };
860 
861 HRESULT WINAPI VBScriptFactory_CreateInstance(IClassFactory *iface, IUnknown *pUnkOuter, REFIID riid, void **ppv)
862 {
863     VBScript *ret;
864     HRESULT hres;
865 
866     TRACE("(%p %s %p)\n", pUnkOuter, debugstr_guid(riid), ppv);
867 
868     ret = heap_alloc_zero(sizeof(*ret));
869     if(!ret)
870         return E_OUTOFMEMORY;
871 
872     ret->IActiveScript_iface.lpVtbl = &VBScriptVtbl;
873     ret->IActiveScriptDebug_iface.lpVtbl = &VBScriptDebugVtbl;
874     ret->IActiveScriptParse_iface.lpVtbl = &VBScriptParseVtbl;
875     ret->IActiveScriptParseProcedure2_iface.lpVtbl = &VBScriptParseProcedureVtbl;
876     ret->IObjectSafety_iface.lpVtbl = &VBScriptSafetyVtbl;
877 
878     ret->ref = 1;
879     ret->state = SCRIPTSTATE_UNINITIALIZED;
880     ret->safeopt = INTERFACE_USES_DISPEX;
881 
882     hres = IActiveScript_QueryInterface(&ret->IActiveScript_iface, riid, ppv);
883     IActiveScript_Release(&ret->IActiveScript_iface);
884     return hres;
885 }
886 
887 typedef struct {
888     IServiceProvider IServiceProvider_iface;
889 
890     LONG ref;
891 
892     IServiceProvider *sp;
893 } AXSite;
894 
895 static inline AXSite *impl_from_IServiceProvider(IServiceProvider *iface)
896 {
897     return CONTAINING_RECORD(iface, AXSite, IServiceProvider_iface);
898 }
899 
900 static HRESULT WINAPI AXSite_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
901 {
902     AXSite *This = impl_from_IServiceProvider(iface);
903 
904     if(IsEqualGUID(&IID_IUnknown, riid)) {
905         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
906         *ppv = &This->IServiceProvider_iface;
907     }else if(IsEqualGUID(&IID_IServiceProvider, riid)) {
908         TRACE("(%p)->(IID_IServiceProvider %p)\n", This, ppv);
909         *ppv = &This->IServiceProvider_iface;
910     }else {
911         TRACE("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
912         *ppv = NULL;
913         return E_NOINTERFACE;
914     }
915 
916     IUnknown_AddRef((IUnknown*)*ppv);
917     return S_OK;
918 }
919 
920 static ULONG WINAPI AXSite_AddRef(IServiceProvider *iface)
921 {
922     AXSite *This = impl_from_IServiceProvider(iface);
923     LONG ref = InterlockedIncrement(&This->ref);
924 
925     TRACE("(%p) ref=%d\n", This, ref);
926 
927     return ref;
928 }
929 
930 static ULONG WINAPI AXSite_Release(IServiceProvider *iface)
931 {
932     AXSite *This = impl_from_IServiceProvider(iface);
933     LONG ref = InterlockedDecrement(&This->ref);
934 
935     TRACE("(%p) ref=%d\n", This, ref);
936 
937     if(!ref)
938         heap_free(This);
939 
940     return ref;
941 }
942 
943 static HRESULT WINAPI AXSite_QueryService(IServiceProvider *iface,
944         REFGUID guidService, REFIID riid, void **ppv)
945 {
946     AXSite *This = impl_from_IServiceProvider(iface);
947 
948     TRACE("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
949 
950     return IServiceProvider_QueryService(This->sp, guidService, riid, ppv);
951 }
952 
953 static IServiceProviderVtbl AXSiteVtbl = {
954     AXSite_QueryInterface,
955     AXSite_AddRef,
956     AXSite_Release,
957     AXSite_QueryService
958 };
959 
960 IUnknown *create_ax_site(script_ctx_t *ctx)
961 {
962     IServiceProvider *sp;
963     AXSite *ret;
964     HRESULT hres;
965 
966     hres = IActiveScriptSite_QueryInterface(ctx->site, &IID_IServiceProvider, (void**)&sp);
967     if(FAILED(hres)) {
968         ERR("Could not get IServiceProvider iface: %08x\n", hres);
969         return NULL;
970     }
971 
972     ret = heap_alloc(sizeof(*ret));
973     if(!ret) {
974         IServiceProvider_Release(sp);
975         return NULL;
976     }
977 
978     ret->IServiceProvider_iface.lpVtbl = &AXSiteVtbl;
979     ret->ref = 1;
980     ret->sp = sp;
981 
982     return (IUnknown*)&ret->IServiceProvider_iface;
983 }
984