dlls/vbscript/vbscript.c

   1 /*
   2  * Copyright 2011 Jacek Caban for CodeWeavers
   3  *
   4  * This library is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU Lesser General Public
   6  * License as published by the Free Software Foundation; either
   7  * version 2.1 of the License, or (at your option) any later version.
   8  *
   9  * This library is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * Lesser General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU Lesser General Public
  15  * License along with this library; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17  */
  18
  19
  20 #include <assert.h>
  21
  22 #include "vbscript.h"
  23 #include "objsafe.h"
  24
  25 #include "wine/debug.h"
  26
  27 WINE_DEFAULT_DEBUG_CHANNEL(vbscript);
  28
  29 #ifdef _WIN64
  30
  31 #define CTXARG_T DWORDLONG
  32 #define IActiveScriptDebugVtbl IActiveScriptDebug64Vtbl
  33 #define IActiveScriptParseVtbl IActiveScriptParse64Vtbl
  34 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_64Vtbl
  35
  36 #else
  37
  38 #define CTXARG_T DWORD
  39 #define IActiveScriptDebugVtbl IActiveScriptDebug32Vtbl
  40 #define IActiveScriptParseVtbl IActiveScriptParse32Vtbl
  41 #define IActiveScriptParseProcedure2Vtbl IActiveScriptParseProcedure2_32Vtbl
  42
  43 #endif
  44
  45 struct VBScript {
  46     IActiveScript IActiveScript_iface;
  47     IActiveScriptDebug IActiveScriptDebug_iface;
  48     IActiveScriptParse IActiveScriptParse_iface;
  49     IActiveScriptParseProcedure2 IActiveScriptParseProcedure2_iface;
  50     IObjectSafety IObjectSafety_iface;
  51
  52     LONG ref;
  53
  54     SCRIPTSTATE state;
  55     script_ctx_t *ctx;
  56     LONG thread_id;
  57     BOOL is_initialized;
  58 };
  59
  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;
  68
  69 static inline WCHAR *heap_pool_strdup(heap_pool_t *heap, const WCHAR *str)
  70 {
  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;
  75 }
  76
  77 static void change_state(VBScript *This, SCRIPTSTATE state)
  78 {
  79     if(This->state == state)
  80         return;
  81
  82     This->state = state;
  83     if(This->ctx->site)
  84         IActiveScriptSite_OnStateChange(This->ctx->site, state);
  85 }
  86
  87 static inline BOOL is_started(VBScript *This)
  88 {
  89     return This->state == SCRIPTSTATE_STARTED
  90         || This->state == SCRIPTSTATE_CONNECTED
  91         || This->state == SCRIPTSTATE_DISCONNECTED;
  92 }
  93
  94 static HRESULT exec_global_code(script_ctx_t *ctx, vbscode_t *code, VARIANT *res)
  95 {
  96     ScriptDisp *obj = ctx->script_obj;
  97     function_t *func_iter, **new_funcs;
  98     dynamic_var_t *var, **new_vars;
  99     IServiceProvider *prev_caller;
 100     size_t cnt, i;
 101     HRESULT hres;
 102
 103     if(code->named_item) {
 104         if(!code->named_item->script_obj) {
 105             hres = create_script_disp(ctx, &code->named_item->script_obj);
 106             if(FAILED(hres)) return hres;
 107         }
 108         obj = code->named_item->script_obj;
 109     }
 110
 111     cnt = obj->global_vars_cnt + code->main_code.var_cnt;
 112     if (cnt > obj->global_vars_size)
 113     {
 114         if (obj->global_vars)
 115             new_vars = realloc(obj->global_vars, cnt * sizeof(*new_vars));
 116         else
 117             new_vars = malloc(cnt * sizeof(*new_vars));
 118         if (!new_vars)
 119             return E_OUTOFMEMORY;
 120         obj->global_vars = new_vars;
 121         obj->global_vars_size = cnt;
 122     }
 123
 124     cnt = obj->global_funcs_cnt;
 125     for (func_iter = code->funcs; func_iter; func_iter = func_iter->next)
 126         cnt++;
 127     if (cnt > obj->global_funcs_size)
 128     {
 129         if (obj->global_funcs)
 130             new_funcs = realloc(obj->global_funcs, cnt * sizeof(*new_funcs));
 131         else
 132             new_funcs = malloc(cnt * sizeof(*new_funcs));
 133         if (!new_funcs)
 134             return E_OUTOFMEMORY;
 135         obj->global_funcs = new_funcs;
 136         obj->global_funcs_size = cnt;
 137     }
 138
 139     for (i = 0; i < code->main_code.var_cnt; i++)
 140     {
 141         if (!(var = heap_pool_alloc(&obj->heap, sizeof(*var))))
 142             return E_OUTOFMEMORY;
 143
 144         var->name = heap_pool_strdup(&obj->heap, code->main_code.vars[i].name);
 145         if (!var->name)
 146             return E_OUTOFMEMORY;
 147         V_VT(&var->v) = VT_EMPTY;
 148         var->is_const = FALSE;
 149         var->array = NULL;
 150
 151         obj->global_vars[obj->global_vars_cnt + i] = var;
 152     }
 153
 154     obj->global_vars_cnt += code->main_code.var_cnt;
 155
 156     for (func_iter = code->funcs; func_iter; func_iter = func_iter->next)
 157     {
 158         for (i = 0; i < obj->global_funcs_cnt; i++)
 159         {
 160             if (!wcsicmp(obj->global_funcs[i]->name, func_iter->name))
 161             {
 162                 /* global function already exists, replace it */
 163                 obj->global_funcs[i] = func_iter;
 164                 break;
 165             }
 166         }
 167         if (i == obj->global_funcs_cnt)
 168             obj->global_funcs[obj->global_funcs_cnt++] = func_iter;
 169     }
 170
 171     if (code->classes)
 172     {
 173         class_desc_t *class = code->classes;
 174
 175         while (1)
 176         {
 177             class->ctx = ctx;
 178             if (!class->next)
 179                 break;
 180             class = class->next;
 181         }
 182
 183         class->next = obj->classes;
 184         obj->classes = code->classes;
 185         code->last_class = class;
 186     }
 187
 188     code->pending_exec = FALSE;
 189
 190     prev_caller = ctx->vbcaller->caller;
 191     ctx->vbcaller->caller = SP_CALLER_UNINITIALIZED;
 192     hres = exec_script(ctx, TRUE, &code->main_code, NULL, NULL, res);
 193     ctx->vbcaller->caller = prev_caller;
 194     return hres;
 195 }
 196
 197 static void exec_queued_code(script_ctx_t *ctx)
 198 {
 199     vbscode_t *iter;
 200
 201     LIST_FOR_EACH_ENTRY(iter, &ctx->code_list, vbscode_t, entry) {
 202         if(iter->pending_exec)
 203             exec_global_code(ctx, iter, NULL);
 204     }
 205 }
 206
 207 static HRESULT retrieve_named_item_disp(IActiveScriptSite *site, named_item_t *item)
 208 {
 209     IUnknown *unk;
 210     HRESULT hres;
 211
 212     hres = IActiveScriptSite_GetItemInfo(site, item->name, SCRIPTINFO_IUNKNOWN, &unk, NULL);
 213     if(FAILED(hres)) {
 214         WARN("GetItemInfo failed: %08lx\n", hres);
 215         return hres;
 216     }
 217
 218     hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&item->disp);
 219     IUnknown_Release(unk);
 220     if(FAILED(hres)) {
 221         WARN("object does not implement IDispatch\n");
 222         return hres;
 223     }
 224
 225     return S_OK;
 226 }
 227
 228 named_item_t *lookup_named_item(script_ctx_t *ctx, const WCHAR *name, unsigned flags)
 229 {
 230     named_item_t *item;
 231     HRESULT hres;
 232
 233     LIST_FOR_EACH_ENTRY(item, &ctx->named_items, named_item_t, entry) {
 234         if((item->flags & flags) == flags && !wcsicmp(item->name, name)) {
 235             if(!item->script_obj && !(item->flags & SCRIPTITEM_GLOBALMEMBERS)) {
 236                 hres = create_script_disp(ctx, &item->script_obj);
 237                 if(FAILED(hres)) return NULL;
 238             }
 239
 240             if(!item->disp && (flags || !(item->flags & SCRIPTITEM_CODEONLY))) {
 241                 hres = retrieve_named_item_disp(ctx->site, item);
 242                 if(FAILED(hres)) continue;
 243             }
 244
 245             return item;
 246         }
 247     }
 248
 249     return NULL;
 250 }
 251
 252 static void release_named_item_script_obj(named_item_t *item)
 253 {
 254     if(!item->script_obj) return;
 255
 256     item->script_obj->ctx = NULL;
 257     IDispatchEx_Release(&item->script_obj->IDispatchEx_iface);
 258     item->script_obj = NULL;
 259 }
 260
 261 void release_named_item(named_item_t *item)
 262 {
 263     if(--item->ref) return;
 264
 265     free(item->name);
 266     free(item);
 267 }
 268
 269 static void release_script(script_ctx_t *ctx)
 270 {
 271     named_item_t *item, *item_next;
 272     vbscode_t *code, *code_next;
 273
 274     collect_objects(ctx);
 275     clear_ei(&ctx->ei);
 276
 277     LIST_FOR_EACH_ENTRY_SAFE(code, code_next, &ctx->code_list, vbscode_t, entry)
 278     {
 279         if(code->is_persistent)
 280         {
 281             code->pending_exec = TRUE;
 282             if(code->last_class) code->last_class->next = NULL;
 283             if(code->named_item) release_named_item_script_obj(code->named_item);
 284         }
 285         else
 286         {
 287             list_remove(&code->entry);
 288             release_vbscode(code);
 289         }
 290     }
 291
 292     LIST_FOR_EACH_ENTRY_SAFE(item, item_next, &ctx->named_items, named_item_t, entry)
 293     {
 294         if(item->disp)
 295         {
 296             IDispatch_Release(item->disp);
 297             item->disp = NULL;
 298         }
 299         release_named_item_script_obj(item);
 300         if(!(item->flags & SCRIPTITEM_ISPERSISTENT))
 301         {
 302             list_remove(&item->entry);
 303             release_named_item(item);
 304         }
 305     }
 306
 307     if(ctx->secmgr) {
 308         IInternetHostSecurityManager_Release(ctx->secmgr);
 309         ctx->secmgr = NULL;
 310     }
 311
 312     if(ctx->site) {
 313         IActiveScriptSite_Release(ctx->site);
 314         ctx->site = NULL;
 315     }
 316
 317     if(ctx->script_obj) {
 318         ScriptDisp *script_obj = ctx->script_obj;
 319
 320         ctx->script_obj = NULL;
 321         script_obj->ctx = NULL;
 322         IDispatchEx_Release(&script_obj->IDispatchEx_iface);
 323     }
 324 }
 325
 326 static void release_code_list(script_ctx_t *ctx)
 327 {
 328     while(!list_empty(&ctx->code_list)) {
 329         vbscode_t *iter = LIST_ENTRY(list_head(&ctx->code_list), vbscode_t, entry);
 330
 331         list_remove(&iter->entry);
 332         release_vbscode(iter);
 333     }
 334 }
 335
 336 static void release_named_item_list(script_ctx_t *ctx)
 337 {
 338     while(!list_empty(&ctx->named_items)) {
 339         named_item_t *iter = LIST_ENTRY(list_head(&ctx->named_items), named_item_t, entry);
 340         list_remove(&iter->entry);
 341         release_named_item(iter);
 342     }
 343 }
 344
 345 static void decrease_state(VBScript *This, SCRIPTSTATE state)
 346 {
 347     switch(This->state) {
 348     case SCRIPTSTATE_CONNECTED:
 349         change_state(This, SCRIPTSTATE_DISCONNECTED);
 350         if(state == SCRIPTSTATE_DISCONNECTED)
 351             return;
 352         /* FALLTHROUGH */
 353     case SCRIPTSTATE_STARTED:
 354     case SCRIPTSTATE_DISCONNECTED:
 355         change_state(This, SCRIPTSTATE_INITIALIZED);
 356         /* FALLTHROUGH */
 357     case SCRIPTSTATE_INITIALIZED:
 358     case SCRIPTSTATE_UNINITIALIZED:
 359         change_state(This, state);
 360         if(state == SCRIPTSTATE_INITIALIZED)
 361             break;
 362         release_script(This->ctx);
 363         This->thread_id = 0;
 364         if(state == SCRIPTSTATE_CLOSED) {
 365             release_code_list(This->ctx);
 366             release_named_item_list(This->ctx);
 367         }
 368         break;
 369     case SCRIPTSTATE_CLOSED:
 370         break;
 371     DEFAULT_UNREACHABLE;
 372     }
 373 }
 374
 375 static inline struct vbcaller *vbcaller_from_IServiceProvider(IServiceProvider *iface)
 376 {
 377     return CONTAINING_RECORD(iface, struct vbcaller, IServiceProvider_iface);
 378 }
 379
 380 static HRESULT WINAPI vbcaller_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
 381 {
 382     struct vbcaller *This = vbcaller_from_IServiceProvider(iface);
 383
 384     if(IsEqualGUID(&IID_IUnknown, riid) || IsEqualGUID(&IID_IServiceProvider, riid)) {
 385         *ppv = &This->IServiceProvider_iface;
 386     }else {
 387         WARN("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
 388         *ppv = NULL;
 389         return E_NOINTERFACE;
 390     }
 391
 392     IUnknown_AddRef((IUnknown*)*ppv);
 393     return S_OK;
 394 }
 395
 396 static ULONG WINAPI vbcaller_AddRef(IServiceProvider *iface)
 397 {
 398     struct vbcaller *This = vbcaller_from_IServiceProvider(iface);
 399     LONG ref = InterlockedIncrement(&This->ref);
 400
 401     TRACE("(%p) ref=%ld\n", This, ref);
 402
 403     return ref;
 404 }
 405
 406 static ULONG WINAPI vbcaller_Release(IServiceProvider *iface)
 407 {
 408     struct vbcaller *This = vbcaller_from_IServiceProvider(iface);
 409     LONG ref = InterlockedDecrement(&This->ref);
 410
 411     TRACE("(%p) ref=%ld\n", This, ref);
 412
 413     if(!ref)
 414         free(This);
 415
 416     return ref;
 417 }
 418
 419 static HRESULT WINAPI vbcaller_QueryService(IServiceProvider *iface, REFGUID guidService,
 420         REFIID riid, void **ppv)
 421 {
 422     struct vbcaller *This = vbcaller_from_IServiceProvider(iface);
 423
 424     if(IsEqualGUID(guidService, &SID_GetCaller)) {
 425         TRACE("(%p)->(SID_GetCaller)\n", This);
 426         *ppv = NULL;
 427         if(!This->caller)
 428             return S_OK;
 429         return (This->caller == SP_CALLER_UNINITIALIZED) ? E_NOINTERFACE : IServiceProvider_QueryInterface(This->caller, riid, ppv);
 430     }
 431
 432     FIXME("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
 433
 434     *ppv = NULL;
 435     return E_NOINTERFACE;
 436 }
 437
 438 static const IServiceProviderVtbl ServiceProviderVtbl = {
 439     vbcaller_QueryInterface,
 440     vbcaller_AddRef,
 441     vbcaller_Release,
 442     vbcaller_QueryService
 443 };
 444
 445 static struct vbcaller *create_vbcaller(void)
 446 {
 447     struct vbcaller *ret;
 448
 449     ret = malloc(sizeof(*ret));
 450     if(ret) {
 451         ret->IServiceProvider_iface.lpVtbl = &ServiceProviderVtbl;
 452         ret->ref = 1;
 453         ret->caller = SP_CALLER_UNINITIALIZED;
 454     }
 455     return ret;
 456 }
 457
 458 static inline VBScriptError *impl_from_IActiveScriptError(IActiveScriptError *iface)
 459 {
 460     return CONTAINING_RECORD(iface, VBScriptError, IActiveScriptError_iface);
 461 }
 462
 463 static HRESULT WINAPI VBScriptError_QueryInterface(IActiveScriptError *iface, REFIID riid, void **ppv)
 464 {
 465     VBScriptError *This = impl_from_IActiveScriptError(iface);
 466
 467     if(IsEqualGUID(riid, &IID_IUnknown)) {
 468         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
 469         *ppv = &This->IActiveScriptError_iface;
 470     }else if(IsEqualGUID(riid, &IID_IActiveScriptError)) {
 471         TRACE("(%p)->(IID_IActiveScriptError %p)\n", This, ppv);
 472         *ppv = &This->IActiveScriptError_iface;
 473     }else {
 474         FIXME("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
 475         *ppv = NULL;
 476         return E_NOINTERFACE;
 477     }
 478
 479     IUnknown_AddRef((IUnknown*)*ppv);
 480     return S_OK;
 481 }
 482
 483 static ULONG WINAPI VBScriptError_AddRef(IActiveScriptError *iface)
 484 {
 485     VBScriptError *This = impl_from_IActiveScriptError(iface);
 486     LONG ref = InterlockedIncrement(&This->ref);
 487
 488     TRACE("(%p) ref=%ld\n", This, ref);
 489
 490     return ref;
 491 }
 492
 493 static ULONG WINAPI VBScriptError_Release(IActiveScriptError *iface)
 494 {
 495     VBScriptError *This = impl_from_IActiveScriptError(iface);
 496     LONG ref = InterlockedDecrement(&This->ref);
 497
 498     TRACE("(%p) ref=%ld\n", This, ref);
 499
 500     if(!ref)
 501         free(This);
 502
 503     return ref;
 504 }
 505
 506 static HRESULT WINAPI VBScriptError_GetExceptionInfo(IActiveScriptError *iface, EXCEPINFO *excepinfo)
 507 {
 508     VBScriptError *This = impl_from_IActiveScriptError(iface);
 509
 510     TRACE("(%p)->(%p)\n", This, excepinfo);
 511
 512     *excepinfo = This->ei;
 513     excepinfo->bstrSource = SysAllocString(This->ei.bstrSource);
 514     excepinfo->bstrDescription = SysAllocString(This->ei.bstrDescription);
 515     excepinfo->bstrHelpFile = SysAllocString(This->ei.bstrHelpFile);
 516     return S_OK;
 517 }
 518
 519 static HRESULT WINAPI VBScriptError_GetSourcePosition(IActiveScriptError *iface, DWORD *source_context, ULONG *line, LONG *character)
 520 {
 521     VBScriptError *This = impl_from_IActiveScriptError(iface);
 522
 523     TRACE("(%p)->(%p %p %p)\n", This, source_context, line, character);
 524
 525     if(source_context)
 526         *source_context = This->cookie;
 527     if(line)
 528         *line = This->line;
 529     if(character)
 530         *character = This->character;
 531     return S_OK;
 532 }
 533
 534 static HRESULT WINAPI VBScriptError_GetSourceLineText(IActiveScriptError *iface, BSTR *source)
 535 {
 536     VBScriptError *This = impl_from_IActiveScriptError(iface);
 537     FIXME("(%p)->(%p)\n", This, source);
 538     return E_NOTIMPL;
 539 }
 540
 541 static const IActiveScriptErrorVtbl VBScriptErrorVtbl = {
 542     VBScriptError_QueryInterface,
 543     VBScriptError_AddRef,
 544     VBScriptError_Release,
 545     VBScriptError_GetExceptionInfo,
 546     VBScriptError_GetSourcePosition,
 547     VBScriptError_GetSourceLineText
 548 };
 549
 550 HRESULT report_script_error(script_ctx_t *ctx, const vbscode_t *code, unsigned loc)
 551 {
 552     VBScriptError *error;
 553     const WCHAR *p, *nl;
 554     HRESULT hres, result;
 555
 556     if(!(error = malloc(sizeof(*error))))
 557         return E_OUTOFMEMORY;
 558     error->IActiveScriptError_iface.lpVtbl = &VBScriptErrorVtbl;
 559
 560     error->ref = 1;
 561     error->ei = ctx->ei;
 562     memset(&ctx->ei, 0, sizeof(ctx->ei));
 563     result = error->ei.scode;
 564
 565     p = code->source;
 566     error->cookie = code->cookie;
 567     error->line = code->start_line;
 568     for(nl = p = code->source; p < code->source + loc; p++) {
 569         if(*p != '\n') continue;
 570         error->line++;
 571         nl = p + 1;
 572     }
 573     error->character = code->source + loc - nl;
 574
 575     hres = IActiveScriptSite_OnScriptError(ctx->site, &error->IActiveScriptError_iface);
 576     IActiveScriptError_Release(&error->IActiveScriptError_iface);
 577     return hres == S_OK ? SCRIPT_E_REPORTED : result;
 578 }
 579
 580 static inline VBScript *impl_from_IActiveScript(IActiveScript *iface)
 581 {
 582     return CONTAINING_RECORD(iface, VBScript, IActiveScript_iface);
 583 }
 584
 585 static HRESULT WINAPI VBScript_QueryInterface(IActiveScript *iface, REFIID riid, void **ppv)
 586 {
 587     VBScript *This = impl_from_IActiveScript(iface);
 588
 589     if(IsEqualGUID(riid, &IID_IUnknown)) {
 590         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
 591         *ppv = &This->IActiveScript_iface;
 592     }else if(IsEqualGUID(riid, &IID_IActiveScript)) {
 593         TRACE("(%p)->(IID_IActiveScript %p)\n", This, ppv);
 594         *ppv = &This->IActiveScript_iface;
 595     }else if(IsEqualGUID(riid, &IID_IActiveScriptDebug)) {
 596         TRACE("(%p)->(IID_IActiveScriptDebug %p)\n", This, ppv);
 597         *ppv = &This->IActiveScriptDebug_iface;
 598     }else if(IsEqualGUID(riid, &IID_IActiveScriptParse)) {
 599         TRACE("(%p)->(IID_IActiveScriptParse %p)\n", This, ppv);
 600         *ppv = &This->IActiveScriptParse_iface;
 601     }else if(IsEqualGUID(riid, &IID_IActiveScriptParseProcedure2)) {
 602         TRACE("(%p)->(IID_IActiveScriptParseProcedure2 %p)\n", This, ppv);
 603         *ppv = &This->IActiveScriptParseProcedure2_iface;
 604     }else if(IsEqualGUID(riid, &IID_IObjectSafety)) {
 605         TRACE("(%p)->(IID_IObjectSafety %p)\n", This, ppv);
 606         *ppv = &This->IObjectSafety_iface;
 607     }else {
 608         WARN("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
 609         *ppv = NULL;
 610         return E_NOINTERFACE;
 611     }
 612
 613     IUnknown_AddRef((IUnknown*)*ppv);
 614     return S_OK;
 615 }
 616
 617 static ULONG WINAPI VBScript_AddRef(IActiveScript *iface)
 618 {
 619     VBScript *This = impl_from_IActiveScript(iface);
 620     LONG ref = InterlockedIncrement(&This->ref);
 621
 622     TRACE("(%p) ref=%ld\n", This, ref);
 623
 624     return ref;
 625 }
 626
 627 static ULONG WINAPI VBScript_Release(IActiveScript *iface)
 628 {
 629     VBScript *This = impl_from_IActiveScript(iface);
 630     LONG ref = InterlockedDecrement(&This->ref);
 631
 632     TRACE("(%p) ref=%ld\n", iface, ref);
 633
 634     if(!ref) {
 635         decrease_state(This, SCRIPTSTATE_CLOSED);
 636         detach_global_objects(This->ctx);
 637         IServiceProvider_Release(&This->ctx->vbcaller->IServiceProvider_iface);
 638         free(This->ctx);
 639         free(This);
 640     }
 641
 642     return ref;
 643 }
 644
 645 static HRESULT WINAPI VBScript_SetScriptSite(IActiveScript *iface, IActiveScriptSite *pass)
 646 {
 647     VBScript *This = impl_from_IActiveScript(iface);
 648     LCID lcid = LOCALE_USER_DEFAULT;
 649     named_item_t *item;
 650     HRESULT hres;
 651
 652     TRACE("(%p)->(%p)\n", This, pass);
 653
 654     if(!pass)
 655         return E_POINTER;
 656
 657     if(This->ctx->site)
 658         return E_UNEXPECTED;
 659
 660     if(InterlockedCompareExchange(&This->thread_id, GetCurrentThreadId(), 0))
 661         return E_UNEXPECTED;
 662
 663     /* Retrieve new dispatches for persistent named items */
 664     LIST_FOR_EACH_ENTRY(item, &This->ctx->named_items, named_item_t, entry)
 665     {
 666         if(!item->disp)
 667         {
 668             hres = retrieve_named_item_disp(pass, item);
 669             if(FAILED(hres)) return hres;
 670         }
 671
 672         /* For some reason, CODEONLY flag is lost in re-initialized scripts */
 673         item->flags &= ~SCRIPTITEM_CODEONLY;
 674     }
 675
 676     hres = create_script_disp(This->ctx, &This->ctx->script_obj);
 677     if(FAILED(hres))
 678         return hres;
 679
 680     This->ctx->site = pass;
 681     IActiveScriptSite_AddRef(This->ctx->site);
 682
 683     IActiveScriptSite_GetLCID(This->ctx->site, &lcid);
 684     This->ctx->lcid = IsValidLocale(lcid, 0) ? lcid : GetUserDefaultLCID();
 685     GetLocaleInfoW(lcid, LOCALE_IDEFAULTANSICODEPAGE | LOCALE_RETURN_NUMBER, (WCHAR *)&This->ctx->codepage,
 686             sizeof(This->ctx->codepage)/sizeof(WCHAR));
 687     if (!This->ctx->codepage)
 688         This->ctx->codepage = CP_UTF8;
 689
 690     if(This->is_initialized)
 691         change_state(This, SCRIPTSTATE_INITIALIZED);
 692     return S_OK;
 693 }
 694
 695 static HRESULT WINAPI VBScript_GetScriptSite(IActiveScript *iface, REFIID riid,
 696                                             void **ppvObject)
 697 {
 698     VBScript *This = impl_from_IActiveScript(iface);
 699     FIXME("(%p)->()\n", This);
 700     return E_NOTIMPL;
 701 }
 702
 703 static HRESULT WINAPI VBScript_SetScriptState(IActiveScript *iface, SCRIPTSTATE ss)
 704 {
 705     VBScript *This = impl_from_IActiveScript(iface);
 706
 707     TRACE("(%p)->(%d)\n", This, ss);
 708
 709     if(This->thread_id && GetCurrentThreadId() != This->thread_id)
 710         return E_UNEXPECTED;
 711
 712     if(ss == SCRIPTSTATE_UNINITIALIZED) {
 713         if(This->state == SCRIPTSTATE_CLOSED)
 714             return E_UNEXPECTED;
 715
 716         decrease_state(This, SCRIPTSTATE_UNINITIALIZED);
 717         return S_OK;
 718     }
 719
 720     if(!This->is_initialized || (!This->ctx->site && ss != SCRIPTSTATE_CLOSED))
 721         return E_UNEXPECTED;
 722
 723     switch(ss) {
 724     case SCRIPTSTATE_STARTED:
 725     case SCRIPTSTATE_CONNECTED: /* FIXME */
 726         if(This->state == SCRIPTSTATE_CLOSED)
 727             return E_UNEXPECTED;
 728
 729         exec_queued_code(This->ctx);
 730         break;
 731     case SCRIPTSTATE_INITIALIZED:
 732         decrease_state(This, SCRIPTSTATE_INITIALIZED);
 733         return S_OK;
 734     case SCRIPTSTATE_CLOSED:
 735         decrease_state(This, SCRIPTSTATE_CLOSED);
 736         return S_OK;
 737     case SCRIPTSTATE_DISCONNECTED:
 738         FIXME("unimplemented SCRIPTSTATE_DISCONNECTED\n");
 739         return S_OK;
 740     default:
 741         FIXME("unimplemented state %d\n", ss);
 742         return E_NOTIMPL;
 743     }
 744
 745     change_state(This, ss);
 746     return S_OK;
 747 }
 748
 749 static HRESULT WINAPI VBScript_GetScriptState(IActiveScript *iface, SCRIPTSTATE *pssState)
 750 {
 751     VBScript *This = impl_from_IActiveScript(iface);
 752
 753     TRACE("(%p)->(%p)\n", This, pssState);
 754
 755     if(!pssState)
 756         return E_POINTER;
 757
 758     if(This->thread_id && This->thread_id != GetCurrentThreadId())
 759         return E_UNEXPECTED;
 760
 761     *pssState = This->state;
 762     return S_OK;
 763 }
 764
 765 static HRESULT WINAPI VBScript_Close(IActiveScript *iface)
 766 {
 767     VBScript *This = impl_from_IActiveScript(iface);
 768
 769     TRACE("(%p)->()\n", This);
 770
 771     if(This->thread_id && This->thread_id != GetCurrentThreadId())
 772         return E_UNEXPECTED;
 773
 774     decrease_state(This, SCRIPTSTATE_CLOSED);
 775     return S_OK;
 776 }
 777
 778 static HRESULT WINAPI VBScript_AddNamedItem(IActiveScript *iface, LPCOLESTR pstrName, DWORD dwFlags)
 779 {
 780     VBScript *This = impl_from_IActiveScript(iface);
 781     named_item_t *item;
 782     IDispatch *disp = NULL;
 783     HRESULT hres;
 784
 785     TRACE("(%p)->(%s %lx)\n", This, debugstr_w(pstrName), dwFlags);
 786
 787     if(This->thread_id != GetCurrentThreadId() || !This->ctx->site)
 788         return E_UNEXPECTED;
 789
 790     if(dwFlags & SCRIPTITEM_GLOBALMEMBERS) {
 791         IUnknown *unk;
 792
 793         hres = IActiveScriptSite_GetItemInfo(This->ctx->site, pstrName, SCRIPTINFO_IUNKNOWN, &unk, NULL);
 794         if(FAILED(hres)) {
 795             WARN("GetItemInfo failed: %08lx\n", hres);
 796             return hres;
 797         }
 798
 799         hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&disp);
 800         IUnknown_Release(unk);
 801         if(FAILED(hres)) {
 802             WARN("object does not implement IDispatch\n");
 803             return hres;
 804         }
 805     }
 806
 807     item = malloc(sizeof(*item));
 808     if(!item) {
 809         if(disp)
 810             IDispatch_Release(disp);
 811         return E_OUTOFMEMORY;
 812     }
 813
 814     item->ref = 1;
 815     item->disp = disp;
 816     item->flags = dwFlags;
 817     item->script_obj = NULL;
 818     item->name = wcsdup(pstrName);
 819     if(!item->name) {
 820         if(disp)
 821             IDispatch_Release(disp);
 822         free(item);
 823         return E_OUTOFMEMORY;
 824     }
 825
 826     list_add_tail(&This->ctx->named_items, &item->entry);
 827     return S_OK;
 828 }
 829
 830 static HRESULT WINAPI VBScript_AddTypeLib(IActiveScript *iface, REFGUID rguidTypeLib,
 831         DWORD dwMajor, DWORD dwMinor, DWORD dwFlags)
 832 {
 833     VBScript *This = impl_from_IActiveScript(iface);
 834     FIXME("(%p)->(%s %ld %ld %ld)\n", This, debugstr_guid(rguidTypeLib), dwMajor, dwMinor, dwFlags);
 835     return E_NOTIMPL;
 836 }
 837
 838 static HRESULT WINAPI VBScript_GetScriptDispatch(IActiveScript *iface, LPCOLESTR pstrItemName, IDispatch **ppdisp)
 839 {
 840     VBScript *This = impl_from_IActiveScript(iface);
 841     ScriptDisp *script_obj;
 842
 843     TRACE("(%p)->(%s %p)\n", This, debugstr_w(pstrItemName), ppdisp);
 844
 845     if(!ppdisp)
 846         return E_POINTER;
 847
 848     if(This->thread_id != GetCurrentThreadId() || !This->ctx->script_obj) {
 849         *ppdisp = NULL;
 850         return E_UNEXPECTED;
 851     }
 852
 853     script_obj = This->ctx->script_obj;
 854     if(pstrItemName) {
 855         named_item_t *item = lookup_named_item(This->ctx, pstrItemName, 0);
 856         if(!item) return E_INVALIDARG;
 857         if(item->script_obj) script_obj = item->script_obj;
 858     }
 859
 860     *ppdisp = (IDispatch*)&script_obj->IDispatchEx_iface;
 861     IDispatch_AddRef(*ppdisp);
 862     return S_OK;
 863 }
 864
 865 static HRESULT WINAPI VBScript_GetCurrentScriptThreadID(IActiveScript *iface,
 866                                                        SCRIPTTHREADID *pstridThread)
 867 {
 868     VBScript *This = impl_from_IActiveScript(iface);
 869     FIXME("(%p)->()\n", This);
 870     return E_NOTIMPL;
 871 }
 872
 873 static HRESULT WINAPI VBScript_GetScriptThreadID(IActiveScript *iface,
 874                                                 DWORD dwWin32ThreadId, SCRIPTTHREADID *pstidThread)
 875 {
 876     VBScript *This = impl_from_IActiveScript(iface);
 877     FIXME("(%p)->()\n", This);
 878     return E_NOTIMPL;
 879 }
 880
 881 static HRESULT WINAPI VBScript_GetScriptThreadState(IActiveScript *iface,
 882         SCRIPTTHREADID stidThread, SCRIPTTHREADSTATE *pstsState)
 883 {
 884     VBScript *This = impl_from_IActiveScript(iface);
 885     FIXME("(%p)->()\n", This);
 886     return E_NOTIMPL;
 887 }
 888
 889 static HRESULT WINAPI VBScript_InterruptScriptThread(IActiveScript *iface,
 890         SCRIPTTHREADID stidThread, const EXCEPINFO *pexcepinfo, DWORD dwFlags)
 891 {
 892     VBScript *This = impl_from_IActiveScript(iface);
 893     FIXME("(%p)->()\n", This);
 894     return E_NOTIMPL;
 895 }
 896
 897 static HRESULT WINAPI VBScript_Clone(IActiveScript *iface, IActiveScript **ppscript)
 898 {
 899     VBScript *This = impl_from_IActiveScript(iface);
 900     FIXME("(%p)->()\n", This);
 901     return E_NOTIMPL;
 902 }
 903
 904 static const IActiveScriptVtbl VBScriptVtbl = {
 905     VBScript_QueryInterface,
 906     VBScript_AddRef,
 907     VBScript_Release,
 908     VBScript_SetScriptSite,
 909     VBScript_GetScriptSite,
 910     VBScript_SetScriptState,
 911     VBScript_GetScriptState,
 912     VBScript_Close,
 913     VBScript_AddNamedItem,
 914     VBScript_AddTypeLib,
 915     VBScript_GetScriptDispatch,
 916     VBScript_GetCurrentScriptThreadID,
 917     VBScript_GetScriptThreadID,
 918     VBScript_GetScriptThreadState,
 919     VBScript_InterruptScriptThread,
 920     VBScript_Clone
 921 };
 922
 923 static inline VBScript *impl_from_IActiveScriptDebug(IActiveScriptDebug *iface)
 924 {
 925     return CONTAINING_RECORD(iface, VBScript, IActiveScriptDebug_iface);
 926 }
 927
 928 static HRESULT WINAPI VBScriptDebug_QueryInterface(IActiveScriptDebug *iface, REFIID riid, void **ppv)
 929 {
 930     VBScript *This = impl_from_IActiveScriptDebug(iface);
 931     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
 932 }
 933
 934 static ULONG WINAPI VBScriptDebug_AddRef(IActiveScriptDebug *iface)
 935 {
 936     VBScript *This = impl_from_IActiveScriptDebug(iface);
 937     return IActiveScript_AddRef(&This->IActiveScript_iface);
 938 }
 939
 940 static ULONG WINAPI VBScriptDebug_Release(IActiveScriptDebug *iface)
 941 {
 942     VBScript *This = impl_from_IActiveScriptDebug(iface);
 943     return IActiveScript_Release(&This->IActiveScript_iface);
 944 }
 945
 946 static HRESULT WINAPI VBScriptDebug_GetScriptTextAttributes(IActiveScriptDebug *iface,
 947         LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
 948 {
 949     VBScript *This = impl_from_IActiveScriptDebug(iface);
 950     FIXME("(%p)->(%s %lu %s %#lx %p)\n", This, debugstr_w(code), len,
 951           debugstr_w(delimiter), flags, attr);
 952     return E_NOTIMPL;
 953 }
 954
 955 static HRESULT WINAPI VBScriptDebug_GetScriptletTextAttributes(IActiveScriptDebug *iface,
 956         LPCOLESTR code, ULONG len, LPCOLESTR delimiter, DWORD flags, SOURCE_TEXT_ATTR *attr)
 957 {
 958     VBScript *This = impl_from_IActiveScriptDebug(iface);
 959     FIXME("(%p)->(%s %lu %s %#lx %p)\n", This, debugstr_w(code), len,
 960           debugstr_w(delimiter), flags, attr);
 961     return E_NOTIMPL;
 962 }
 963
 964 static HRESULT WINAPI VBScriptDebug_EnumCodeContextsOfPosition(IActiveScriptDebug *iface,
 965         CTXARG_T source, ULONG offset, ULONG len, IEnumDebugCodeContexts **ret)
 966 {
 967     VBScript *This = impl_from_IActiveScriptDebug(iface);
 968     FIXME("(%p)->(%s %lu %lu %p)\n", This, wine_dbgstr_longlong(source), offset, len, ret);
 969     return E_NOTIMPL;
 970 }
 971
 972 static const IActiveScriptDebugVtbl VBScriptDebugVtbl = {
 973     VBScriptDebug_QueryInterface,
 974     VBScriptDebug_AddRef,
 975     VBScriptDebug_Release,
 976     VBScriptDebug_GetScriptTextAttributes,
 977     VBScriptDebug_GetScriptletTextAttributes,
 978     VBScriptDebug_EnumCodeContextsOfPosition,
 979 };
 980
 981 static inline VBScript *impl_from_IActiveScriptParse(IActiveScriptParse *iface)
 982 {
 983     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParse_iface);
 984 }
 985
 986 static HRESULT WINAPI VBScriptParse_QueryInterface(IActiveScriptParse *iface, REFIID riid, void **ppv)
 987 {
 988     VBScript *This = impl_from_IActiveScriptParse(iface);
 989     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
 990 }
 991
 992 static ULONG WINAPI VBScriptParse_AddRef(IActiveScriptParse *iface)
 993 {
 994     VBScript *This = impl_from_IActiveScriptParse(iface);
 995     return IActiveScript_AddRef(&This->IActiveScript_iface);
 996 }
 997
 998 static ULONG WINAPI VBScriptParse_Release(IActiveScriptParse *iface)
 999 {
1000     VBScript *This = impl_from_IActiveScriptParse(iface);
1001     return IActiveScript_Release(&This->IActiveScript_iface);
1002 }
1003
1004 static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
1005 {
1006     VBScript *This = impl_from_IActiveScriptParse(iface);
1007
1008     TRACE("(%p)\n", This);
1009
1010     if(This->is_initialized)
1011         return E_UNEXPECTED;
1012     This->is_initialized = TRUE;
1013
1014     if(This->ctx->site)
1015         change_state(This, SCRIPTSTATE_INITIALIZED);
1016     return S_OK;
1017 }
1018
1019 static HRESULT WINAPI VBScriptParse_AddScriptlet(IActiveScriptParse *iface,
1020         LPCOLESTR pstrDefaultName, LPCOLESTR pstrCode, LPCOLESTR pstrItemName,
1021         LPCOLESTR pstrSubItemName, LPCOLESTR pstrEventName, LPCOLESTR pstrDelimiter,
1022         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags,
1023         BSTR *pbstrName, EXCEPINFO *pexcepinfo)
1024 {
1025     VBScript *This = impl_from_IActiveScriptParse(iface);
1026     FIXME("(%p)->(%s %s %s %s %s %s %s %lu %lx %p %p)\n", This, debugstr_w(pstrDefaultName),
1027           debugstr_w(pstrCode), debugstr_w(pstrItemName), debugstr_w(pstrSubItemName),
1028           debugstr_w(pstrEventName), debugstr_w(pstrDelimiter), wine_dbgstr_longlong(dwSourceContextCookie),
1029           ulStartingLineNumber, dwFlags, pbstrName, pexcepinfo);
1030     return E_NOTIMPL;
1031 }
1032
1033 static HRESULT WINAPI VBScriptParse_ParseScriptText(IActiveScriptParse *iface,
1034         LPCOLESTR pstrCode, LPCOLESTR pstrItemName, IUnknown *punkContext,
1035         LPCOLESTR pstrDelimiter, CTXARG_T dwSourceContextCookie, ULONG ulStartingLine,
1036         DWORD dwFlags, VARIANT *pvarResult, EXCEPINFO *pexcepinfo)
1037 {
1038     VBScript *This = impl_from_IActiveScriptParse(iface);
1039     vbscode_t *code;
1040     HRESULT hres;
1041
1042     TRACE("(%p)->(%s %s %p %s %s %lu %lx %p %p)\n", This, debugstr_w(pstrCode),
1043           debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
1044           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLine, dwFlags, pvarResult, pexcepinfo);
1045
1046     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
1047         return E_UNEXPECTED;
1048
1049     hres = compile_script(This->ctx, pstrCode, pstrItemName, pstrDelimiter, dwSourceContextCookie,
1050                           ulStartingLine, dwFlags, &code);
1051     if(FAILED(hres))
1052         return hres;
1053
1054     if(!(dwFlags & SCRIPTTEXT_ISEXPRESSION) && !is_started(This)) {
1055         code->pending_exec = TRUE;
1056         return S_OK;
1057     }
1058
1059     return exec_global_code(This->ctx, code, pvarResult);
1060 }
1061
1062 static const IActiveScriptParseVtbl VBScriptParseVtbl = {
1063     VBScriptParse_QueryInterface,
1064     VBScriptParse_AddRef,
1065     VBScriptParse_Release,
1066     VBScriptParse_InitNew,
1067     VBScriptParse_AddScriptlet,
1068     VBScriptParse_ParseScriptText
1069 };
1070
1071 static inline VBScript *impl_from_IActiveScriptParseProcedure2(IActiveScriptParseProcedure2 *iface)
1072 {
1073     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParseProcedure2_iface);
1074 }
1075
1076 static HRESULT WINAPI VBScriptParseProcedure_QueryInterface(IActiveScriptParseProcedure2 *iface, REFIID riid, void **ppv)
1077 {
1078     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
1079     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
1080 }
1081
1082 static ULONG WINAPI VBScriptParseProcedure_AddRef(IActiveScriptParseProcedure2 *iface)
1083 {
1084     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
1085     return IActiveScript_AddRef(&This->IActiveScript_iface);
1086 }
1087
1088 static ULONG WINAPI VBScriptParseProcedure_Release(IActiveScriptParseProcedure2 *iface)
1089 {
1090     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
1091     return IActiveScript_Release(&This->IActiveScript_iface);
1092 }
1093
1094 static HRESULT WINAPI VBScriptParseProcedure_ParseProcedureText(IActiveScriptParseProcedure2 *iface,
1095         LPCOLESTR pstrCode, LPCOLESTR pstrFormalParams, LPCOLESTR pstrProcedureName,
1096         LPCOLESTR pstrItemName, IUnknown *punkContext, LPCOLESTR pstrDelimiter,
1097         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags, IDispatch **ppdisp)
1098 {
1099     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
1100     class_desc_t *desc;
1101     vbdisp_t *vbdisp;
1102     HRESULT hres;
1103
1104     TRACE("(%p)->(%s %s %s %s %p %s %s %lu %lx %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
1105           debugstr_w(pstrProcedureName), debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
1106           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLineNumber, dwFlags, ppdisp);
1107
1108     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
1109         return E_UNEXPECTED;
1110
1111     hres = compile_procedure(This->ctx, pstrCode, pstrItemName, pstrDelimiter, dwSourceContextCookie,
1112                              ulStartingLineNumber, dwFlags, &desc);
1113     if(FAILED(hres))
1114         return hres;
1115
1116     hres = create_vbdisp(desc, &vbdisp);
1117     if(FAILED(hres))
1118         return hres;
1119
1120     *ppdisp = (IDispatch*)&vbdisp->IDispatchEx_iface;
1121     return S_OK;
1122 }
1123
1124 static const IActiveScriptParseProcedure2Vtbl VBScriptParseProcedureVtbl = {
1125     VBScriptParseProcedure_QueryInterface,
1126     VBScriptParseProcedure_AddRef,
1127     VBScriptParseProcedure_Release,
1128     VBScriptParseProcedure_ParseProcedureText,
1129 };
1130
1131 static inline VBScript *impl_from_IObjectSafety(IObjectSafety *iface)
1132 {
1133     return CONTAINING_RECORD(iface, VBScript, IObjectSafety_iface);
1134 }
1135
1136 static HRESULT WINAPI VBScriptSafety_QueryInterface(IObjectSafety *iface, REFIID riid, void **ppv)
1137 {
1138     VBScript *This = impl_from_IObjectSafety(iface);
1139     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
1140 }
1141
1142 static ULONG WINAPI VBScriptSafety_AddRef(IObjectSafety *iface)
1143 {
1144     VBScript *This = impl_from_IObjectSafety(iface);
1145     return IActiveScript_AddRef(&This->IActiveScript_iface);
1146 }
1147
1148 static ULONG WINAPI VBScriptSafety_Release(IObjectSafety *iface)
1149 {
1150     VBScript *This = impl_from_IObjectSafety(iface);
1151     return IActiveScript_Release(&This->IActiveScript_iface);
1152 }
1153
1154 #define SUPPORTED_OPTIONS (INTERFACESAFE_FOR_UNTRUSTED_DATA|INTERFACE_USES_DISPEX|INTERFACE_USES_SECURITY_MANAGER)
1155
1156 static HRESULT WINAPI VBScriptSafety_GetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
1157         DWORD *pdwSupportedOptions, DWORD *pdwEnabledOptions)
1158 {
1159     VBScript *This = impl_from_IObjectSafety(iface);
1160
1161     TRACE("(%p)->(%s %p %p)\n", This, debugstr_guid(riid), pdwSupportedOptions, pdwEnabledOptions);
1162
1163     if(!pdwSupportedOptions || !pdwEnabledOptions)
1164         return E_POINTER;
1165
1166     *pdwSupportedOptions = SUPPORTED_OPTIONS;
1167     *pdwEnabledOptions = This->ctx->safeopt;
1168     return S_OK;
1169 }
1170
1171 static HRESULT WINAPI VBScriptSafety_SetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
1172         DWORD dwOptionSetMask, DWORD dwEnabledOptions)
1173 {
1174     VBScript *This = impl_from_IObjectSafety(iface);
1175
1176     TRACE("(%p)->(%s %lx %lx)\n", This, debugstr_guid(riid), dwOptionSetMask, dwEnabledOptions);
1177
1178     if(dwOptionSetMask & ~SUPPORTED_OPTIONS)
1179         return E_FAIL;
1180
1181     This->ctx->safeopt = (dwEnabledOptions & dwOptionSetMask) | (This->ctx->safeopt & ~dwOptionSetMask) | INTERFACE_USES_DISPEX;
1182     return S_OK;
1183 }
1184
1185 static const IObjectSafetyVtbl VBScriptSafetyVtbl = {
1186     VBScriptSafety_QueryInterface,
1187     VBScriptSafety_AddRef,
1188     VBScriptSafety_Release,
1189     VBScriptSafety_GetInterfaceSafetyOptions,
1190     VBScriptSafety_SetInterfaceSafetyOptions
1191 };
1192
1193 HRESULT WINAPI VBScriptFactory_CreateInstance(IClassFactory *iface, IUnknown *pUnkOuter, REFIID riid, void **ppv)
1194 {
1195     struct vbcaller *vbcaller;
1196     script_ctx_t *ctx;
1197     VBScript *ret;
1198     HRESULT hres;
1199
1200     TRACE("(%p %s %p)\n", pUnkOuter, debugstr_guid(riid), ppv);
1201
1202     ret = calloc(1, sizeof(*ret));
1203     if(!ret)
1204         return E_OUTOFMEMORY;
1205
1206     if(!(vbcaller = create_vbcaller())) {
1207         free(ret);
1208         return E_OUTOFMEMORY;
1209     }
1210
1211     ret->IActiveScript_iface.lpVtbl = &VBScriptVtbl;
1212     ret->IActiveScriptDebug_iface.lpVtbl = &VBScriptDebugVtbl;
1213     ret->IActiveScriptParse_iface.lpVtbl = &VBScriptParseVtbl;
1214     ret->IActiveScriptParseProcedure2_iface.lpVtbl = &VBScriptParseProcedureVtbl;
1215     ret->IObjectSafety_iface.lpVtbl = &VBScriptSafetyVtbl;
1216
1217     ret->ref = 1;
1218     ret->state = SCRIPTSTATE_UNINITIALIZED;
1219
1220     ctx = ret->ctx = calloc(1, sizeof(*ctx));
1221     if(!ctx) {
1222         IServiceProvider_Release(&vbcaller->IServiceProvider_iface);
1223         free(ret);
1224         return E_OUTOFMEMORY;
1225     }
1226
1227     ctx->vbcaller = vbcaller;
1228     ctx->safeopt = INTERFACE_USES_DISPEX;
1229     list_init(&ctx->objects);
1230     list_init(&ctx->code_list);
1231     list_init(&ctx->named_items);
1232
1233     hres = init_global(ctx);
1234     if(FAILED(hres)) {
1235         IActiveScript_Release(&ret->IActiveScript_iface);
1236         return hres;
1237     }
1238
1239     hres = IActiveScript_QueryInterface(&ret->IActiveScript_iface, riid, ppv);
1240     IActiveScript_Release(&ret->IActiveScript_iface);
1241     return hres;
1242 }
1243
1244 typedef struct {
1245     IServiceProvider IServiceProvider_iface;
1246
1247     LONG ref;
1248
1249     IServiceProvider *sp;
1250 } AXSite;
1251
1252 static inline AXSite *impl_from_IServiceProvider(IServiceProvider *iface)
1253 {
1254     return CONTAINING_RECORD(iface, AXSite, IServiceProvider_iface);
1255 }
1256
1257 static HRESULT WINAPI AXSite_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
1258 {
1259     AXSite *This = impl_from_IServiceProvider(iface);
1260
1261     if(IsEqualGUID(&IID_IUnknown, riid)) {
1262         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
1263         *ppv = &This->IServiceProvider_iface;
1264     }else if(IsEqualGUID(&IID_IServiceProvider, riid)) {
1265         TRACE("(%p)->(IID_IServiceProvider %p)\n", This, ppv);
1266         *ppv = &This->IServiceProvider_iface;
1267     }else {
1268         TRACE("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
1269         *ppv = NULL;
1270         return E_NOINTERFACE;
1271     }
1272
1273     IUnknown_AddRef((IUnknown*)*ppv);
1274     return S_OK;
1275 }
1276
1277 static ULONG WINAPI AXSite_AddRef(IServiceProvider *iface)
1278 {
1279     AXSite *This = impl_from_IServiceProvider(iface);
1280     LONG ref = InterlockedIncrement(&This->ref);
1281
1282     TRACE("(%p) ref=%ld\n", This, ref);
1283
1284     return ref;
1285 }
1286
1287 static ULONG WINAPI AXSite_Release(IServiceProvider *iface)
1288 {
1289     AXSite *This = impl_from_IServiceProvider(iface);
1290     LONG ref = InterlockedDecrement(&This->ref);
1291
1292     TRACE("(%p) ref=%ld\n", This, ref);
1293
1294     if(!ref)
1295         free(This);
1296
1297     return ref;
1298 }
1299
1300 static HRESULT WINAPI AXSite_QueryService(IServiceProvider *iface,
1301         REFGUID guidService, REFIID riid, void **ppv)
1302 {
1303     AXSite *This = impl_from_IServiceProvider(iface);
1304
1305     TRACE("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
1306
1307     return IServiceProvider_QueryService(This->sp, guidService, riid, ppv);
1308 }
1309
1310 static IServiceProviderVtbl AXSiteVtbl = {
1311     AXSite_QueryInterface,
1312     AXSite_AddRef,
1313     AXSite_Release,
1314     AXSite_QueryService
1315 };
1316
1317 IUnknown *create_ax_site(script_ctx_t *ctx)
1318 {
1319     IServiceProvider *sp;
1320     AXSite *ret;
1321     HRESULT hres;
1322
1323     hres = IActiveScriptSite_QueryInterface(ctx->site, &IID_IServiceProvider, (void**)&sp);
1324     if(FAILED(hres)) {
1325         ERR("Could not get IServiceProvider iface: %08lx\n", hres);
1326         return NULL;
1327     }
1328
1329     ret = malloc(sizeof(*ret));
1330     if(!ret) {
1331         IServiceProvider_Release(sp);
1332         return NULL;
1333     }
1334
1335     ret->IServiceProvider_iface.lpVtbl = &AXSiteVtbl;
1336     ret->ref = 1;
1337     ret->sp = sp;
1338
1339     return (IUnknown*)&ret->IServiceProvider_iface;
1340 }