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     case SCRIPTSTATE_DISCONNECTED:
 355         FIXME("unimplemented SCRIPTSTATE_DISCONNECTED\n");
 356         return S_OK;
 357     default:
 358         FIXME("unimplemented state %d\n", ss);
 359         return E_NOTIMPL;
 360     }
 361
 362     change_state(This, ss);
 363     return S_OK;
 364 }
 365
 366 static HRESULT WINAPI VBScript_GetScriptState(IActiveScript *iface, SCRIPTSTATE *pssState)
 367 {
 368     VBScript *This = impl_from_IActiveScript(iface);
 369
 370     TRACE("(%p)->(%p)\n", This, pssState);
 371
 372     if(!pssState)
 373         return E_POINTER;
 374
 375     if(This->thread_id && This->thread_id != GetCurrentThreadId())
 376         return E_UNEXPECTED;
 377
 378     *pssState = This->state;
 379     return S_OK;
 380 }
 381
 382 static HRESULT WINAPI VBScript_Close(IActiveScript *iface)
 383 {
 384     VBScript *This = impl_from_IActiveScript(iface);
 385
 386     TRACE("(%p)->()\n", This);
 387
 388     if(This->thread_id && This->thread_id != GetCurrentThreadId())
 389         return E_UNEXPECTED;
 390
 391     decrease_state(This, SCRIPTSTATE_CLOSED);
 392     return S_OK;
 393 }
 394
 395 static HRESULT WINAPI VBScript_AddNamedItem(IActiveScript *iface, LPCOLESTR pstrName, DWORD dwFlags)
 396 {
 397     VBScript *This = impl_from_IActiveScript(iface);
 398     named_item_t *item;
 399     IDispatch *disp = NULL;
 400     HRESULT hres;
 401
 402     TRACE("(%p)->(%s %x)\n", This, debugstr_w(pstrName), dwFlags);
 403
 404     if(This->thread_id != GetCurrentThreadId() || !This->ctx || This->state == SCRIPTSTATE_CLOSED)
 405         return E_UNEXPECTED;
 406
 407     if(dwFlags & SCRIPTITEM_GLOBALMEMBERS) {
 408         IUnknown *unk;
 409
 410         hres = IActiveScriptSite_GetItemInfo(This->site, pstrName, SCRIPTINFO_IUNKNOWN, &unk, NULL);
 411         if(FAILED(hres)) {
 412             WARN("GetItemInfo failed: %08x\n", hres);
 413             return hres;
 414         }
 415
 416         hres = IUnknown_QueryInterface(unk, &IID_IDispatch, (void**)&disp);
 417         IUnknown_Release(unk);
 418         if(FAILED(hres)) {
 419             WARN("object does not implement IDispatch\n");
 420             return hres;
 421         }
 422
 423         if(This->ctx->host_global)
 424             IDispatch_Release(This->ctx->host_global);
 425         IDispatch_AddRef(disp);
 426         This->ctx->host_global = disp;
 427     }
 428
 429     item = heap_alloc(sizeof(*item));
 430     if(!item) {
 431         if(disp)
 432             IDispatch_Release(disp);
 433         return E_OUTOFMEMORY;
 434     }
 435
 436     item->disp = disp;
 437     item->flags = dwFlags;
 438     item->name = heap_strdupW(pstrName);
 439     if(!item->name) {
 440         if(disp)
 441             IDispatch_Release(disp);
 442         heap_free(item);
 443         return E_OUTOFMEMORY;
 444     }
 445
 446     list_add_tail(&This->ctx->named_items, &item->entry);
 447     return S_OK;
 448 }
 449
 450 static HRESULT WINAPI VBScript_AddTypeLib(IActiveScript *iface, REFGUID rguidTypeLib,
 451         DWORD dwMajor, DWORD dwMinor, DWORD dwFlags)
 452 {
 453     VBScript *This = impl_from_IActiveScript(iface);
 454     FIXME("(%p)->()\n", This);
 455     return E_NOTIMPL;
 456 }
 457
 458 static HRESULT WINAPI VBScript_GetScriptDispatch(IActiveScript *iface, LPCOLESTR pstrItemName, IDispatch **ppdisp)
 459 {
 460     VBScript *This = impl_from_IActiveScript(iface);
 461
 462     TRACE("(%p)->(%p)\n", This, ppdisp);
 463
 464     if(!ppdisp)
 465         return E_POINTER;
 466
 467     if(This->thread_id != GetCurrentThreadId() || !This->ctx || !This->ctx->script_obj) {
 468         *ppdisp = NULL;
 469         return E_UNEXPECTED;
 470     }
 471
 472     *ppdisp = (IDispatch*)&This->ctx->script_obj->IDispatchEx_iface;
 473     IDispatch_AddRef(*ppdisp);
 474     return S_OK;
 475 }
 476
 477 static HRESULT WINAPI VBScript_GetCurrentScriptThreadID(IActiveScript *iface,
 478                                                        SCRIPTTHREADID *pstridThread)
 479 {
 480     VBScript *This = impl_from_IActiveScript(iface);
 481     FIXME("(%p)->()\n", This);
 482     return E_NOTIMPL;
 483 }
 484
 485 static HRESULT WINAPI VBScript_GetScriptThreadID(IActiveScript *iface,
 486                                                 DWORD dwWin32ThreadId, SCRIPTTHREADID *pstidThread)
 487 {
 488     VBScript *This = impl_from_IActiveScript(iface);
 489     FIXME("(%p)->()\n", This);
 490     return E_NOTIMPL;
 491 }
 492
 493 static HRESULT WINAPI VBScript_GetScriptThreadState(IActiveScript *iface,
 494         SCRIPTTHREADID stidThread, SCRIPTTHREADSTATE *pstsState)
 495 {
 496     VBScript *This = impl_from_IActiveScript(iface);
 497     FIXME("(%p)->()\n", This);
 498     return E_NOTIMPL;
 499 }
 500
 501 static HRESULT WINAPI VBScript_InterruptScriptThread(IActiveScript *iface,
 502         SCRIPTTHREADID stidThread, const EXCEPINFO *pexcepinfo, DWORD dwFlags)
 503 {
 504     VBScript *This = impl_from_IActiveScript(iface);
 505     FIXME("(%p)->()\n", This);
 506     return E_NOTIMPL;
 507 }
 508
 509 static HRESULT WINAPI VBScript_Clone(IActiveScript *iface, IActiveScript **ppscript)
 510 {
 511     VBScript *This = impl_from_IActiveScript(iface);
 512     FIXME("(%p)->()\n", This);
 513     return E_NOTIMPL;
 514 }
 515
 516 static const IActiveScriptVtbl VBScriptVtbl = {
 517     VBScript_QueryInterface,
 518     VBScript_AddRef,
 519     VBScript_Release,
 520     VBScript_SetScriptSite,
 521     VBScript_GetScriptSite,
 522     VBScript_SetScriptState,
 523     VBScript_GetScriptState,
 524     VBScript_Close,
 525     VBScript_AddNamedItem,
 526     VBScript_AddTypeLib,
 527     VBScript_GetScriptDispatch,
 528     VBScript_GetCurrentScriptThreadID,
 529     VBScript_GetScriptThreadID,
 530     VBScript_GetScriptThreadState,
 531     VBScript_InterruptScriptThread,
 532     VBScript_Clone
 533 };
 534
 535 static inline VBScript *impl_from_IActiveScriptParse(IActiveScriptParse *iface)
 536 {
 537     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParse_iface);
 538 }
 539
 540 static HRESULT WINAPI VBScriptParse_QueryInterface(IActiveScriptParse *iface, REFIID riid, void **ppv)
 541 {
 542     VBScript *This = impl_from_IActiveScriptParse(iface);
 543     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
 544 }
 545
 546 static ULONG WINAPI VBScriptParse_AddRef(IActiveScriptParse *iface)
 547 {
 548     VBScript *This = impl_from_IActiveScriptParse(iface);
 549     return IActiveScript_AddRef(&This->IActiveScript_iface);
 550 }
 551
 552 static ULONG WINAPI VBScriptParse_Release(IActiveScriptParse *iface)
 553 {
 554     VBScript *This = impl_from_IActiveScriptParse(iface);
 555     return IActiveScript_Release(&This->IActiveScript_iface);
 556 }
 557
 558 static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
 559 {
 560     VBScript *This = impl_from_IActiveScriptParse(iface);
 561     script_ctx_t *ctx, *old_ctx;
 562
 563     TRACE("(%p)\n", This);
 564
 565     if(This->ctx)
 566         return E_UNEXPECTED;
 567
 568     ctx = heap_alloc_zero(sizeof(script_ctx_t));
 569     if(!ctx)
 570         return E_OUTOFMEMORY;
 571
 572     ctx->safeopt = This->safeopt;
 573     heap_pool_init(&ctx->heap);
 574     list_init(&ctx->objects);
 575     list_init(&ctx->code_list);
 576     list_init(&ctx->named_items);
 577
 578     old_ctx = InterlockedCompareExchangePointer((void**)&This->ctx, ctx, NULL);
 579     if(old_ctx) {
 580         destroy_script(ctx);
 581         return E_UNEXPECTED;
 582     }
 583
 584     return This->site ? set_ctx_site(This) : S_OK;
 585 }
 586
 587 static HRESULT WINAPI VBScriptParse_AddScriptlet(IActiveScriptParse *iface,
 588         LPCOLESTR pstrDefaultName, LPCOLESTR pstrCode, LPCOLESTR pstrItemName,
 589         LPCOLESTR pstrSubItemName, LPCOLESTR pstrEventName, LPCOLESTR pstrDelimiter,
 590         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags,
 591         BSTR *pbstrName, EXCEPINFO *pexcepinfo)
 592 {
 593     VBScript *This = impl_from_IActiveScriptParse(iface);
 594     FIXME("(%p)->(%s %s %s %s %s %s %s %u %x %p %p)\n", This, debugstr_w(pstrDefaultName),
 595           debugstr_w(pstrCode), debugstr_w(pstrItemName), debugstr_w(pstrSubItemName),
 596           debugstr_w(pstrEventName), debugstr_w(pstrDelimiter), wine_dbgstr_longlong(dwSourceContextCookie),
 597           ulStartingLineNumber, dwFlags, pbstrName, pexcepinfo);
 598     return E_NOTIMPL;
 599 }
 600
 601 static HRESULT WINAPI VBScriptParse_ParseScriptText(IActiveScriptParse *iface,
 602         LPCOLESTR pstrCode, LPCOLESTR pstrItemName, IUnknown *punkContext,
 603         LPCOLESTR pstrDelimiter, CTXARG_T dwSourceContextCookie, ULONG ulStartingLine,
 604         DWORD dwFlags, VARIANT *pvarResult, EXCEPINFO *pexcepinfo)
 605 {
 606     VBScript *This = impl_from_IActiveScriptParse(iface);
 607     vbscode_t *code;
 608     HRESULT hres;
 609
 610     TRACE("(%p)->(%s %s %p %s %s %u %x %p %p)\n", This, debugstr_w(pstrCode),
 611           debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
 612           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLine, dwFlags, pvarResult, pexcepinfo);
 613
 614     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
 615         return E_UNEXPECTED;
 616
 617     hres = compile_script(This->ctx, pstrCode, pstrDelimiter, &code);
 618     if(FAILED(hres))
 619         return hres;
 620
 621     if(!is_started(This)) {
 622         code->pending_exec = TRUE;
 623         return S_OK;
 624     }
 625
 626     return exec_global_code(This->ctx, code);
 627 }
 628
 629 static const IActiveScriptParseVtbl VBScriptParseVtbl = {
 630     VBScriptParse_QueryInterface,
 631     VBScriptParse_AddRef,
 632     VBScriptParse_Release,
 633     VBScriptParse_InitNew,
 634     VBScriptParse_AddScriptlet,
 635     VBScriptParse_ParseScriptText
 636 };
 637
 638 static inline VBScript *impl_from_IActiveScriptParseProcedure2(IActiveScriptParseProcedure2 *iface)
 639 {
 640     return CONTAINING_RECORD(iface, VBScript, IActiveScriptParseProcedure2_iface);
 641 }
 642
 643 static HRESULT WINAPI VBScriptParseProcedure_QueryInterface(IActiveScriptParseProcedure2 *iface, REFIID riid, void **ppv)
 644 {
 645     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
 646     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
 647 }
 648
 649 static ULONG WINAPI VBScriptParseProcedure_AddRef(IActiveScriptParseProcedure2 *iface)
 650 {
 651     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
 652     return IActiveScript_AddRef(&This->IActiveScript_iface);
 653 }
 654
 655 static ULONG WINAPI VBScriptParseProcedure_Release(IActiveScriptParseProcedure2 *iface)
 656 {
 657     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
 658     return IActiveScript_Release(&This->IActiveScript_iface);
 659 }
 660
 661 static HRESULT WINAPI VBScriptParseProcedure_ParseProcedureText(IActiveScriptParseProcedure2 *iface,
 662         LPCOLESTR pstrCode, LPCOLESTR pstrFormalParams, LPCOLESTR pstrProcedureName,
 663         LPCOLESTR pstrItemName, IUnknown *punkContext, LPCOLESTR pstrDelimiter,
 664         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags, IDispatch **ppdisp)
 665 {
 666     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
 667     vbscode_t *code;
 668     HRESULT hres;
 669
 670     TRACE("(%p)->(%s %s %s %s %p %s %s %u %x %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
 671           debugstr_w(pstrProcedureName), debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
 672           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLineNumber, dwFlags, ppdisp);
 673
 674     if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
 675         return E_UNEXPECTED;
 676
 677     hres = compile_script(This->ctx, pstrCode, pstrDelimiter, &code);
 678     if(FAILED(hres))
 679         return hres;
 680
 681     return create_procedure_disp(This->ctx, code, ppdisp);
 682 }
 683
 684 static const IActiveScriptParseProcedure2Vtbl VBScriptParseProcedureVtbl = {
 685     VBScriptParseProcedure_QueryInterface,
 686     VBScriptParseProcedure_AddRef,
 687     VBScriptParseProcedure_Release,
 688     VBScriptParseProcedure_ParseProcedureText,
 689 };
 690
 691 static inline VBScript *impl_from_IObjectSafety(IObjectSafety *iface)
 692 {
 693     return CONTAINING_RECORD(iface, VBScript, IObjectSafety_iface);
 694 }
 695
 696 static HRESULT WINAPI VBScriptSafety_QueryInterface(IObjectSafety *iface, REFIID riid, void **ppv)
 697 {
 698     VBScript *This = impl_from_IObjectSafety(iface);
 699     return IActiveScript_QueryInterface(&This->IActiveScript_iface, riid, ppv);
 700 }
 701
 702 static ULONG WINAPI VBScriptSafety_AddRef(IObjectSafety *iface)
 703 {
 704     VBScript *This = impl_from_IObjectSafety(iface);
 705     return IActiveScript_AddRef(&This->IActiveScript_iface);
 706 }
 707
 708 static ULONG WINAPI VBScriptSafety_Release(IObjectSafety *iface)
 709 {
 710     VBScript *This = impl_from_IObjectSafety(iface);
 711     return IActiveScript_Release(&This->IActiveScript_iface);
 712 }
 713
 714 #define SUPPORTED_OPTIONS (INTERFACESAFE_FOR_UNTRUSTED_DATA|INTERFACE_USES_DISPEX|INTERFACE_USES_SECURITY_MANAGER)
 715
 716 static HRESULT WINAPI VBScriptSafety_GetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
 717         DWORD *pdwSupportedOptions, DWORD *pdwEnabledOptions)
 718 {
 719     VBScript *This = impl_from_IObjectSafety(iface);
 720
 721     TRACE("(%p)->(%s %p %p)\n", This, debugstr_guid(riid), pdwSupportedOptions, pdwEnabledOptions);
 722
 723     if(!pdwSupportedOptions || !pdwEnabledOptions)
 724         return E_POINTER;
 725
 726     *pdwSupportedOptions = SUPPORTED_OPTIONS;
 727     *pdwEnabledOptions = This->safeopt;
 728     return S_OK;
 729 }
 730
 731 static HRESULT WINAPI VBScriptSafety_SetInterfaceSafetyOptions(IObjectSafety *iface, REFIID riid,
 732         DWORD dwOptionSetMask, DWORD dwEnabledOptions)
 733 {
 734     VBScript *This = impl_from_IObjectSafety(iface);
 735
 736     TRACE("(%p)->(%s %x %x)\n", This, debugstr_guid(riid), dwOptionSetMask, dwEnabledOptions);
 737
 738     if(dwOptionSetMask & ~SUPPORTED_OPTIONS)
 739         return E_FAIL;
 740
 741     This->safeopt = (dwEnabledOptions & dwOptionSetMask) | (This->safeopt & ~dwOptionSetMask) | INTERFACE_USES_DISPEX;
 742     return S_OK;
 743 }
 744
 745 static const IObjectSafetyVtbl VBScriptSafetyVtbl = {
 746     VBScriptSafety_QueryInterface,
 747     VBScriptSafety_AddRef,
 748     VBScriptSafety_Release,
 749     VBScriptSafety_GetInterfaceSafetyOptions,
 750     VBScriptSafety_SetInterfaceSafetyOptions
 751 };
 752
 753 HRESULT WINAPI VBScriptFactory_CreateInstance(IClassFactory *iface, IUnknown *pUnkOuter, REFIID riid, void **ppv)
 754 {
 755     VBScript *ret;
 756     HRESULT hres;
 757
 758     TRACE("(%p %s %p)\n", pUnkOuter, debugstr_guid(riid), ppv);
 759
 760     ret = heap_alloc_zero(sizeof(*ret));
 761     if(!ret)
 762         return E_OUTOFMEMORY;
 763
 764     ret->IActiveScript_iface.lpVtbl = &VBScriptVtbl;
 765     ret->IActiveScriptParse_iface.lpVtbl = &VBScriptParseVtbl;
 766     ret->IActiveScriptParseProcedure2_iface.lpVtbl = &VBScriptParseProcedureVtbl;
 767     ret->IObjectSafety_iface.lpVtbl = &VBScriptSafetyVtbl;
 768
 769     ret->ref = 1;
 770     ret->state = SCRIPTSTATE_UNINITIALIZED;
 771     ret->safeopt = INTERFACE_USES_DISPEX;
 772
 773     hres = IActiveScript_QueryInterface(&ret->IActiveScript_iface, riid, ppv);
 774     IActiveScript_Release(&ret->IActiveScript_iface);
 775     return hres;
 776 }
 777
 778 typedef struct {
 779     IServiceProvider IServiceProvider_iface;
 780
 781     LONG ref;
 782
 783     IServiceProvider *sp;
 784 } AXSite;
 785
 786 static inline AXSite *impl_from_IServiceProvider(IServiceProvider *iface)
 787 {
 788     return CONTAINING_RECORD(iface, AXSite, IServiceProvider_iface);
 789 }
 790
 791 static HRESULT WINAPI AXSite_QueryInterface(IServiceProvider *iface, REFIID riid, void **ppv)
 792 {
 793     AXSite *This = impl_from_IServiceProvider(iface);
 794
 795     if(IsEqualGUID(&IID_IUnknown, riid)) {
 796         TRACE("(%p)->(IID_IUnknown %p)\n", This, ppv);
 797         *ppv = &This->IServiceProvider_iface;
 798     }else if(IsEqualGUID(&IID_IServiceProvider, riid)) {
 799         TRACE("(%p)->(IID_IServiceProvider %p)\n", This, ppv);
 800         *ppv = &This->IServiceProvider_iface;
 801     }else {
 802         TRACE("(%p)->(%s %p)\n", This, debugstr_guid(riid), ppv);
 803         *ppv = NULL;
 804         return E_NOINTERFACE;
 805     }
 806
 807     IUnknown_AddRef((IUnknown*)*ppv);
 808     return S_OK;
 809 }
 810
 811 static ULONG WINAPI AXSite_AddRef(IServiceProvider *iface)
 812 {
 813     AXSite *This = impl_from_IServiceProvider(iface);
 814     LONG ref = InterlockedIncrement(&This->ref);
 815
 816     TRACE("(%p) ref=%d\n", This, ref);
 817
 818     return ref;
 819 }
 820
 821 static ULONG WINAPI AXSite_Release(IServiceProvider *iface)
 822 {
 823     AXSite *This = impl_from_IServiceProvider(iface);
 824     LONG ref = InterlockedDecrement(&This->ref);
 825
 826     TRACE("(%p) ref=%d\n", This, ref);
 827
 828     if(!ref)
 829         heap_free(This);
 830
 831     return ref;
 832 }
 833
 834 static HRESULT WINAPI AXSite_QueryService(IServiceProvider *iface,
 835         REFGUID guidService, REFIID riid, void **ppv)
 836 {
 837     AXSite *This = impl_from_IServiceProvider(iface);
 838
 839     TRACE("(%p)->(%s %s %p)\n", This, debugstr_guid(guidService), debugstr_guid(riid), ppv);
 840
 841     return IServiceProvider_QueryService(This->sp, guidService, riid, ppv);
 842 }
 843
 844 static IServiceProviderVtbl AXSiteVtbl = {
 845     AXSite_QueryInterface,
 846     AXSite_AddRef,
 847     AXSite_Release,
 848     AXSite_QueryService
 849 };
 850
 851 IUnknown *create_ax_site(script_ctx_t *ctx)
 852 {
 853     IServiceProvider *sp;
 854     AXSite *ret;
 855     HRESULT hres;
 856
 857     hres = IActiveScriptSite_QueryInterface(ctx->site, &IID_IServiceProvider, (void**)&sp);
 858     if(FAILED(hres)) {
 859         ERR("Could not get IServiceProvider iface: %08x\n", hres);
 860         return NULL;
 861     }
 862
 863     ret = heap_alloc(sizeof(*ret));
 864     if(!ret) {
 865         IServiceProvider_Release(sp);
 866         return NULL;
 867     }
 868
 869     ret->IServiceProvider_iface.lpVtbl = &AXSiteVtbl;
 870     ret->ref = 1;
 871     ret->sp = sp;
 872
 873     return (IUnknown*)&ret->IServiceProvider_iface;
 874 }