Import Tk 8.5.15 (as of svn r89086)
This commit is contained in:
Zachary Ware
462
win/tkWinSendCom.c
Normal file
462
win/tkWinSendCom.c
Normal file
@@ -0,0 +1,462 @@
|
||||
/*
|
||||
* tkWinSendCom.c --
|
||||
*
|
||||
* This file provides support functions that implement the Windows "send"
|
||||
* command using COM interfaces, allowing commands to be passed from
|
||||
* interpreter to interpreter. See also tkWinSend.c, where most of the
|
||||
* interesting functions are.
|
||||
*
|
||||
* We implement a COM class for use in registering Tcl interpreters with the
|
||||
* system's Running Object Table. This class implements an IDispatch interface
|
||||
* with the following method:
|
||||
* Send(String cmd) As String
|
||||
* In other words the Send methods takes a string and evaluates this in the
|
||||
* Tcl interpreter. The result is returned as another string.
|
||||
*
|
||||
* Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tkInt.h"
|
||||
#include "tkWinSendCom.h"
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
* Non-public prototypes.
|
||||
*
|
||||
* These are the interface methods for IUnknown, IDispatch and
|
||||
* ISupportErrorInfo.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void TkWinSendCom_Destroy(LPDISPATCH pdisp);
|
||||
|
||||
static STDMETHODIMP WinSendCom_QueryInterface(IDispatch *This,
|
||||
REFIID riid, void **ppvObject);
|
||||
static STDMETHODIMP_(ULONG) WinSendCom_AddRef(IDispatch *This);
|
||||
static STDMETHODIMP_(ULONG) WinSendCom_Release(IDispatch *This);
|
||||
static STDMETHODIMP WinSendCom_GetTypeInfoCount(IDispatch *This,
|
||||
UINT *pctinfo);
|
||||
static STDMETHODIMP WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo,
|
||||
LCID lcid, ITypeInfo **ppTI);
|
||||
static STDMETHODIMP WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid,
|
||||
LPOLESTR *rgszNames, UINT cNames, LCID lcid,
|
||||
DISPID *rgDispId);
|
||||
static STDMETHODIMP WinSendCom_Invoke(IDispatch *This, DISPID dispidMember,
|
||||
REFIID riid, LCID lcid, WORD wFlags,
|
||||
DISPPARAMS *pDispParams, VARIANT *pvarResult,
|
||||
EXCEPINFO *pExcepInfo, UINT *puArgErr);
|
||||
static STDMETHODIMP ISupportErrorInfo_QueryInterface(
|
||||
ISupportErrorInfo *This, REFIID riid,
|
||||
void **ppvObject);
|
||||
static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef(
|
||||
ISupportErrorInfo *This);
|
||||
static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release(
|
||||
ISupportErrorInfo *This);
|
||||
static STDMETHODIMP ISupportErrorInfo_InterfaceSupportsErrorInfo(
|
||||
ISupportErrorInfo *This, REFIID riid);
|
||||
static HRESULT Send(TkWinSendCom *obj, VARIANT vCmd,
|
||||
VARIANT *pvResult, EXCEPINFO *pExcepInfo,
|
||||
UINT *puArgErr);
|
||||
static HRESULT Async(TkWinSendCom *obj, VARIANT Cmd,
|
||||
EXCEPINFO *pExcepInfo, UINT *puArgErr);
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* CreateInstance --
|
||||
*
|
||||
* Create and initialises a new instance of the WinSend COM class and
|
||||
* returns an interface pointer for you to use.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
HRESULT
|
||||
TkWinSendCom_CreateInstance(
|
||||
Tcl_Interp *interp,
|
||||
REFIID riid,
|
||||
void **ppv)
|
||||
{
|
||||
/*
|
||||
* Construct v-tables for each interface.
|
||||
*/
|
||||
|
||||
static IDispatchVtbl vtbl = {
|
||||
WinSendCom_QueryInterface,
|
||||
WinSendCom_AddRef,
|
||||
WinSendCom_Release,
|
||||
WinSendCom_GetTypeInfoCount,
|
||||
WinSendCom_GetTypeInfo,
|
||||
WinSendCom_GetIDsOfNames,
|
||||
WinSendCom_Invoke,
|
||||
};
|
||||
static ISupportErrorInfoVtbl vtbl2 = {
|
||||
ISupportErrorInfo_QueryInterface,
|
||||
ISupportErrorInfo_AddRef,
|
||||
ISupportErrorInfo_Release,
|
||||
ISupportErrorInfo_InterfaceSupportsErrorInfo,
|
||||
};
|
||||
HRESULT hr = S_OK;
|
||||
TkWinSendCom *obj = NULL;
|
||||
|
||||
/*
|
||||
* This had probably better always be globally visible memory so we shall
|
||||
* use the COM Task allocator.
|
||||
*/
|
||||
|
||||
obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom));
|
||||
if (obj == NULL) {
|
||||
*ppv = NULL;
|
||||
hr = E_OUTOFMEMORY;
|
||||
} else {
|
||||
obj->lpVtbl = &vtbl;
|
||||
obj->lpVtbl2 = &vtbl2;
|
||||
obj->refcount = 0;
|
||||
obj->interp = interp;
|
||||
|
||||
/*
|
||||
* lock the interp? Tcl_AddRef/Retain?
|
||||
*/
|
||||
|
||||
hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv);
|
||||
}
|
||||
|
||||
return hr;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TkWinSendCom_Destroy --
|
||||
*
|
||||
* This helper function is the destructor for our COM class.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Releases the storage allocated for this object.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
static void
|
||||
TkWinSendCom_Destroy(
|
||||
LPDISPATCH pdisp)
|
||||
{
|
||||
CoTaskMemFree((void*)pdisp);
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* IDispatch --
|
||||
*
|
||||
* The IDispatch interface implements the 'late-binding' COM methods
|
||||
* typically used by scripting COM clients. The Invoke method is the most
|
||||
* important one.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static STDMETHODIMP
|
||||
WinSendCom_QueryInterface(
|
||||
IDispatch *This,
|
||||
REFIID riid,
|
||||
void **ppvObject)
|
||||
{
|
||||
HRESULT hr = E_NOINTERFACE;
|
||||
TkWinSendCom *this = (TkWinSendCom*)This;
|
||||
*ppvObject = NULL;
|
||||
|
||||
if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0
|
||||
|| memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) {
|
||||
*ppvObject = (void**)this;
|
||||
this->lpVtbl->AddRef(This);
|
||||
hr = S_OK;
|
||||
} else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) {
|
||||
*ppvObject = (void**)(this + 1);
|
||||
this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1));
|
||||
hr = S_OK;
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
static STDMETHODIMP_(ULONG)
|
||||
WinSendCom_AddRef(
|
||||
IDispatch *This)
|
||||
{
|
||||
TkWinSendCom *this = (TkWinSendCom*)This;
|
||||
|
||||
return InterlockedIncrement(&this->refcount);
|
||||
}
|
||||
|
||||
static STDMETHODIMP_(ULONG)
|
||||
WinSendCom_Release(
|
||||
IDispatch *This)
|
||||
{
|
||||
long r = 0;
|
||||
TkWinSendCom *this = (TkWinSendCom*)This;
|
||||
|
||||
if ((r = InterlockedDecrement(&this->refcount)) == 0) {
|
||||
TkWinSendCom_Destroy(This);
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
static STDMETHODIMP
|
||||
WinSendCom_GetTypeInfoCount(
|
||||
IDispatch *This,
|
||||
UINT *pctinfo)
|
||||
{
|
||||
HRESULT hr = E_POINTER;
|
||||
|
||||
if (pctinfo != NULL) {
|
||||
*pctinfo = 0;
|
||||
hr = S_OK;
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
static STDMETHODIMP
|
||||
WinSendCom_GetTypeInfo(
|
||||
IDispatch *This,
|
||||
UINT iTInfo,
|
||||
LCID lcid,
|
||||
ITypeInfo **ppTI)
|
||||
{
|
||||
HRESULT hr = E_POINTER;
|
||||
|
||||
if (ppTI) {
|
||||
*ppTI = NULL;
|
||||
hr = E_NOTIMPL;
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
static STDMETHODIMP
|
||||
WinSendCom_GetIDsOfNames(
|
||||
IDispatch *This,
|
||||
REFIID riid,
|
||||
LPOLESTR *rgszNames,
|
||||
UINT cNames,
|
||||
LCID lcid,
|
||||
DISPID *rgDispId)
|
||||
{
|
||||
HRESULT hr = E_POINTER;
|
||||
|
||||
if (rgDispId) {
|
||||
hr = DISP_E_UNKNOWNNAME;
|
||||
if (_wcsicmp(*rgszNames, L"Send") == 0) {
|
||||
*rgDispId = TKWINSENDCOM_DISPID_SEND, hr = S_OK;
|
||||
} else if (_wcsicmp(*rgszNames, L"Async") == 0) {
|
||||
*rgDispId = TKWINSENDCOM_DISPID_ASYNC, hr = S_OK;
|
||||
}
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
static STDMETHODIMP
|
||||
WinSendCom_Invoke(
|
||||
IDispatch *This,
|
||||
DISPID dispidMember,
|
||||
REFIID riid,
|
||||
LCID lcid,
|
||||
WORD wFlags,
|
||||
DISPPARAMS *pDispParams,
|
||||
VARIANT *pvarResult,
|
||||
EXCEPINFO *pExcepInfo,
|
||||
UINT *puArgErr)
|
||||
{
|
||||
HRESULT hr = DISP_E_MEMBERNOTFOUND;
|
||||
TkWinSendCom *this = (TkWinSendCom*)This;
|
||||
|
||||
switch (dispidMember) {
|
||||
case TKWINSENDCOM_DISPID_SEND:
|
||||
if (wFlags | DISPATCH_METHOD) {
|
||||
if (pDispParams->cArgs != 1) {
|
||||
hr = DISP_E_BADPARAMCOUNT;
|
||||
} else {
|
||||
hr = Send(this, pDispParams->rgvarg[0], pvarResult,
|
||||
pExcepInfo, puArgErr);
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case TKWINSENDCOM_DISPID_ASYNC:
|
||||
if (wFlags | DISPATCH_METHOD) {
|
||||
if (pDispParams->cArgs != 1) {
|
||||
hr = DISP_E_BADPARAMCOUNT;
|
||||
} else {
|
||||
hr = Async(this, pDispParams->rgvarg[0], pExcepInfo, puArgErr);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ISupportErrorInfo --
|
||||
*
|
||||
* This interface provides rich error information to COM clients. Used by
|
||||
* VB and scripting COM clients.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static STDMETHODIMP
|
||||
ISupportErrorInfo_QueryInterface(
|
||||
ISupportErrorInfo *This,
|
||||
REFIID riid,
|
||||
void **ppvObject)
|
||||
{
|
||||
TkWinSendCom *this = (TkWinSendCom*)(This - 1);
|
||||
|
||||
return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject);
|
||||
}
|
||||
|
||||
static STDMETHODIMP_(ULONG)
|
||||
ISupportErrorInfo_AddRef(
|
||||
ISupportErrorInfo *This)
|
||||
{
|
||||
TkWinSendCom *this = (TkWinSendCom*)(This - 1);
|
||||
|
||||
return InterlockedIncrement(&this->refcount);
|
||||
}
|
||||
|
||||
static STDMETHODIMP_(ULONG)
|
||||
ISupportErrorInfo_Release(
|
||||
ISupportErrorInfo *This)
|
||||
{
|
||||
TkWinSendCom *this = (TkWinSendCom*)(This - 1);
|
||||
|
||||
return this->lpVtbl->Release((IDispatch*)this);
|
||||
}
|
||||
|
||||
static STDMETHODIMP
|
||||
ISupportErrorInfo_InterfaceSupportsErrorInfo(
|
||||
ISupportErrorInfo *This,
|
||||
REFIID riid)
|
||||
{
|
||||
/*TkWinSendCom *this = (TkWinSendCom*)(This - 1);*/
|
||||
return S_OK; /* or S_FALSE */
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* Async --
|
||||
*
|
||||
* Queues the command for evaluation in the assigned interpreter.
|
||||
*
|
||||
* Results:
|
||||
* A standard COM HRESULT is returned. The Tcl result is discarded.
|
||||
*
|
||||
* Side effects:
|
||||
* The interpreters state and result will be modified.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static HRESULT
|
||||
Async(
|
||||
TkWinSendCom *obj,
|
||||
VARIANT Cmd,
|
||||
EXCEPINFO *pExcepInfo,
|
||||
UINT *puArgErr)
|
||||
{
|
||||
HRESULT hr = S_OK;
|
||||
VARIANT vCmd;
|
||||
|
||||
VariantInit(&vCmd);
|
||||
|
||||
hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR);
|
||||
if (FAILED(hr)) {
|
||||
Tcl_SetStringObj(Tcl_GetObjResult(obj->interp),
|
||||
"invalid args: Async(command)", -1);
|
||||
SetExcepInfo(obj->interp, pExcepInfo);
|
||||
hr = DISP_E_EXCEPTION;
|
||||
}
|
||||
|
||||
if (SUCCEEDED(hr)) {
|
||||
if (obj->interp) {
|
||||
Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
|
||||
(int)SysStringLen(vCmd.bstrVal));
|
||||
TkWinSend_QueueCommand(obj->interp, scriptPtr);
|
||||
}
|
||||
}
|
||||
|
||||
VariantClear(&vCmd);
|
||||
|
||||
return hr;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* Send --
|
||||
*
|
||||
* Evaluates the string in the assigned interpreter. If the result is a
|
||||
* valid address then set it to the result returned by the evaluation.
|
||||
* Tcl exceptions are converted into COM exceptions.
|
||||
*
|
||||
* Results:
|
||||
* A standard COM HRESULT is returned. The Tcl result is set as the
|
||||
* method calls result.
|
||||
*
|
||||
* Side effects:
|
||||
* The interpreters state and result will be modified.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static HRESULT
|
||||
Send(
|
||||
TkWinSendCom *obj,
|
||||
VARIANT vCmd,
|
||||
VARIANT *pvResult,
|
||||
EXCEPINFO *pExcepInfo,
|
||||
UINT *puArgErr)
|
||||
{
|
||||
HRESULT hr = S_OK;
|
||||
int result = TCL_OK;
|
||||
VARIANT v;
|
||||
|
||||
VariantInit(&v);
|
||||
hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR);
|
||||
if (SUCCEEDED(hr)) {
|
||||
if (obj->interp) {
|
||||
Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal,
|
||||
(int)SysStringLen(v.bstrVal));
|
||||
|
||||
result = Tcl_EvalObjEx(obj->interp, scriptPtr,
|
||||
TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
|
||||
if (pvResult) {
|
||||
VariantInit(pvResult);
|
||||
pvResult->vt = VT_BSTR;
|
||||
pvResult->bstrVal = SysAllocString(
|
||||
Tcl_GetUnicode(Tcl_GetObjResult(obj->interp)));
|
||||
}
|
||||
if (result == TCL_ERROR) {
|
||||
hr = DISP_E_EXCEPTION;
|
||||
SetExcepInfo(obj->interp, pExcepInfo);
|
||||
}
|
||||
}
|
||||
VariantClear(&v);
|
||||
}
|
||||
return hr;
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
Reference in New Issue
Block a user