vbscript: Added IActiveScriptParseProcedure2::ParseProcedureText implementation.

dlls/vbscript/vbdisp.c

@@ -501,6 +501,8 @@ HRESULT create_vbdisp(const class_desc_t *desc, vbdisp_t **ret)
     vbdisp->ref = 1;
     vbdisp->desc = desc;
 
+    list_add_tail(&desc->ctx->objects, &vbdisp->entry);
+
     if(desc->class_initialize_id) {
         DISPPARAMS dp = {0};
         HRESULT hres;
@@ -513,11 +515,56 @@ HRESULT create_vbdisp(const class_desc_t *desc, vbdisp_t **ret)
         }
     }
 
-    list_add_tail(&desc->ctx->objects, &vbdisp->entry);
     *ret = vbdisp;
     return S_OK;
 }
 
+static HRESULT Procedure_invoke(vbdisp_t *This, VARIANT *args, unsigned args_cnt, VARIANT *res)
+{
+    script_ctx_t *ctx = This->desc->ctx;
+    HRESULT hres;
+
+    TRACE("\n");
+
+    IActiveScriptSite_OnEnterScript(ctx->site);
+    hres = exec_script(ctx, This->desc->value_func, NULL, NULL, NULL);
+    IActiveScriptSite_OnLeaveScript(ctx->site);
+
+    return hres;
+}
+
+static const builtin_prop_t procedure_props[] = {
+    {DISPID_VALUE,  Procedure_invoke, 0}
+};
+
+HRESULT create_procedure_disp(script_ctx_t *ctx, vbscode_t *code, IDispatch **ret)
+{
+    class_desc_t *desc;
+    vbdisp_t *vbdisp;
+    HRESULT hres;
+
+    desc = heap_alloc_zero(sizeof(*desc));
+    if(!desc)
+        return E_OUTOFMEMORY;
+
+    desc->ctx = ctx;
+    desc->builtin_prop_cnt = sizeof(procedure_props)/sizeof(*procedure_props);
+    desc->builtin_props = procedure_props;
+    desc->value_func = &code->main_code;
+
+    hres = create_vbdisp(desc, &vbdisp);
+    if(FAILED(hres)) {
+        heap_free(desc);
+        return hres;
+    }
+
+    desc->next = ctx->procs;
+    ctx->procs = desc;
+
+    *ret = (IDispatch*)&vbdisp->IDispatchEx_iface;
+    return S_OK;
+}
+
 void collect_objects(script_ctx_t *ctx)
 {
     vbdisp_t *iter, *iter2;

dlls/vbscript/vbscript.c

@@ -650,10 +650,21 @@ static HRESULT WINAPI VBScriptParseProcedure_ParseProcedureText(IActiveScriptPar
         CTXARG_T dwSourceContextCookie, ULONG ulStartingLineNumber, DWORD dwFlags, IDispatch **ppdisp)
 {
     VBScript *This = impl_from_IActiveScriptParseProcedure2(iface);
-    FIXME("(%p)->(%s %s %s %s %p %s %s %u %x %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
+    vbscode_t *code;
+    HRESULT hres;
+
+    TRACE("(%p)->(%s %s %s %s %p %s %s %u %x %p)\n", This, debugstr_w(pstrCode), debugstr_w(pstrFormalParams),
           debugstr_w(pstrProcedureName), debugstr_w(pstrItemName), punkContext, debugstr_w(pstrDelimiter),
           wine_dbgstr_longlong(dwSourceContextCookie), ulStartingLineNumber, dwFlags, ppdisp);
-    return E_NOTIMPL;
+
+    if(This->thread_id != GetCurrentThreadId() || This->state == SCRIPTSTATE_CLOSED)
+        return E_UNEXPECTED;
+
+    hres = compile_script(This->ctx, pstrCode, &code);
+    if(FAILED(hres))
+        return hres;
+
+    return create_procedure_disp(This->ctx, code, ppdisp);
 }
 
 static const IActiveScriptParseProcedure2Vtbl VBScriptParseProcedureVtbl = {

dlls/vbscript/vbscript.h

@@ -100,6 +100,7 @@ typedef struct _class_desc_t {
     unsigned builtin_prop_cnt;
     const builtin_prop_t *builtin_props;
     ITypeInfo *typeinfo;
+    function_t *value_func;
 
     struct _class_desc_t *next;
 } class_desc_t;
@@ -121,6 +122,7 @@ HRESULT vbdisp_get_id(vbdisp_t*,BSTR,vbdisp_invoke_type_t,BOOL,DISPID*) DECLSPEC
 HRESULT disp_call(script_ctx_t*,IDispatch*,DISPID,DISPPARAMS*,VARIANT*) DECLSPEC_HIDDEN;
 HRESULT disp_propput(script_ctx_t*,IDispatch*,DISPID,DISPPARAMS*) DECLSPEC_HIDDEN;
 void collect_objects(script_ctx_t*) DECLSPEC_HIDDEN;
+HRESULT create_procedure_disp(script_ctx_t*,vbscode_t*,IDispatch**) DECLSPEC_HIDDEN;
 
 static inline unsigned arg_cnt(const DISPPARAMS *dp)
 {
@@ -160,6 +162,7 @@ struct _script_ctx_t {
     dynamic_var_t *global_vars;
     function_t *global_funcs;
     class_desc_t *classes;
+    class_desc_t *procs;
 
     vbsheap_t heap;