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