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