Release 6.15.
[wine.git] / dlls / vbscript / vbscript.c
blob4b57b4b2b93157d0466cc06221104ada7b06d34d
1 /*
2 * Copyright 2011 Jacek Caban for CodeWeavers
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.
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.
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
20 #include <assert.h>
22 #include "vbscript.h"
23 #include "objsafe.h"
25 #include "wine/debug.h"
27 WINE_DEFAULT_DEBUG_CHANNEL(vbscript);
29 #ifdef _WIN64
31 #define CTXARG_T DWORDLONG
32 #define IActiveScriptDebugVtbl IActiveScriptDebug64Vtbl
33 #define IActiveScriptParseVtbl IActiveScriptParse64Vtbl
34 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_64Vtbl
36 #else
38 #define CTXARG_T DWORD
39 #define IActiveScriptDebugVtbl IActiveScriptDebug32Vtbl
40 #define IActiveScriptParseVtbl IActiveScriptParse32Vtbl
41 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_32Vtbl
43 #endif
45 struct VBScript {
46 IActiveScript IActiveScript_iface;
47 IActiveScriptDebug IActiveScriptDebug_iface;
48 IActiveScriptParse IActiveScriptParse_iface;
49 IActiveScriptParseProcedure2 IActiveScriptParseProcedure2_iface;
50 IObjectSafety IObjectSafety_iface;
52 LONG ref;
54 SCRIPTSTATE state;
55 script_ctx_t *ctx;
56 LONG thread_id;
57 BOOL is_initialized;
60 typedef struct {
61 IActiveScriptError IActiveScriptError_iface;
62 LONG ref;
63 EXCEPINFO ei;
64 DWORD_PTR cookie;
65 unsigned line;
66 unsigned character;
67 } VBScriptError;
69 static inline WCHAR *heap_pool_strdup(heap_pool_t *heap, const WCHAR *str)
71 size_t size = (lstrlenW(str) + 1) * sizeof(WCHAR);
72 WCHAR *ret = heap_pool_alloc(heap, size);
73 if (ret) memcpy(ret, str, size);
74 return ret;
77 static void change_state(VBScript *This, SCRIPTSTATE state)
79 if(This->state == state)
80 return;
82 This->state = state;
83 if(This->ctx->site)
84 IActiveScriptSite_OnStateChange(This->ctx->site, state);
87 static inline BOOL is_started(VBScript *This)
89 return This->state == SCRIPTSTATE_STARTED
90 || This->state == SCRIPTSTATE_CONNECTED
91 || This->state == SCRIPTSTATE_DISCONNECTED;
94 static HRESULT exec_global_code(script_ctx_t *ctx, vbscode_t *code, VARIANT *res)
96 ScriptDisp *obj = ctx->script_obj;
97 function_t *func_iter, **new_funcs;
98 dynamic_var_t *var, **new_vars;
99 size_t cnt, i;
100 HRESULT hres;
102 if(code->named_item) {
103 if(!code->named_item->script_obj) {
104 hres = create_script_disp(ctx, &code->named_item->script_obj);
105 if(FAILED(hres)) return hres;
107 obj = code->named_item->script_obj;
110 cnt = obj->global_vars_cnt + code->main_code.var_cnt;
111 if (cnt > obj->global_vars_size)
113 if (obj->global_vars)
114 new_vars = heap_realloc(obj->global_vars, cnt * sizeof(*new_vars));
115 else
116 new_vars = heap_alloc(cnt * sizeof(*new_vars));
117 if (!new_vars)
118 return E_OUTOFMEMORY;
119 obj->global_vars = new_vars;
120 obj->global_vars_size = cnt;
123 cnt = obj->global_funcs_cnt;
124 for (func_iter = code->funcs; func_iter; func_iter = func_iter->next)
125 cnt++;
126 if (cnt > obj->global_funcs_size)
128 if (obj->global_funcs)
129 new_funcs = heap_realloc(obj->global_funcs, cnt * sizeof(*new_funcs));
130 else
131 new_funcs = heap_alloc(cnt * sizeof(*new_funcs));
132 if (!new_funcs)
133 return E_OUTOFMEMORY;
134 obj->global_funcs = new_funcs;
135 obj->global_funcs_size = cnt;
138 for (i = 0; i < code->main_code.var_cnt; i++)
140 if (!(var = heap_pool_alloc(&obj->heap, sizeof(*var))))
141 return E_OUTOFMEMORY;
143 var->name = heap_pool_strdup(&obj->heap, code->main_code.vars[i].name);
144 if (!var->name)
145 return E_OUTOFMEMORY;
146 V_VT(&var->v) = VT_EMPTY;
147 var->is_const = FALSE;
148 var->array = NULL;
150 obj->global_vars[obj->global_vars_cnt + i] = var;
153 obj->global_vars_cnt += code->main_code.var_cnt;
155 for (func_iter = code->funcs; func_iter; func_iter = func_iter->next)
157 for (i = 0; i < obj->global_funcs_cnt; i++)
159 if (!wcsicmp(obj->global_funcs[i]->name, func_iter->name))
161 /* global function already exists, replace it */
162 obj->global_funcs[i] = func_iter;
163 break;
166 if (i == obj->global_funcs_cnt)
167 obj->global_funcs[obj->global_funcs_cnt++] = func_iter;
170 if (code->classes)
172 class_desc_t *class = code->classes;
174 while (1)
176 class->ctx = ctx;
177 if (!class->next)
178 break;
179 class = class->next;
182 class->next = obj->classes;
183 obj->classes = code->classes;
184 code->last_class = class;
187 code->pending_exec = FALSE;
188 return exec_script(ctx, TRUE, &code->main_code, NULL, NULL, res);
191 static void exec_queued_code(script_ctx_t *ctx)
193 vbscode_t *iter;
195 LIST_FOR_EACH_ENTRY(iter, &ctx->code_list, vbscode_t, entry) {
196 if(iter->pending_exec)
197 exec_global_code(ctx, iter, NULL);
201 static HRESULT retrieve_named_item_disp(IActiveScriptSite *site, named_item_t *item)
203 IUnknown *unk;
204 HRESULT hres;
206 hres = IActiveScriptSite_GetItemInfo(site, item->name, SCRIPTINFO_IUNKNOWN, &unk, NULL);
207 if(FAILED(hres)) {
208 WARN("GetItemInfo failed: %08x\n", hres);
209 return hres;
212 hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&item->disp);
213 IUnknown_Release(unk);
214 if(FAILED(hres)) {
215 WARN("object does not implement IDispatch\n");
216 return hres;
219 return S_OK;
222 named_item_t *lookup_named_item(script_ctx_t *ctx, const WCHAR *name, unsigned flags)
224 named_item_t *item;
225 HRESULT hres;
227 LIST_FOR_EACH_ENTRY(item, &ctx->named_items, named_item_t, entry) {
228 if((item->flags & flags) == flags && !wcsicmp(item->name, name)) {
229 if(!item->script_obj && !(item->flags & SCRIPTITEM_GLOBALMEMBERS)) {
230 hres = create_script_disp(ctx, &item->script_obj);
231 if(FAILED(hres)) return NULL;
234 if(!item->disp && (flags || !(item->flags & SCRIPTITEM_CODEONLY))) {
235 hres = retrieve_named_item_disp(ctx->site, item);
236 if(FAILED(hres)) continue;
239 return item;
243 return NULL;
246 static void release_named_item_script_obj(named_item_t *item)
248 if(!item->script_obj) return;
250 item->script_obj->ctx = NULL;
251 IDispatchEx_Release(&item->script_obj->IDispatchEx_iface);
252 item->script_obj = NULL;
255 void release_named_item(named_item_t *item)
257 if(--item->ref) return;
259 heap_free(item->name);
260 heap_free(item);
263 static void release_script(script_ctx_t *ctx)
265 named_item_t *item, *item_next;
266 vbscode_t *code, *code_next;
268 collect_objects(ctx);
269 clear_ei(&ctx->ei);
271 LIST_FOR_EACH_ENTRY_SAFE(code, code_next, &ctx->code_list, vbscode_t, entry)
273 if(code->is_persistent)
275 code->pending_exec = TRUE;
276 if(code->last_class) code->last_class->next = NULL;
277 if(code->named_item) release_named_item_script_obj(code->named_item);
279 else
281 list_remove(&code->entry);
282 release_vbscode(code);
286 LIST_FOR_EACH_ENTRY_SAFE(item, item_next, &ctx->named_items, named_item_t, entry)
288 if(item->disp)
290 IDispatch_Release(item->disp);
291 item->disp = NULL;
293 release_named_item_script_obj(item);
294 if(!(item->flags & SCRIPTITEM_ISPERSISTENT))
296 list_remove(&item->entry);
297 release_named_item(item);
301 if(ctx->secmgr) {
302 IInternetHostSecurityManager_Release(ctx->secmgr);
303 ctx->secmgr = NULL;
306 if(ctx->site) {
307 IActiveScriptSite_Release(ctx->site);
308 ctx->site = NULL;
311 if(ctx->script_obj) {
312 ScriptDisp *script_obj = ctx->script_obj;
314 ctx->script_obj = NULL;
315 script_obj->ctx = NULL;
316 IDispatchEx_Release(&script_obj->IDispatchEx_iface);
320 static void release_code_list(script_ctx_t *ctx)
322 while(!list_empty(&ctx->code_list)) {
323 vbscode_t *iter = LIST_ENTRY(list_head(&ctx->code_list), vbscode_t, entry);
325 list_remove(&iter->entry);
326 release_vbscode(iter);
330 static void release_named_item_list(script_ctx_t *ctx)
332 while(!list_empty(&ctx->named_items)) {
333 named_item_t *iter = LIST_ENTRY(list_head(&ctx->named_items), named_item_t, entry);
334 list_remove(&iter->entry);
335 release_named_item(iter);
339 static void decrease_state(VBScript *This, SCRIPTSTATE state)
341 switch(This->state) {
342 case SCRIPTSTATE_CONNECTED:
343 change_state(This, SCRIPTSTATE_DISCONNECTED);
344 if(state == SCRIPTSTATE_DISCONNECTED)
345 return;
346 /* FALLTHROUGH */
347 case SCRIPTSTATE_STARTED:
348 case SCRIPTSTATE_DISCONNECTED:
349 change_state(This, SCRIPTSTATE_INITIALIZED);
350 /* FALLTHROUGH */
351 case SCRIPTSTATE_INITIALIZED:
352 case SCRIPTSTATE_UNINITIALIZED:
353 change_state(This, state);
354 if(state == SCRIPTSTATE_INITIALIZED)
355 break;
356 release_script(This->ctx);
357 This->thread_id = 0;
358 if(state == SCRIPTSTATE_CLOSED) {
359 release_code_list(This->ctx);
360 release_named_item_list(This->ctx);
362 break;
363 case SCRIPTSTATE_CLOSED:
364 break;
365 DEFAULT_UNREACHABLE;
369 static inline VBScriptError *impl_from_IActiveScriptError(IActiveScriptError *iface)
371 return CONTAINING_RECORD(iface, VBScriptError, IActiveScriptError_iface);
374 static HRESULT WINAPI VBScriptError_QueryInterface(IActiveScriptError *iface, REFIID riid, void **ppv)
376 VBScriptError *This = impl_from_IActiveScriptError(iface);
378 if(IsEqualGUID(riid, &IID_IUnknown)) {
379 TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
380 *ppv = &This->IActiveScriptError_iface;
381 }else if(IsEqualGUID(riid, &IID_IActiveScriptError)) {
382 TRACE("(%p)->(IID_IActiveScriptError %p)\n", This, ppv);
383 *ppv = &This->IActiveScriptError_iface;
384 }else {
385 FIXME("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
386 *ppv = NULL;
387 return E_NOINTERFACE;
390 IUnknown_AddRef((IUnknown*)*ppv);
391 return S_OK;
394 static ULONG WINAPI VBScriptError_AddRef(IActiveScriptError *iface)
396 VBScriptError *This = impl_from_IActiveScriptError(iface);
397 LONG ref = InterlockedIncrement(&This->ref);
399 TRACE("(%p) ref=%d\n", This, ref);
401 return ref;
404 static ULONG WINAPI VBScriptError_Release(IActiveScriptError *iface)
406 VBScriptError *This = impl_from_IActiveScriptError(iface);
407 LONG ref = InterlockedDecrement(&This->ref);
409 TRACE("(%p) ref=%d\n", This, ref);
411 if(!ref) {
412 heap_free(This);
415 return ref;
418 static HRESULT WINAPI VBScriptError_GetExceptionInfo(IActiveScriptError *iface, EXCEPINFO *excepinfo)
420 VBScriptError *This = impl_from_IActiveScriptError(iface);
422 TRACE("(%p)->(%p)\n", This, excepinfo);
424 *excepinfo = This->ei;
425 excepinfo->bstrSource = SysAllocString(This->ei.bstrSource);
426 excepinfo->bstrDescription = SysAllocString(This->ei.bstrDescription);
427 excepinfo->bstrHelpFile = SysAllocString(This->ei.bstrHelpFile);
428 return S_OK;
431 static HRESULT WINAPI VBScriptError_GetSourcePosition(IActiveScriptError *iface, DWORD *source_context, ULONG *line, LONG *character)
433 VBScriptError *This = impl_from_IActiveScriptError(iface);
435 TRACE("(%p)->(%p %p %p)\n", This, source_context, line, character);
437 if(source_context)
438 *source_context = This->cookie;
439 if(line)
440 *line = This->line;
441 if(character)
442 *character = This->character;
443 return S_OK;
446 static HRESULT WINAPI VBScriptError_GetSourceLineText(IActiveScriptError *iface, BSTR *source)
448 VBScriptError *This = impl_from_IActiveScriptError(iface);
449 FIXME("(%p)->(%p)\n", This, source);
450 return E_NOTIMPL;
453 static const IActiveScriptErrorVtbl VBScriptErrorVtbl = {
454 VBScriptError_QueryInterface,
455 VBScriptError_AddRef,
456 VBScriptError_Release,
457 VBScriptError_GetExceptionInfo,
458 VBScriptError_GetSourcePosition,
459 VBScriptError_GetSourceLineText
462 HRESULT report_script_error(script_ctx_t *ctx, const vbscode_t *code, unsigned loc)
464 VBScriptError *error;
465 const WCHAR *p, *nl;
466 HRESULT hres, result;
468 if(!(error = heap_alloc(sizeof(*error))))
469 return E_OUTOFMEMORY;
470 error->IActiveScriptError_iface.lpVtbl = &VBScriptErrorVtbl;
472 error->ref = 1;
473 error->ei = ctx->ei;
474 memset(&ctx->ei, 0, sizeof(ctx->ei));
475 result = error->ei.scode;
477 p = code->source;
478 error->cookie = code->cookie;
479 error->line = code->start_line;
480 for(nl = p = code->source; p < code->source + loc; p++) {
481 if(*p != '\n') continue;
482 error->line++;
483 nl = p + 1;
485 error->character = code->source + loc - nl;
487 hres = IActiveScriptSite_OnScriptError(ctx->site, &error->IActiveScriptError_iface);
488 IActiveScriptError_Release(&error->IActiveScriptError_iface);
489 return hres == S_OK ? SCRIPT_E_REPORTED : result;
492 static inline VBScript *impl_from_IActiveScript(IActiveScript *iface)
494 return CONTAINING_RECORD(iface, VBScript, IActiveScript_iface);
497 static HRESULT WINAPI VBScript_QueryInterface(IActiveScript *iface, REFIID riid, void **ppv)
499 VBScript *This = impl_from_IActiveScript(iface);
501 if(IsEqualGUID(riid, &IID_IUnknown)) {
502 TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
503 *ppv = &This->IActiveScript_iface;
504 }else if(IsEqualGUID(riid, &IID_IActiveScript)) {
505 TRACE("(%p)->(IID_IActiveScript %p)\n", This, ppv);
506 *ppv = &This->IActiveScript_iface;
507 }else if(IsEqualGUID(riid, &IID_IActiveScriptDebug)) {
508 TRACE("(%p)->(IID_IActiveScriptDebug %p)\n", This, ppv);
509 *ppv = &This->IActiveScriptDebug_iface;
510 }else if(IsEqualGUID(riid, &IID_IActiveScriptParse)) {
511 TRACE("(%p)->(IID_IActiveScriptParse %p)\n", This, ppv);
512 *ppv = &This->IActiveScriptParse_iface;
513 }else if(IsEqualGUID(riid, &IID_IActiveScriptParseProcedure2)) {
514 TRACE("(%p)->(IID_IActiveScriptParseProcedure2 %p)\n", This, ppv);
515 *ppv = &This->IActiveScriptParseProcedure2_iface;
516 }else if(IsEqualGUID(riid, &IID_IObjectSafety)) {
517 TRACE("(%p)->(IID_IObjectSafety %p)\n", This, ppv);
518 *ppv = &This->IObjectSafety_iface;
519 }else {
520 WARN("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
521 *ppv = NULL;
522 return E_NOINTERFACE;
525 IUnknown_AddRef((IUnknown*)*ppv);
526 return S_OK;
529 static ULONG WINAPI VBScript_AddRef(IActiveScript *iface)
531 VBScript *This = impl_from_IActiveScript(iface);
532 LONG ref = InterlockedIncrement(&This->ref);
534 TRACE("(%p) ref=%d\n", This, ref);
536 return ref;
539 static ULONG WINAPI VBScript_Release(IActiveScript *iface)
541 VBScript *This = impl_from_IActiveScript(iface);
542 LONG ref = InterlockedDecrement(&This->ref);
544 TRACE("(%p) ref=%d\n", iface, ref);
546 if(!ref) {
547 decrease_state(This, SCRIPTSTATE_CLOSED);
548 detach_global_objects(This->ctx);
549 heap_free(This->ctx);
550 heap_free(This);
553 return ref;
556 static HRESULT WINAPI VBScript_SetScriptSite(IActiveScript *iface, IActiveScriptSite *pass)
558 VBScript *This = impl_from_IActiveScript(iface);
559 named_item_t *item;
560 LCID lcid;
561 HRESULT hres;
563 TRACE("(%p)->(%p)\n", This, pass);
565 if(!pass)
566 return E_POINTER;
568 if(This->ctx->site)
569 return E_UNEXPECTED;
571 if(InterlockedCompareExchange(&This->thread_id, GetCurrentThreadId(), 0))
572 return E_UNEXPECTED;
574 /* Retrieve new dispatches for persistent named items */
575 LIST_FOR_EACH_ENTRY(item, &This->ctx->named_items, named_item_t, entry)
577 if(!item->disp)
579 hres = retrieve_named_item_disp(pass, item);
580 if(FAILED(hres)) return hres;
583 /* For some reason, CODEONLY flag is lost in re-initialized scripts */
584 item->flags &= ~SCRIPTITEM_CODEONLY;
587 hres = create_script_disp(This->ctx, &This->ctx->script_obj);
588 if(FAILED(hres))
589 return hres;
591 This->ctx->site = pass;
592 IActiveScriptSite_AddRef(This->ctx->site);
594 hres = IActiveScriptSite_GetLCID(This->ctx->site, &lcid);
595 if(hres == S_OK)
596 This->ctx->lcid = lcid;
598 if(This->is_initialized)
599 change_state(This, SCRIPTSTATE_INITIALIZED);
600 return S_OK;
603 static HRESULT WINAPI VBScript_GetScriptSite(IActiveScript *iface, REFIID riid,
604 void **ppvObject)
606 VBScript *This = impl_from_IActiveScript(iface);
607 FIXME("(%p)->()\n", This);
608 return E_NOTIMPL;
611 static HRESULT WINAPI VBScript_SetScriptState(IActiveScript *iface, SCRIPTSTATE ss)
613 VBScript *This = impl_from_IActiveScript(iface);
615 TRACE("(%p)->(%d)\n", This, ss);
617 if(This->thread_id && GetCurrentThreadId() != This->thread_id)
618 return E_UNEXPECTED;
620 if(ss == SCRIPTSTATE_UNINITIALIZED) {
621 if(This->state == SCRIPTSTATE_CLOSED)
622 return E_UNEXPECTED;
624 decrease_state(This, SCRIPTSTATE_UNINITIALIZED);
625 return S_OK;
628 if(!This->is_initialized || (!This->ctx->site && ss != SCRIPTSTATE_CLOSED))
629 return E_UNEXPECTED;
631 switch(ss) {
632 case SCRIPTSTATE_STARTED:
633 case SCRIPTSTATE_CONNECTED: /* FIXME */
634 if(This->state == SCRIPTSTATE_CLOSED)
635 return E_UNEXPECTED;
637 exec_queued_code(This->ctx);
638 break;
639 case SCRIPTSTATE_INITIALIZED:
640 decrease_state(This, SCRIPTSTATE_INITIALIZED);
641 return S_OK;
642 case SCRIPTSTATE_CLOSED:
643 decrease_state(This, SCRIPTSTATE_CLOSED);
644 return S_OK;
645 case SCRIPTSTATE_DISCONNECTED:
646 FIXME("unimplemented SCRIPTSTATE_DISCONNECTED\n");
647 return S_OK;
648 default:
649 FIXME("unimplemented state %d\n", ss);
650 return E_NOTIMPL;
653 change_state(This, ss);
654 return S_OK;
657 static HRESULT WINAPI VBScript_GetScriptState(IActiveScript *iface, SCRIPTSTATE *pssState)
659 VBScript *This = impl_from_IActiveScript(iface);
661 TRACE("(%p)->(%p)\n", This, pssState);
663 if(!pssState)
664 return E_POINTER;
666 if(This->thread_id && This->thread_id != GetCurrentThreadId())
667 return E_UNEXPECTED;
669 *pssState = This->state;
670 return S_OK;
673 static HRESULT WINAPI VBScript_Close(IActiveScript *iface)
675 VBScript *This = impl_from_IActiveScript(iface);
677 TRACE("(%p)->()\n", This);
679 if(This->thread_id && This->thread_id != GetCurrentThreadId())
680 return E_UNEXPECTED;
682 decrease_state(This, SCRIPTSTATE_CLOSED);
683 return S_OK;
686 static HRESULT WINAPI VBScript_AddNamedItem(IActiveScript *iface, LPCOLESTR pstrName, DWORD dwFlags)
688 VBScript *This = impl_from_IActiveScript(iface);
689 named_item_t *item;
690 IDispatch *disp = NULL;
691 HRESULT hres;
693 TRACE("(%p)->(%s %x)\n", This, debugstr_w(pstrName), dwFlags);
695 if(This->thread_id != GetCurrentThreadId() || !This->ctx->site)
696 return E_UNEXPECTED;
698 if(dwFlags & SCRIPTITEM_GLOBALMEMBERS) {
699 IUnknown *unk;
701 hres = IActiveScriptSite_GetItemInfo(This->ctx->site, pstrName, SCRIPTINFO_IUNKNOWN, &unk, NULL);
702 if(FAILED(hres)) {
703 WARN("GetItemInfo failed: %08x\n", hres);
704 return hres;
707 hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&disp);
708 IUnknown_Release(unk);
709 if(FAILED(hres)) {
710 WARN("object does not implement IDispatch\n");
711 return hres;
715 item = heap_alloc(sizeof(*item));
716 if(!item) {
717 if(disp)
718 IDispatch_Release(disp);
719 return E_OUTOFMEMORY;
722 item->ref = 1;
723 item->disp = disp;
724 item->flags = dwFlags;
725 item->script_obj = NULL;
726 item->name = heap_strdupW(pstrName);
727 if(!item->name) {
728 if(disp)
729 IDispatch_Release(disp);
730 heap_free(item);
731 return E_OUTOFMEMORY;
734 list_add_tail(&This->ctx->named_items, &item->entry);
735 return S_OK;
738 static HRESULT WINAPI VBScript_AddTypeLib(IActiveScript *iface, REFGUID rguidTypeLib,
739 DWORD dwMajor, DWORD dwMinor, DWORD dwFlags)
741 VBScript *This = impl_from_IActiveScript(iface);
742 FIXME("(%p)->(%s %d %d %d)\n", This, debugstr_guid(rguidTypeLib), dwMajor, dwMinor, dwFlags);
743 return E_NOTIMPL;
746 static HRESULT WINAPI VBScript_GetScriptDispatch(IActiveScript *iface, LPCOLESTR pstrItemName, IDispatch **ppdisp)
748 VBScript *This = impl_from_IActiveScript(iface);
749 ScriptDisp *script_obj;
751 TRACE("(%p)->(%s %p)\n", This, debugstr_w(pstrItemName), ppdisp);
753 if(!ppdisp)
754 return E_POINTER;
756 if(This->thread_id != GetCurrentThreadId() || !This->ctx->script_obj) {
757 *ppdisp = NULL;
758 return E_UNEXPECTED;
761 script_obj = This->ctx->script_obj;
762 if(pstrItemName) {
763 named_item_t *item = lookup_named_item(This->ctx, pstrItemName, 0);
764 if(!item) return E_INVALIDARG;
765 if(item->script_obj) script_obj = item->script_obj;
768 *ppdisp = (IDispatch*)&script_obj->IDispatchEx_iface;
769 IDispatch_AddRef(*ppdisp);
770 return S_OK;
773 static HRESULT WINAPI VBScript_GetCurrentScriptThreadID(IActiveScript *iface,
774 SCRIPTTHREADID *pstridThread)
776 VBScript *This = impl_from_IActiveScript(iface);
777 FIXME("(%p)->()\n", This);
778 return E_NOTIMPL;
781 static HRESULT WINAPI VBScript_GetScriptThreadID(IActiveScript *iface,
782 DWORD dwWin32ThreadId, SCRIPTTHREADID *pstidThread)
784 VBScript *This = impl_from_IActiveScript(iface);
785 FIXME("(%p)->()\n", This);
786 return E_NOTIMPL;
789 static HRESULT WINAPI VBScript_GetScriptThreadState(IActiveScript *iface,
790 SCRIPTTHREADID stidThread, SCRIPTTHREADSTATE *pstsState)
792 VBScript *This = impl_from_IActiveScript(iface);
793 FIXME("(%p)->()\n", This);
794 return E_NOTIMPL;
797 static HRESULT WINAPI VBScript_InterruptScriptThread(IActiveScript *iface,
798 SCRIPTTHREADID stidThread, const EXCEPINFO *pexcepinfo, DWORD dwFlags)
800 VBScript *This = impl_from_IActiveScript(iface);
801 FIXME("(%p)->()\n", This);
802 return E_NOTIMPL;
805 static HRESULT WINAPI VBScript_Clone(IActiveScript *iface, IActiveScript **ppscript)
807 VBScript *This = impl_from_IActiveScript(iface);
808 FIXME("(%p)->()\n", This);
809 return E_NOTIMPL;
812 static const IActiveScriptVtbl VBScriptVtbl = {
813 VBScript_QueryInterface,
814 VBScript_AddRef,
815 VBScript_Release,
816 VBScript_SetScriptSite,
817 VBScript_GetScriptSite,
818 VBScript_SetScriptState,
819 VBScript_GetScriptState,
820 VBScript_Close,
821 VBScript_AddNamedItem,
822 VBScript_AddTypeLib,
823 VBScript_GetScriptDispatch,
824 VBScript_GetCurrentScriptThreadID,
825 VBScript_GetScriptThreadID,
826 VBScript_GetScriptThreadState,
827 VBScript_InterruptScriptThread,
828 VBScript_Clone
831 static inline VBScript *impl_from_IActiveScriptDebug(IActiveScriptDebug *iface)
833 return CONTAINING_RECORD(iface, VBScript, IActiveScriptDebug_iface);
836 static HRESULT WINAPI VBScriptDebug_QueryInterface(IActiveScriptDebug *iface, REFIID riid, void **ppv)
838 VBScript *This = impl_from_IActiveScriptDebug(iface);
839 return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
842 static ULONG WINAPI VBScriptDebug_AddRef(IActiveScriptDebug *iface)
844 VBScript *This = impl_from_IActiveScriptDebug(iface);
845 return IActiveScript_AddRef(&This->IActiveScript_iface);
848 static ULONG WINAPI VBScriptDebug_Release(IActiveScriptDebug *iface)
850 VBScript *This = impl_from_IActiveScriptDebug(iface);
851 return IActiveScript_Release(&This->IActiveScript_iface);
854 static HRESULT WINAPI VBScriptDebug_GetScriptTextAttributes(IActiveScriptDebug *iface,
855 LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
857 VBScript *This = impl_from_IActiveScriptDebug(iface);
858 FIXME("(%p)->(%s %u %s %#x %p)\n", This, debugstr_w(code), len,
859 debugstr_w(delimiter), flags, attr);
860 return E_NOTIMPL;
863 static HRESULT WINAPI VBScriptDebug_GetScriptletTextAttributes(IActiveScriptDebug *iface,
864 LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
866 VBScript *This = impl_from_IActiveScriptDebug(iface);
867 FIXME("(%p)->(%s %u %s %#x %p)\n", This, debugstr_w(code), len,
868 debugstr_w(delimiter), flags, attr);
869 return E_NOTIMPL;
872 static HRESULT WINAPI VBScriptDebug_EnumCodeContextsOfPosition(IActiveScriptDebug *iface,
873 CTXARG_T source, ULONG offset, ULONG len, IEnumDebugCodeContexts **ret)
875 VBScript *This = impl_from_IActiveScriptDebug(iface);
876 FIXME("(%p)->(%s %u %u %p)\n", This, wine_dbgstr_longlong(source), offset, len, ret);
877 return E_NOTIMPL;
880 static const IActiveScriptDebugVtbl VBScriptDebugVtbl = {
881 VBScriptDebug_QueryInterface,
882 VBScriptDebug_AddRef,
883 VBScriptDebug_Release,
884 VBScriptDebug_GetScriptTextAttributes,
885 VBScriptDebug_GetScriptletTextAttributes,
886 VBScriptDebug_EnumCodeContextsOfPosition,
889 static inline VBScript *impl_from_IActiveScriptParse(IActiveScriptParse *iface)
891 return CONTAINING_RECORD(iface, VBScript, IActiveScriptParse_iface);
894 static HRESULT WINAPI VBScriptParse_QueryInterface(IActiveScriptParse *iface, REFIID riid, void **ppv)
896 VBScript *This = impl_from_IActiveScriptParse(iface);
897 return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
900 static ULONG WINAPI VBScriptParse_AddRef(IActiveScriptParse *iface)
902 VBScript *This = impl_from_IActiveScriptParse(iface);
903 return IActiveScript_AddRef(&This->IActiveScript_iface);
906 static ULONG WINAPI VBScriptParse_Release(IActiveScriptParse *iface)
908 VBScript *This = impl_from_IActiveScriptParse(iface);
909 return IActiveScript_Release(&This->IActiveScript_iface);
912 static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
914 VBScript *This = impl_from_IActiveScriptParse(iface);
916 TRACE("(%p)\n", This);
918 if(This->is_initialized)
919 return E_UNEXPECTED;
920 This->is_initialized = TRUE;
922 if(This->ctx->site)
923 change_state(This, SCRIPTSTATE_INITIALIZED);
924 return S_OK;
927 static HRESULT WINAPI VBScriptParse_AddScriptlet(IActiveScriptParse *iface,
928 LPCOLESTR pstrDefaultName, LPCOLESTR pstrCode, LPCOLESTR pstrItemName,
929 LPCOLESTR pstrSubItemName, LPCOLESTR pstrEventName, LPCOLESTR pstrDelimiter,
930 CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags,
931 BSTR *pbstrName, EXCEPINFO *pexcepinfo)
933 VBScript *This = impl_from_IActiveScriptParse(iface);
934 FIXME("(%p)->(%s %s %s %s %s %s %s %u %x %p %p)\n", This, debugstr_w(pstrDefaultName),
935 debugstr_w(pstrCode), debugstr_w(pstrItemName), debugstr_w(pstrSubItemName),
936 debugstr_w(pstrEventName), debugstr_w(pstrDelimiter), wine_dbgstr_longlong(dwSourceContextCookie),
937 ulStartingLineNumber, dwFlags, pbstrName, pexcepinfo);
938 return E_NOTIMPL;
941 static HRESULT WINAPI VBScriptParse_ParseScriptText(IActiveScriptParse *iface,
942 LPCOLESTR pstrCode, LPCOLESTR pstrItemName, IUnknown *punkContext,
943 LPCOLESTR pstrDelimiter, CTXARG_T dwSourceContextCookie, ULONG ulStartingLine,
944 DWORD dwFlags, VARIANT *pvarResult, EXCEPINFO *pexcepinfo)
946 VBScript *This = impl_from_IActiveScriptParse(iface);
947 vbscode_t *code;
948 HRESULT hres;
950 TRACE("(%p)->(%s %s %p %s %s %u %x %p %p)\n", This, debugstr_w(pstrCode),
951 debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
952 wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLine, dwFlags, pvarResult, pexcepinfo);
954 if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
955 return E_UNEXPECTED;
957 hres = compile_script(This->ctx, pstrCode, pstrItemName, pstrDelimiter, dwSourceContextCookie,
958 ulStartingLine, dwFlags, &code);
959 if(FAILED(hres))
960 return hres;
962 if(!(dwFlags & SCRIPTTEXT_ISEXPRESSION) && !is_started(This)) {
963 code->pending_exec = TRUE;
964 return S_OK;
967 return exec_global_code(This->ctx, code, pvarResult);
970 static const IActiveScriptParseVtbl VBScriptParseVtbl = {
971 VBScriptParse_QueryInterface,
972 VBScriptParse_AddRef,
973 VBScriptParse_Release,
974 VBScriptParse_InitNew,
975 VBScriptParse_AddScriptlet,
976 VBScriptParse_ParseScriptText
979 static inline VBScript *impl_from_IActiveScriptParseProcedure2(IActiveScriptParseProcedure2 *iface)
981 return CONTAINING_RECORD(iface, VBScript, IActiveScriptParseProcedure2_iface);
984 static HRESULT WINAPI VBScriptParseProcedure_QueryInterface(IActiveScriptParseProcedure2 *iface, REFIID riid, void **ppv)
986 VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
987 return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
990 static ULONG WINAPI VBScriptParseProcedure_AddRef(IActiveScriptParseProcedure2 *iface)
992 VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
993 return IActiveScript_AddRef(&This->IActiveScript_iface);
996 static ULONG WINAPI VBScriptParseProcedure_Release(IActiveScriptParseProcedure2 *iface)
998 VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
999 return IActiveScript_Release(&This->IActiveScript_iface);
1002 static HRESULT WINAPI VBScriptParseProcedure_ParseProcedureText(IActiveScriptParseProcedure2 *iface,
1003 LPCOLESTR pstrCode, LPCOLESTR pstrFormalParams, LPCOLESTR pstrProcedureName,
1004 LPCOLESTR pstrItemName, IUnknown *punkContext, LPCOLESTR pstrDelimiter,
1005 CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags, IDispatch **ppdisp)
1007 VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
1008 class_desc_t *desc;
1009 vbdisp_t *vbdisp;
1010 HRESULT hres;
1012 TRACE("(%p)->(%s %s %s %s %p %s %s %u %x %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
1013 debugstr_w(pstrProcedureName), debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
1014 wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLineNumber, dwFlags, ppdisp);
1016 if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
1017 return E_UNEXPECTED;
1019 hres = compile_procedure(This->ctx, pstrCode, pstrItemName, pstrDelimiter, dwSourceContextCookie,
1020 ulStartingLineNumber, dwFlags, &desc);
1021 if(FAILED(hres))
1022 return hres;
1024 hres = create_vbdisp(desc, &vbdisp);
1025 if(FAILED(hres))
1026 return hres;
1028 *ppdisp = (IDispatch*)&vbdisp->IDispatchEx_iface;
1029 return S_OK;
1032 static const IActiveScriptParseProcedure2Vtbl VBScriptParseProcedureVtbl = {
1033 VBScriptParseProcedure_QueryInterface,
1034 VBScriptParseProcedure_AddRef,
1035 VBScriptParseProcedure_Release,
1036 VBScriptParseProcedure_ParseProcedureText,
1039 static inline VBScript *impl_from_IObjectSafety(IObjectSafety *iface)
1041 return CONTAINING_RECORD(iface, VBScript, IObjectSafety_iface);
1044 static HRESULT WINAPI VBScriptSafety_QueryInterface(IObjectSafety *iface, REFIID riid, void **ppv)
1046 VBScript *This = impl_from_IObjectSafety(iface);
1047 return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
1050 static ULONG WINAPI VBScriptSafety_AddRef(IObjectSafety *iface)
1052 VBScript *This = impl_from_IObjectSafety(iface);
1053 return IActiveScript_AddRef(&This->IActiveScript_iface);
1056 static ULONG WINAPI VBScriptSafety_Release(IObjectSafety *iface)
1058 VBScript *This = impl_from_IObjectSafety(iface);
1059 return IActiveScript_Release(&This->IActiveScript_iface);
1062 #define SUPPORTED_OPTIONS (INTERFACESAFE_FOR_UNTRUSTED_DATA|INTERFACE_USES_DISPEX|INTERFACE_USES_SECURITY_MANAGER)
1064 static HRESULT WINAPI VBScriptSafety_GetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
1065 DWORD *pdwSupportedOptions, DWORD *pdwEnabledOptions)
1067 VBScript *This = impl_from_IObjectSafety(iface);
1069 TRACE("(%p)->(%s %p %p)\n", This, debugstr_guid(riid), pdwSupportedOptions, pdwEnabledOptions);
1071 if(!pdwSupportedOptions || !pdwEnabledOptions)
1072 return E_POINTER;
1074 *pdwSupportedOptions = SUPPORTED_OPTIONS;
1075 *pdwEnabledOptions = This->ctx->safeopt;
1076 return S_OK;
1079 static HRESULT WINAPI VBScriptSafety_SetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
1080 DWORD dwOptionSetMask, DWORD dwEnabledOptions)
1082 VBScript *This = impl_from_IObjectSafety(iface);
1084 TRACE("(%p)->(%s %x %x)\n", This, debugstr_guid(riid), dwOptionSetMask, dwEnabledOptions);
1086 if(dwOptionSetMask & ~SUPPORTED_OPTIONS)
1087 return E_FAIL;
1089 This->ctx->safeopt = (dwEnabledOptions & dwOptionSetMask) | (This->ctx->safeopt & ~dwOptionSetMask) | INTERFACE_USES_DISPEX;
1090 return S_OK;
1093 static const IObjectSafetyVtbl VBScriptSafetyVtbl = {
1094 VBScriptSafety_QueryInterface,
1095 VBScriptSafety_AddRef,
1096 VBScriptSafety_Release,
1097 VBScriptSafety_GetInterfaceSafetyOptions,
1098 VBScriptSafety_SetInterfaceSafetyOptions
1101 HRESULT WINAPI VBScriptFactory_CreateInstance(IClassFactory *iface, IUnknown *pUnkOuter, REFIID riid, void **ppv)
1103 script_ctx_t *ctx;
1104 VBScript *ret;
1105 HRESULT hres;
1107 TRACE("(%p %s %p)\n", pUnkOuter, debugstr_guid(riid), ppv);
1109 ret = heap_alloc_zero(sizeof(*ret));
1110 if(!ret)
1111 return E_OUTOFMEMORY;
1113 ret->IActiveScript_iface.lpVtbl = &VBScriptVtbl;
1114 ret->IActiveScriptDebug_iface.lpVtbl = &VBScriptDebugVtbl;
1115 ret->IActiveScriptParse_iface.lpVtbl = &VBScriptParseVtbl;
1116 ret->IActiveScriptParseProcedure2_iface.lpVtbl = &VBScriptParseProcedureVtbl;
1117 ret->IObjectSafety_iface.lpVtbl = &VBScriptSafetyVtbl;
1119 ret->ref = 1;
1120 ret->state = SCRIPTSTATE_UNINITIALIZED;
1122 ctx = ret->ctx = heap_alloc_zero(sizeof(*ctx));
1123 if(!ctx) {
1124 heap_free(ret);
1125 return E_OUTOFMEMORY;
1128 ctx->safeopt = INTERFACE_USES_DISPEX;
1129 list_init(&ctx->objects);
1130 list_init(&ctx->code_list);
1131 list_init(&ctx->named_items);
1133 hres = init_global(ctx);
1134 if(FAILED(hres)) {
1135 IActiveScript_Release(&ret->IActiveScript_iface);
1136 return hres;
1139 hres = IActiveScript_QueryInterface(&ret->IActiveScript_iface, riid, ppv);
1140 IActiveScript_Release(&ret->IActiveScript_iface);
1141 return hres;
1144 typedef struct {
1145 IServiceProvider IServiceProvider_iface;
1147 LONG ref;
1149 IServiceProvider *sp;
1150 } AXSite;
1152 static inline AXSite *impl_from_IServiceProvider(IServiceProvider *iface)
1154 return CONTAINING_RECORD(iface, AXSite, IServiceProvider_iface);
1157 static HRESULT WINAPI AXSite_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
1159 AXSite *This = impl_from_IServiceProvider(iface);
1161 if(IsEqualGUID(&IID_IUnknown, riid)) {
1162 TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
1163 *ppv = &This->IServiceProvider_iface;
1164 }else if(IsEqualGUID(&IID_IServiceProvider, riid)) {
1165 TRACE("(%p)->(IID_IServiceProvider %p)\n", This, ppv);
1166 *ppv = &This->IServiceProvider_iface;
1167 }else {
1168 TRACE("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
1169 *ppv = NULL;
1170 return E_NOINTERFACE;
1173 IUnknown_AddRef((IUnknown*)*ppv);
1174 return S_OK;
1177 static ULONG WINAPI AXSite_AddRef(IServiceProvider *iface)
1179 AXSite *This = impl_from_IServiceProvider(iface);
1180 LONG ref = InterlockedIncrement(&This->ref);
1182 TRACE("(%p) ref=%d\n", This, ref);
1184 return ref;
1187 static ULONG WINAPI AXSite_Release(IServiceProvider *iface)
1189 AXSite *This = impl_from_IServiceProvider(iface);
1190 LONG ref = InterlockedDecrement(&This->ref);
1192 TRACE("(%p) ref=%d\n", This, ref);
1194 if(!ref)
1195 heap_free(This);
1197 return ref;
1200 static HRESULT WINAPI AXSite_QueryService(IServiceProvider *iface,
1201 REFGUID guidService, REFIID riid, void **ppv)
1203 AXSite *This = impl_from_IServiceProvider(iface);
1205 TRACE("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
1207 return IServiceProvider_QueryService(This->sp, guidService, riid, ppv);
1210 static IServiceProviderVtbl AXSiteVtbl = {
1211 AXSite_QueryInterface,
1212 AXSite_AddRef,
1213 AXSite_Release,
1214 AXSite_QueryService
1217 IUnknown *create_ax_site(script_ctx_t *ctx)
1219 IServiceProvider *sp;
1220 AXSite *ret;
1221 HRESULT hres;
1223 hres = IActiveScriptSite_QueryInterface(ctx->site, &IID_IServiceProvider, (void**)&sp);
1224 if(FAILED(hres)) {
1225 ERR("Could not get IServiceProvider iface: %08x\n", hres);
1226 return NULL;
1229 ret = heap_alloc(sizeof(*ret));
1230 if(!ret) {
1231 IServiceProvider_Release(sp);
1232 return NULL;
1235 ret->IServiceProvider_iface.lpVtbl = &AXSiteVtbl;
1236 ret->ref = 1;
1237 ret->sp = sp;
1239 return (IUnknown*)&ret->IServiceProvider_iface;