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