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