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