1/* 2 * tkWinSendCom.c -- 3 * 4 * This file provides support functions that implement the Windows "send" 5 * command using COM interfaces, allowing commands to be passed from 6 * interpreter to interpreter. See also tkWinSend.c, where most of the 7 * interesting functions are. 8 * 9 * We implement a COM class for use in registering Tcl interpreters with the 10 * system's Running Object Table. This class implements an IDispatch interface 11 * with the following method: 12 * Send(String cmd) As String 13 * In other words the Send methods takes a string and evaluates this in the 14 * Tcl interpreter. The result is returned as another string. 15 * 16 * Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> 17 * 18 * See the file "license.terms" for information on usage and redistribution of 19 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 20 * 21 * RCS: @(#) $Id$ 22 */ 23 24#include "tkInt.h" 25#include "tkWinSendCom.h" 26 27/* 28 * ---------------------------------------------------------------------- 29 * Non-public prototypes. 30 * 31 * These are the interface methods for IUnknown, IDispatch and 32 * ISupportErrorInfo. 33 * 34 * ---------------------------------------------------------------------- 35 */ 36 37static void TkWinSendCom_Destroy(LPDISPATCH pdisp); 38 39static STDMETHODIMP WinSendCom_QueryInterface(IDispatch *This, 40 REFIID riid, void **ppvObject); 41static STDMETHODIMP_(ULONG) WinSendCom_AddRef(IDispatch *This); 42static STDMETHODIMP_(ULONG) WinSendCom_Release(IDispatch *This); 43static STDMETHODIMP WinSendCom_GetTypeInfoCount(IDispatch *This, 44 UINT *pctinfo); 45static STDMETHODIMP WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo, 46 LCID lcid, ITypeInfo **ppTI); 47static STDMETHODIMP WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid, 48 LPOLESTR *rgszNames, UINT cNames, LCID lcid, 49 DISPID *rgDispId); 50static STDMETHODIMP WinSendCom_Invoke(IDispatch *This, DISPID dispidMember, 51 REFIID riid, LCID lcid, WORD wFlags, 52 DISPPARAMS *pDispParams, VARIANT *pvarResult, 53 EXCEPINFO *pExcepInfo, UINT *puArgErr); 54static STDMETHODIMP ISupportErrorInfo_QueryInterface( 55 ISupportErrorInfo *This, REFIID riid, 56 void **ppvObject); 57static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef( 58 ISupportErrorInfo *This); 59static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release( 60 ISupportErrorInfo *This); 61static STDMETHODIMP ISupportErrorInfo_InterfaceSupportsErrorInfo( 62 ISupportErrorInfo *This, REFIID riid); 63static HRESULT Send(TkWinSendCom *obj, VARIANT vCmd, 64 VARIANT *pvResult, EXCEPINFO *pExcepInfo, 65 UINT *puArgErr); 66static HRESULT Async(TkWinSendCom *obj, VARIANT Cmd, 67 EXCEPINFO *pExcepInfo, UINT *puArgErr); 68 69/* 70 * ---------------------------------------------------------------------- 71 * 72 * CreateInstance -- 73 * 74 * Create and initialises a new instance of the WinSend COM class and 75 * returns an interface pointer for you to use. 76 * 77 * ---------------------------------------------------------------------- 78 */ 79 80HRESULT 81TkWinSendCom_CreateInstance( 82 Tcl_Interp *interp, 83 REFIID riid, 84 void **ppv) 85{ 86 /* 87 * Construct v-tables for each interface. 88 */ 89 90 static IDispatchVtbl vtbl = { 91 WinSendCom_QueryInterface, 92 WinSendCom_AddRef, 93 WinSendCom_Release, 94 WinSendCom_GetTypeInfoCount, 95 WinSendCom_GetTypeInfo, 96 WinSendCom_GetIDsOfNames, 97 WinSendCom_Invoke, 98 }; 99 static ISupportErrorInfoVtbl vtbl2 = { 100 ISupportErrorInfo_QueryInterface, 101 ISupportErrorInfo_AddRef, 102 ISupportErrorInfo_Release, 103 ISupportErrorInfo_InterfaceSupportsErrorInfo, 104 }; 105 HRESULT hr = S_OK; 106 TkWinSendCom *obj = NULL; 107 108 /* 109 * This had probably better always be globally visible memory so we shall 110 * use the COM Task allocator. 111 */ 112 113 obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom)); 114 if (obj == NULL) { 115 *ppv = NULL; 116 hr = E_OUTOFMEMORY; 117 } else { 118 obj->lpVtbl = &vtbl; 119 obj->lpVtbl2 = &vtbl2; 120 obj->refcount = 0; 121 obj->interp = interp; 122 123 /* 124 * lock the interp? Tcl_AddRef/Retain? 125 */ 126 127 hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv); 128 } 129 130 return hr; 131} 132 133/* 134 * ---------------------------------------------------------------------- 135 * 136 * TkWinSendCom_Destroy -- 137 * 138 * This helper function is the destructor for our COM class. 139 * 140 * Results: 141 * None. 142 * 143 * Side effects: 144 * Releases the storage allocated for this object. 145 * 146 * ---------------------------------------------------------------------- 147 */ 148static void 149TkWinSendCom_Destroy( 150 LPDISPATCH pdisp) 151{ 152 CoTaskMemFree((void*)pdisp); 153} 154 155/* 156 * ---------------------------------------------------------------------- 157 * 158 * IDispatch -- 159 * 160 * The IDispatch interface implements the 'late-binding' COM methods 161 * typically used by scripting COM clients. The Invoke method is the most 162 * important one. 163 * 164 * ---------------------------------------------------------------------- 165 */ 166 167static STDMETHODIMP 168WinSendCom_QueryInterface( 169 IDispatch *This, 170 REFIID riid, 171 void **ppvObject) 172{ 173 HRESULT hr = E_NOINTERFACE; 174 TkWinSendCom *this = (TkWinSendCom*)This; 175 *ppvObject = NULL; 176 177 if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0 178 || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { 179 *ppvObject = (void**)this; 180 this->lpVtbl->AddRef(This); 181 hr = S_OK; 182 } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) { 183 *ppvObject = (void**)(this + 1); 184 this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1)); 185 hr = S_OK; 186 } 187 return hr; 188} 189 190static STDMETHODIMP_(ULONG) 191WinSendCom_AddRef( 192 IDispatch *This) 193{ 194 TkWinSendCom *this = (TkWinSendCom*)This; 195 196 return InterlockedIncrement(&this->refcount); 197} 198 199static STDMETHODIMP_(ULONG) 200WinSendCom_Release( 201 IDispatch *This) 202{ 203 long r = 0; 204 TkWinSendCom *this = (TkWinSendCom*)This; 205 206 if ((r = InterlockedDecrement(&this->refcount)) == 0) { 207 TkWinSendCom_Destroy(This); 208 } 209 return r; 210} 211 212static STDMETHODIMP 213WinSendCom_GetTypeInfoCount( 214 IDispatch *This, 215 UINT *pctinfo) 216{ 217 HRESULT hr = E_POINTER; 218 219 if (pctinfo != NULL) { 220 *pctinfo = 0; 221 hr = S_OK; 222 } 223 return hr; 224} 225 226static STDMETHODIMP 227WinSendCom_GetTypeInfo( 228 IDispatch *This, 229 UINT iTInfo, 230 LCID lcid, 231 ITypeInfo **ppTI) 232{ 233 HRESULT hr = E_POINTER; 234 235 if (ppTI) { 236 *ppTI = NULL; 237 hr = E_NOTIMPL; 238 } 239 return hr; 240} 241 242static STDMETHODIMP 243WinSendCom_GetIDsOfNames( 244 IDispatch *This, 245 REFIID riid, 246 LPOLESTR *rgszNames, 247 UINT cNames, 248 LCID lcid, 249 DISPID *rgDispId) 250{ 251 HRESULT hr = E_POINTER; 252 253 if (rgDispId) { 254 hr = DISP_E_UNKNOWNNAME; 255 if (_wcsicmp(*rgszNames, L"Send") == 0) { 256 *rgDispId = TKWINSENDCOM_DISPID_SEND, hr = S_OK; 257 } else if (_wcsicmp(*rgszNames, L"Async") == 0) { 258 *rgDispId = TKWINSENDCOM_DISPID_ASYNC, hr = S_OK; 259 } 260 } 261 return hr; 262} 263 264static STDMETHODIMP 265WinSendCom_Invoke( 266 IDispatch *This, 267 DISPID dispidMember, 268 REFIID riid, 269 LCID lcid, 270 WORD wFlags, 271 DISPPARAMS *pDispParams, 272 VARIANT *pvarResult, 273 EXCEPINFO *pExcepInfo, 274 UINT *puArgErr) 275{ 276 HRESULT hr = DISP_E_MEMBERNOTFOUND; 277 TkWinSendCom *this = (TkWinSendCom*)This; 278 279 switch (dispidMember) { 280 case TKWINSENDCOM_DISPID_SEND: 281 if (wFlags | DISPATCH_METHOD) { 282 if (pDispParams->cArgs != 1) { 283 hr = DISP_E_BADPARAMCOUNT; 284 } else { 285 hr = Send(this, pDispParams->rgvarg[0], pvarResult, 286 pExcepInfo, puArgErr); 287 } 288 } 289 break; 290 291 case TKWINSENDCOM_DISPID_ASYNC: 292 if (wFlags | DISPATCH_METHOD) { 293 if (pDispParams->cArgs != 1) { 294 hr = DISP_E_BADPARAMCOUNT; 295 } else { 296 hr = Async(this, pDispParams->rgvarg[0], pExcepInfo, puArgErr); 297 } 298 } 299 break; 300 } 301 return hr; 302} 303 304/* 305 * ---------------------------------------------------------------------- 306 * 307 * ISupportErrorInfo -- 308 * 309 * This interface provides rich error information to COM clients. Used by 310 * VB and scripting COM clients. 311 * 312 * ---------------------------------------------------------------------- 313 */ 314 315static STDMETHODIMP 316ISupportErrorInfo_QueryInterface( 317 ISupportErrorInfo *This, 318 REFIID riid, 319 void **ppvObject) 320{ 321 TkWinSendCom *this = (TkWinSendCom*)(This - 1); 322 323 return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject); 324} 325 326static STDMETHODIMP_(ULONG) 327ISupportErrorInfo_AddRef( 328 ISupportErrorInfo *This) 329{ 330 TkWinSendCom *this = (TkWinSendCom*)(This - 1); 331 332 return InterlockedIncrement(&this->refcount); 333} 334 335static STDMETHODIMP_(ULONG) 336ISupportErrorInfo_Release( 337 ISupportErrorInfo *This) 338{ 339 TkWinSendCom *this = (TkWinSendCom*)(This - 1); 340 341 return this->lpVtbl->Release((IDispatch*)this); 342} 343 344static STDMETHODIMP 345ISupportErrorInfo_InterfaceSupportsErrorInfo( 346 ISupportErrorInfo *This, 347 REFIID riid) 348{ 349 /*TkWinSendCom *this = (TkWinSendCom*)(This - 1);*/ 350 return S_OK; /* or S_FALSE */ 351} 352 353/* 354 * ---------------------------------------------------------------------- 355 * 356 * Async -- 357 * 358 * Queues the command for evaluation in the assigned interpreter. 359 * 360 * Results: 361 * A standard COM HRESULT is returned. The Tcl result is discarded. 362 * 363 * Side effects: 364 * The interpreters state and result will be modified. 365 * 366 * ---------------------------------------------------------------------- 367 */ 368 369static HRESULT 370Async( 371 TkWinSendCom *obj, 372 VARIANT Cmd, 373 EXCEPINFO *pExcepInfo, 374 UINT *puArgErr) 375{ 376 HRESULT hr = S_OK; 377 int result = TCL_OK; 378 VARIANT vCmd; 379 380 VariantInit(&vCmd); 381 382 hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR); 383 if (FAILED(hr)) { 384 Tcl_SetStringObj(Tcl_GetObjResult(obj->interp), 385 "invalid args: Async(command)", -1); 386 SetExcepInfo(obj->interp, pExcepInfo); 387 hr = DISP_E_EXCEPTION; 388 } 389 390 if (SUCCEEDED(hr)) { 391 if (obj->interp) { 392 Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, 393 (int)SysStringLen(vCmd.bstrVal)); 394 result = TkWinSend_QueueCommand(obj->interp, scriptPtr); 395 } 396 } 397 398 VariantClear(&vCmd); 399 400 return hr; 401} 402 403/* 404 * ---------------------------------------------------------------------- 405 * 406 * Send -- 407 * 408 * Evaluates the string in the assigned interpreter. If the result is a 409 * valid address then set it to the result returned by the evaluation. 410 * Tcl exceptions are converted into COM exceptions. 411 * 412 * Results: 413 * A standard COM HRESULT is returned. The Tcl result is set as the 414 * method calls result. 415 * 416 * Side effects: 417 * The interpreters state and result will be modified. 418 * 419 * ---------------------------------------------------------------------- 420 */ 421 422static HRESULT 423Send( 424 TkWinSendCom *obj, 425 VARIANT vCmd, 426 VARIANT *pvResult, 427 EXCEPINFO *pExcepInfo, 428 UINT *puArgErr) 429{ 430 HRESULT hr = S_OK; 431 int result = TCL_OK; 432 VARIANT v; 433 434 VariantInit(&v); 435 hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR); 436 if (SUCCEEDED(hr)) { 437 if (obj->interp) { 438 Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, 439 (int)SysStringLen(v.bstrVal)); 440 441 result = Tcl_EvalObjEx(obj->interp, scriptPtr, 442 TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); 443 if (pvResult) { 444 VariantInit(pvResult); 445 pvResult->vt = VT_BSTR; 446 pvResult->bstrVal = SysAllocString( 447 Tcl_GetUnicode(Tcl_GetObjResult(obj->interp))); 448 } 449 if (result == TCL_ERROR) { 450 hr = DISP_E_EXCEPTION; 451 SetExcepInfo(obj->interp, pExcepInfo); 452 } 453 } 454 VariantClear(&v); 455 } 456 return hr; 457} 458 459/* 460 * Local Variables: 461 * mode: c 462 * c-basic-offset: 4 463 * fill-column: 78 464 * End: 465 */ 466