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