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