| Posted by
| Nick Gammon
Australia (23,158 posts) Bio
Forum Administrator |
| Message
| I have done a minimal test file that, in a single file, demonstrates the problem. Copy between the lines and paste into (say) test.cpp and compile under Microsoft Visual C++.
#include <stdio.h>
#include <objbase.h>
#include <activscp.h>
//#define VBSCRIPT
//#define JSCRIPT
//#define PERLSCRIPT
//#define PYTHON
#define TCL
#ifdef VBSCRIPT
#define LANGUAGE L"vbscript"
#define TEST_CODE L"msgbox \"hello, world\", 0, \"test\" "
#endif // VBSCRIPT
#ifdef JSCRIPT
#define LANGUAGE L"jscript"
#define TEST_CODE L"WshShell = new ActiveXObject(\"WScript.Shell\");\n" \
L"WshShell.Popup(\"Hello, world\", 0, \"test\");\n"
#endif // JSCRIPT
#ifdef PERLSCRIPT
#define LANGUAGE L"perlscript"
#define TEST_CODE L"$WshShell = Win32::OLE->new(\"WScript.Shell\");\n" \
L"$WshShell->Popup(\"Hello, world\", 0, \"test\");\n"
#endif // PERLSCRIPT
#ifdef PYTHON
#define LANGUAGE L"python"
#define TEST_CODE L"import win32com.client\n" \
L"WshShell = win32com.client.Dispatch(\"WScript.Shell\")\n" \
L"WshShell.Popup(\"Hello, world\", 0, \"test\")\n"
#endif // PYTHON
#ifdef TCL
#define LANGUAGE L"tclscript"
#define TEST_CODE L"a = 42\n"
#endif // TCL
#define TRACE(arg) printf ("%s", arg)
#define TRACE1(arg, arg2) printf (arg, arg2)
class CActiveScriptSite : public IActiveScriptSite,
public IActiveScriptSiteWindow {
LONG m_cRef;
IDispatch * m_pDispWorld;
public:
CActiveScriptSite(IDispatch * pDispWorld)
: m_cRef(0), m_pDispWorld (pDispWorld)
{ }
~CActiveScriptSite(void)
{
if (m_pDispWorld)
m_pDispWorld->Release ();
}
// IUnknown methods
STDMETHODIMP QueryInterface(REFIID riid, void **ppv)
{
TRACE ("CActiveScriptSite: QueryInterface\n");
if (riid == IID_IUnknown||riid == IID_IActiveScriptSite)
*ppv = (IActiveScriptSite*)this;
else if (riid == IID_IActiveScriptSiteWindow)
*ppv = (IActiveScriptSiteWindow*)this;
else
return (*ppv = 0), E_OUTOFMEMORY;
((IUnknown*)*ppv)->AddRef();
return S_OK;
}
STDMETHODIMP_(ULONG) AddRef()
{
TRACE ("CActiveScriptSite: AddRef\n");
return InterlockedIncrement(&m_cRef);
}
STDMETHODIMP_(ULONG) Release()
{
TRACE ("CActiveScriptSite: Release\n");
if (InterlockedDecrement(&m_cRef))
return m_cRef;
delete this;
return 0;
}
// IActiveScriptSite methods
STDMETHODIMP GetItemInfo(LPCOLESTR pstrName, DWORD dwReturnMask,
IUnknown **ppiunkItem, ITypeInfo **ppti)
{
HRESULT hr = E_FAIL;
if (dwReturnMask & SCRIPTINFO_IUNKNOWN)
*ppiunkItem = 0;
if (dwReturnMask & SCRIPTINFO_ITYPEINFO)
*ppti = 0;
return hr;
}
STDMETHODIMP OnScriptError(IActiveScriptError *pscripterror);
STDMETHODIMP GetLCID(LCID *plcid)
{
TRACE ("CActiveScriptSite: GetLCID\n");
*plcid = 9;
return S_OK;
}
STDMETHODIMP GetDocVersionString(BSTR *pbstrVersion)
{
TRACE ("CActiveScriptSite: GetDocVersionString\n");
*pbstrVersion = SysAllocString(L"1.0");
return S_OK;
}
STDMETHODIMP OnScriptTerminate(const VARIANT *pvr, const EXCEPINFO *pei)
{
TRACE ("CActiveScriptSite: OnScriptTerminate\n");
return S_OK;
}
STDMETHODIMP OnStateChange(SCRIPTSTATE ssScriptState)
{
TRACE1 ("CActiveScriptSite: OnStateChange: %i\n", ssScriptState);
return S_OK;
}
STDMETHODIMP OnEnterScript(void)
{
TRACE ("CActiveScriptSite: OnEnterScript\n");
return S_OK;
}
STDMETHODIMP OnLeaveScript(void)
{
TRACE ("CActiveScriptSite: OnLeaveScript\n");
return S_OK;
}
// IActiveScriptSiteWindow methods
STDMETHODIMP GetWindow(HWND *phwnd)
{
TRACE ("CActiveScriptSite: GetWindow\n");
*phwnd = GetDesktopWindow();
return S_OK;
}
STDMETHODIMP EnableModeless(BOOL)
{
TRACE ("CActiveScriptSite: EnableModeless\n");
return S_OK;
}
};
STDMETHODIMP CActiveScriptSite::OnScriptError(IActiveScriptError *pscripterror)
{
DWORD dwCookie;
LONG nChar;
ULONG nLine;
BSTR bstr = 0;
EXCEPINFO ei;
ZeroMemory(&ei, sizeof(ei));
TRACE ("CActiveScriptSite: OnScriptError\n");
pscripterror->GetExceptionInfo(&ei);
pscripterror->GetSourcePosition(&dwCookie, &nLine, &nChar);
pscripterror->GetSourceLineText(&bstr);
printf ("Error occurred at line %ld character %ld\n", nLine, nChar);
printf ("Error source: %S\n", ei.bstrSource);
printf ("Error description: %S\n", ei.bstrDescription);
printf ("Error help file: %S\n", ei.bstrHelpFile);
SysFreeString(bstr);
SysFreeString(ei.bstrSource);
SysFreeString(ei.bstrDescription);
SysFreeString(ei.bstrHelpFile);
return S_OK;
} // end of CActiveScriptSite::OnScriptError
bool ShowError (const HRESULT hr, const char * sMsg)
{
DWORD status = 0;
char *formattedmsg;
if (hr == S_OK)
return false;
if (!FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_ALLOCATE_BUFFER |
FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
hr,
LANG_NEUTRAL,
(LPTSTR) &formattedmsg,
0,
NULL))
printf ("<<Error %08X>>\n\nWhen doing: %s\n", hr, sMsg);
else
{
printf ("Error %08X occurred when doing %s:\n\n%s\n", hr, sMsg,formattedmsg);
LocalFree (formattedmsg);
}
return true;
} // end of ShowError
int main (void)
{
HRESULT hr;
CLSID clsid;
IActiveScript * pIActiveScript = NULL; // script interface
IActiveScriptParse * pIActiveScriptParse = NULL; // parser
CActiveScriptSite * pSite = NULL; // our local site (world object)
// IDispatch * ppDispatch = NULL; // script engine dispatch pointer
// initialise COM
hr = CoInitialize (NULL);
if (ShowError (hr, "CoInitialize"))
return 1;
// find class ID of scripting language
hr = CLSIDFromProgID(LANGUAGE, &clsid);
if (ShowError (hr, "CLSIDFromProgID"))
return 1;
// create an instance of the script engine
TRACE ("Creating instance of script engine ...\n");
hr = ::CoCreateInstance(clsid,
NULL,
CLSCTX_ALL,
IID_IActiveScript,
reinterpret_cast<void**>(&pIActiveScript));
if (ShowError (hr, "CoCreateInstance"))
return 1;
// get the script parser interface
TRACE ("Getting script engine parse interface...\n");
hr = pIActiveScript->QueryInterface(
IID_IActiveScriptParse,
reinterpret_cast<void**>(&pIActiveScriptParse));
if (ShowError (hr, "QueryInterface: IID_IActiveScriptParse"))
return 1;
// initialise it
TRACE ("Initialise parse interface...\n");
hr = pIActiveScriptParse->InitNew ();
if (ShowError (hr, "InitNew"))
return 1;
// create host site object
TRACE ("Create host site object...\n");
pSite = new CActiveScriptSite (NULL); // should be dispatch pointer
pSite->AddRef ();
TRACE ("Set site...\n");
hr = pIActiveScript->SetScriptSite (pSite);
if (ShowError (hr, "SetScriptSite" ))
return 1;
// start script engine
TRACE ("Start engine...\n");
hr = pIActiveScript->SetScriptState (SCRIPTSTATE_STARTED);
if (ShowError (hr, "SetScriptState: SCRIPTSTATE_STARTED" ))
return 1;
// connect it
TRACE ("Connect engine...\n");
hr = pIActiveScript->SetScriptState (SCRIPTSTATE_CONNECTED);
if (ShowError (hr, "SetScriptState: SCRIPTSTATE_CONNECTED" ))
return 1;
// execute our test script
TRACE ("Test script...\n");
EXCEPINFO ei;
hr = pIActiveScriptParse->ParseScriptText
(TEST_CODE, 0, 0, 0, 0, 0,
SCRIPTTEXT_ISPERSISTENT |
SCRIPTTEXT_ISVISIBLE,
NULL,
&ei);
if (ShowError (hr, "ParseScriptText" ))
return 1;
TRACE ("Release everything...\n");
// release engine
pIActiveScript->SetScriptState(SCRIPTSTATE_DISCONNECTED);
pIActiveScript->Close ();
pIActiveScript->Release ();
// release parser
pIActiveScriptParse->Release ();
// finished with site
pSite->Release ();
// show we got to the end
printf ("Completed OK\n");
return 0;
} // end of main
By changing the defines (line 4 on) you can test different script engines. Uncomment #define PERLSCRIPT for instance, and comment out #define TCL.
In *every* other case (you can try them) the script engine initialises, and runs, displaying a message box. Here is the example from Perlscript, also from ActiveState:
Creating instance of script engine ...
Redirecting output to win32trace remote collector
Getting script engine parse interface...
Initialise parse interface...
Create host site object...
CActiveScriptSite: AddRef
Set site...
CActiveScriptSite: AddRef
CActiveScriptSite: QueryInterface
CActiveScriptSite: QueryInterface
CActiveScriptSite: GetLCID
CActiveScriptSite: OnStateChange: 5
Start engine...
CActiveScriptSite: OnStateChange: 1
Connect engine...
CActiveScriptSite: OnStateChange: 2
CActiveScriptSite: OnStateChange: 2
Test script...
CActiveScriptSite: OnEnterScript
CActiveScriptSite: OnLeaveScript
CActiveScriptSite: OnEnterScript
CActiveScriptSite: OnLeaveScript
Release everything...
CActiveScriptSite: OnStateChange: 3
CActiveScriptSite: OnStateChange: 5
CActiveScriptSite: OnStateChange: 4
CActiveScriptSite: Release
CActiveScriptSite: Release
Completed OK
However for TCL I get this:
Creating instance of script engine ...
Getting script engine parse interface...
Initialise parse interface...
Error 8000FFFF occurred when doing InitNew:
Catastrophic failure
|
- Nick Gammon
www.gammon.com.au, www.mushclient.com | | Top |
|
![[Next page]](/images/thin_next.gif){kind=small}
![[Go to top]](/images/gototop.gif){kind=small}
top