Встраивание Windows Scripting в свои приложения

 extern "C" int WINAPI _tWinMain(HINSTANCE hInstance,
   HINSTANCE /*hPrevInstance*/, 
   LPTSTR lpCmdLine, int /*nShowCmd*/)
{
   
   HRESULT hRes = CoInitialize(NULL);
   ATLASSERT(SUCCEEDED(hRes));
   _Module.Init(NULL, hInstance);
   _Module.dwThreadID = GetCurrentThreadId();
   
   CClientDlg  Dlg;
   int nRet = Dlg.DoModal();

   CoUninitialize();
   return nRet;
}

// MyScriptSite.h

#include <windows.h>
#include <activscp.h>

class CMyScriptSite : 
    public CComObjectRootEx<CComSingleThreadModel>,
    public IActiveScriptSite 
{
public:

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CMyScriptSite)
    COM_INTERFACE_ENTRY(IActiveScriptSite)
END_COM_MAP()

   CMyScriptSite() 
   {
   }
   ~CMyScriptSite() 
   {
   }

   // Методы IActiveScriptSite...
   virtual HRESULT __stdcall GetLCID(LCID *plcid) 
   {
      return S_OK;
   }
   
   virtual HRESULT __stdcall GetItemInfo(LPCOLESTR pstrName,
      DWORD dwReturnMask, IUnknown **ppunkItem, ITypeInfo **ppti) 
   {
      if(ppti) 
      {
         *ppti = NULL;
         
         // Если просят ITypeInfo... 
         if(dwReturnMask & SCRIPTINFO_ITYPEINFO) 
         {
            *ppti = m_spTypeInfo;
            (*ppti)->AddRef();
         }
      }
      
      // Если Windows Scripting разместил ppunkItem...
      if(ppunkItem)
      {
         *ppunkItem = NULL;
         
         // Если Windows Scripting требует IUnknown...
         if(dwReturnMask & SCRIPTINFO_IUNKNOWN) 
         {
            // ...и требуется объект с именем MyObject...
            USES_CONVERSION;
            if (!lstrcmpi(_T("MyObject"), OLE2T(pstrName))) 
            {
               // ...То подсовываем наш объект.
               *ppunkItem = m_spUnkScriptObject;
               // ...и AddRef'им наш объект...
               (*ppunkItem)->AddRef();
            }
         }
      }
      return S_OK;
   }
   
   virtual HRESULT __stdcall GetDocVersionString(BSTR *pbstrVersion) 
   {
      return S_OK;
   }
   
   virtual HRESULT __stdcall OnScriptTerminate(
      const VARIANT *pvarResult, const EXCEPINFO *pexcepInfo) 
   {
      return S_OK;
   }
   
   virtual HRESULT __stdcall OnStateChange(SCRIPTSTATE ssScriptState) 
   {
      return S_OK;
   }
   
   virtual HRESULT __stdcall OnScriptError(
      IActiveScriptError *pscriptError) 
   {
      // Это сообщение появится в случае ошибки в скрипте.
      // Более подробная информация в pscriptError.
      EXCEPINFO ei;
      pscriptError->GetExceptionInfo(&ei);

      USES_CONVERSION;
      ::MessageBox(::GetActiveWindow(), OLE2T(ei.bstrDescription), 
                  "Script Error", MB_SETFOREGROUND);
      return S_OK;
   }
   
   virtual HRESULT __stdcall OnEnterScript(void) 
   {
      return S_OK;
   }
   
   virtual HRESULT __stdcall OnLeaveScript(void) 
   {
      return S_OK;
   }

public:   
   CComPtr<IUnknown> m_spUnkScriptObject;
   CComPtr<ITypeInfo> m_spTypeInfo;
};

LRESULT CClientDlg::OnOK(WORD wNotifyCode, WORD wID,
                         HWND hWndCtl, BOOL& bHandled)
{
   // Создаем скрипт-сайт и COM-объекты...

   // Классы CMyScriptSite и CMyObject не являются полноценными
   // COM-объектами (у них отсутствует реализация IUnknown).
   // Чтобы создать на их базе экземпляр COM-объекта, надо
   // воспользоваться специальным шаблоном - CComObject<>.
   CComObject<CMyScriptSite> * pMySite = NULL;
   // Счетчик ссылок у COM-объектов, созданных таким образом
   // равен нулю. Так что если ему сделать AddRef(), а
   // затем вызвать Releas(), он умрет!!!
   CComObject<CMyScriptSite>::CreateInstance(&pMySite);
   CComObject<CMyObject> * pMyObject = NULL;
   CComObject<CMyObject>::CreateInstance(&pMyObject);

   // Инициализируем m_spUnkScriptObject IUnknown-интерфейсом 
   // нашего скрипт-объекта...
   RET_FAIL(pMyObject->QueryInterface(IID_IUnknown,
      (void **)&pMySite->m_spUnkScriptObject), "IUnknown initialization");

   // Подгружаем и регистрируем библиотеку типов...
   CComPtr<ITypeLib> sptLib;
   RET_FAIL(LoadTypeLib(L"AtlClientApp.tlb", &sptLib), "LoadTypeLib");

   // Инициализируем реализацию IActiveScriptSite и ITypeInfo...
   RET_FAIL(sptLib->GetTypeInfoOfGuid(CLSID_MyObject, &pMySite->m_spTypeInfo), 
       "GetTypeInfoOfGuid");


   // Создаем экземпляр скрипт-машины, находящейся в VBSCRIPT.DLL.
   // Если CLSID_VBScript заменить на CLSID другой скрипт-машины, то
   // можно будет воспользоваться и другим языком...
   CComPtr<IActiveScript> spAS;
   RET_FAIL(CoCreateInstance(CLSID_VBScript, NULL, CLSCTX_INPROC_SERVER,
      IID_IActiveScript, (void **)&spAS), 
      "CoCreateInstance() for CLSID_VBScript");

   // Получаем интерфейс IActiveScriptParse.
   CComPtr<IActiveScriptParse> spASP;
   RET_FAIL(spAS->QueryInterface(IID_IActiveScriptParse, (void **)&spASP),
      "QueryInterface() for IID_IActiveScriptParse");

   /* Передаем скрипт-машине наш интерфейс IActiveScriptSite...
    Заметьте что до этого момента счетчик ссылок объекта pMySite
    (pMySite->m_dwRef) равен нулю. Скрипт-машина, действуя в 
    соответствии с законами COM, увеличивает счетчик ссылок у pMySite 
    на единицу и автоматически становится единственным объектом, имеющим
    ссылку на pMySite. Так что когда скрипт-машина освободит
    ссылку на pMySite, он (pMySite) автоматически уничтожится.
    НЕ ЗАБУДЬТЕ вызвать spAS->Close(), иначе pMySite, 
    а зачастую и MyObject, будут жить вечно ;-). */
   RET_FAIL(spAS->SetScriptSite((IActiveScriptSite *)pMySite),
      "IActiveScript::SetScriptSite()");

   // Дадим скрипт-машине шанс инициализироваться...
   RET_FAIL(spASP->InitNew(), "IActiveScriptParse::InitNew()");

   // Добавляем MyObject в пространство имен скрипт-машины...
   RET_FAIL(spAS->AddNamedItem(OLESTR("MyObject"), SCRIPTITEM_ISVISIBLE |
      SCRIPTITEM_ISSOURCE), "IActiveScript::AddNamedItem()");

   // Получаем текст из текстового окна...
   TCHAR szBuf[1024];
   // Конвертируем его в BSTR...
   CComBSTR sbsScript(GetDlgItemText(IDC_EDIT1, szBuf, 1024) + 1, szBuf);

   // Разбираем код скрипта...
   EXCEPINFO ei;
   RET_FAIL(spASP->ParseScriptText(sbsScript, NULL/*OLESTR("MyObject")*/, 
       NULL, NULL, 0, 0, L, NULL, &ei), "ParseScriptText");
   // Задаем состояние машины. Эта строка реально запускает выполнение
   // скрипта.
   HRESULT hr = spAS->SetScriptState(SCRIPTSTATE_CONNECTED);
   if(FAILED(hr))
   {
       spAS->Close();
       return 0;
   }
   // Оповещаем пользователя, что исполнение скрипта закончено...
   ::MessageBox(NULL, "Скрипт закончен, щелкните для рассылки события...", "",
      MB_SETFOREGROUND);

   // Рассылаем событие...
   pMyObject->Fire_MyEvent();

   // Следующий вызов заставляет скрипт отключиться от событий и 
   // освободить все используемые им объекты. Так как они удерживаются только
   // скрипт-машиной, то они незамедлительно самоуничтожаются. Можете 
   // проверить это, установив точки прерывания на их деструкторах.
   spAS->Close();
   return 0; 
}

#include "AtlClientApp.h"
#include "MyObject.h"
#include "MyScriptSite.h"

#define RET_FAIL(hr_param, msg) \
    { \
        HRESULT hr = hr_param; \
        if(FAILED(hr)) \
        { \
            ATLASSERT(!msg); \
            return hr; \
        } \
    }

extern const GUID CLSID_VBScript;

// CLSID скрипт-машины ...
#include <initguid.h>
DEFINE_GUID(CLSID_VBScript, 0xb54f3741, 0x5b07, 0x11cf, 0xa4, 0xb0, 0x0,
            0xaa, 0x0, 0x4a, 0x55, 0xe8);

STDMETHODIMP CMyObject::SayHi()
{
   ::MessageBox(NULL, "Мы внутри SayHi()", "CMyObject", MB_SETFOREGROUND);
   return S_OK;
}

STDMETHODIMP CMyObject::SayHi2()
{
   ::MessageBox(NULL, " Мы внутри SayHi2()", "CMyObject", MB_SETFOREGROUND);
   return S_OK;
}

   MyObject.SayHi

   Sub MyObject_MyEvent
      MyObject.SayHi2
   End Sub