Index: collects/mysterx/mysterx.ss
===================================================================
--- collects/mysterx/mysterx.ss	(revision 13203)
+++ collects/mysterx/mysterx.ss	(working copy)
@@ -54,6 +54,8 @@
     cci/coclass
     cocreate-instance-from-progid
     cci/progid
+    com-get-active-object-from-coclass
+    gao/coclass
     coclass
     progid
     set-coclass!
@@ -111,6 +113,8 @@
   (define cci/coclass cocreate-instance-from-coclass)
   (define cocreate-instance-from-progid mxprims:cocreate-instance-from-progid)
   (define cci/progid cocreate-instance-from-progid)
+  (define com-get-active-object-from-coclass mxprims:com-get-active-object-from-coclass)
+  (define gao/coclass com-get-active-object-from-coclass)
   (define coclass mxprims:coclass)
   (define progid mxprims:progid)
   (define set-coclass! mxprims:set-coclass!)
Index: collects/mysterx/private/mxmain.ss
===================================================================
--- collects/mysterx/private/mxmain.ss	(revision 13203)
+++ collects/mysterx/private/mxmain.ss	(working copy)
@@ -39,6 +39,7 @@
    progid->html
    cocreate-instance-from-coclass
    cocreate-instance-from-progid
+   com-get-active-object-from-coclass
    coclass
    progid
    set-coclass!
@@ -324,6 +325,7 @@
   (define progid->html #f)
   (define cocreate-instance-from-coclass #f)
   (define cocreate-instance-from-progid #f)
+  (define com-get-active-object-from-coclass #f)
   (define coclass #f)
   (define progid #f)
   (define set-coclass! #f)
Index: src/mysterx/mysterx.cxx
===================================================================
--- src/mysterx/mysterx.cxx	(revision 13203)
+++ src/mysterx/mysterx.cxx	(working copy)
@@ -151,6 +151,7 @@
   { mx_com_release_object,"com-release-object",1,1 },
   { mx_com_add_ref,"com-add-ref",1,1 },
   { mx_com_ref_count,"com-ref-count",1,1 },
+  { mx_com_get_active_object_from_coclass,"com-get-active-object-from-coclass",1,1 },
 
   // browsers
 
@@ -901,6 +902,64 @@
                                location, machine);
 }
 
+Scheme_Object *do_get_active_object(CLSID clsId, LPCTSTR name)
+{
+  HRESULT hr;
+  IUnknown *pUnk;
+  IDispatch *pIDispatch;
+  MX_COM_Object *com_object;
+
+  hr = GetActiveObject(clsId, NULL, &pUnk);
+
+  if (hr != ERROR_SUCCESS) {
+    char errBuff[2048];
+    sprintf(errBuff,
+            "com-get-active-object-from-coclass: "
+            "Unable to get instance of %s",
+            name);
+    codedComError(errBuff, hr);
+  }
+
+  hr = pUnk->QueryInterface(IID_IDispatch, (void **)&pIDispatch);
+
+  if (hr != ERROR_SUCCESS) {
+    char errBuff[2048];
+    sprintf(errBuff,
+            "com-get-active-object-from-coclass: "
+            "Unable to get instance of %s",
+            name);
+    codedComError(errBuff, hr);
+  }
+
+  com_object = (MX_COM_Object *)scheme_malloc_tagged(sizeof(MX_COM_Object));
+
+  com_object->so.type = mx_com_object_type;
+  com_object->pIDispatch = pIDispatch;
+  com_object->pITypeInfo = NULL;
+  com_object->clsId = clsId;
+  com_object->pEventTypeInfo = NULL;
+  com_object->pIConnectionPoint = NULL;
+  com_object->pISink = NULL;
+  com_object->connectionCookie = (DWORD)0;
+  com_object->released = FALSE;
+  com_object->types = NULL;
+
+  mx_register_com_object((Scheme_Object *)com_object, pIDispatch);
+
+  return (Scheme_Object *)com_object;
+}
+
+Scheme_Object *mx_com_get_active_object_from_coclass(int argc, Scheme_Object **argv)
+{
+  LPCTSTR coclass;
+
+  GUARANTEE_STRSYM("com-get-active-object-from-coclass", 0);
+
+  coclass = schemeToText(argv[0]);
+
+  return do_get_active_object(getCLSIDFromCoClass(coclass), coclass);
+}
+
 Scheme_Object *mx_set_coclass(int argc, Scheme_Object **argv)
 {
   CLSID clsId;
@@ -4211,7 +4270,8 @@
   retval = retvalVariantToSchemeObject(&retvalVa);
 
   // all pointers are 32 bits, choose arbitrary one
-  if (retvalVa.vt != VT_VOID)
+  if (retvalVa.vt != VT_VOID &&
+      retvalVa.vt != VT_HRESULT)
     free(retvalVa.pullVal);
 
   return retval;
Index: src/mysterx/mysterx.h
===================================================================
--- src/mysterx/mysterx.h	(revision 13203)
+++ src/mysterx/mysterx.h	(working copy)
@@ -343,6 +343,7 @@
 MX_PRIM_DECL(mx_com_event_type);
 MX_PRIM_DECL(mx_cocreate_instance_from_coclass);
 MX_PRIM_DECL(mx_cocreate_instance_from_progid);
+MX_PRIM_DECL(mx_com_get_active_object_from_coclass);
 MX_PRIM_DECL(mx_coclass);
 MX_PRIM_DECL(mx_progid);
 MX_PRIM_DECL(mx_set_coclass);
