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