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