Implemented returning error information property to the caller. This is

done using the normal COM automation error objects and is converted back into
Tcl's errorCode and errorInfo lists by the caller. The COM Error.Source string
is made from [list $errorCode $errorInfo] in the callee.

diff --git a/WinSendCom.c b/WinSendCom.c
index fd7e912087a760d36fc038687000d0c908f40ca6..54b2d4d1739b3d629c5ce6302482db9754375a95 100644 (file)
--- a/WinSendCom.c
+++ b/WinSendCom.c
@@ -36,7 +36,16 @@ static STDMETHODIMP WinSendCom_Invoke(IDispatch *This, DISPID dispidMember,
                                       VARIANT *pvarResult,
                                       EXCEPINFO *pExcepInfo,
                                       UINT *puArgErr);
-static HRESULT Send(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult);
+
+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(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult,
+                    EXCEPINFO* pExcepInfo, UINT *puArgErr);
 
 /* ----------------------------------------------------------------------
  * COM Class Helpers
@@ -59,6 +68,14 @@ WinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv)
         WinSendCom_GetIDsOfNames,
         WinSendCom_Invoke,
     };
+
+    static ISupportErrorInfoVtbl vtbl2 = {
+        ISupportErrorInfo_QueryInterface,
+        ISupportErrorInfo_AddRef,
+        ISupportErrorInfo_Release,
+        ISupportErrorInfo_InterfaceSupportsErrorInfo,
+    };
+
     HRESULT hr = S_OK;
     WinSendCom *obj = NULL;
 
@@ -68,6 +85,7 @@ WinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv)
         hr = E_OUTOFMEMORY;
     } else {
         obj->lpVtbl = &vtbl;
+        obj->lpVtbl2 = &vtbl2;
         obj->refcount = 0;
         obj->interp = interp;
 
@@ -108,6 +126,10 @@ WinSendCom_QueryInterface(IDispatch *This,
         *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;
 }
@@ -192,18 +214,56 @@ WinSendCom_Invoke(IDispatch *This, DISPID dispidMember,
             if (pDispParams->cArgs != 1)
                 hr = DISP_E_BADPARAMCOUNT;
             else
-                hr = Send(this, pDispParams->rgvarg[0], pvarResult);
+                hr = Send(this, pDispParams->rgvarg[0], pvarResult, pExcepInfo, puArgErr);
         }
     }
     return hr;
 }
 
+/* ---------------------------------------------------------------------- */
+
+/*
+ * WinSendCom ISupportErrorInfo methods
+ */
+
+static STDMETHODIMP 
+ISupportErrorInfo_QueryInterface(ISupportErrorInfo *This,
+                                 REFIID riid, void **ppvObject)
+{
+    WinSendCom *this = (WinSendCom*)(This - 1);
+    return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject);
+}
+
+static STDMETHODIMP_(ULONG)
+ISupportErrorInfo_AddRef(ISupportErrorInfo *This)
+{
+    WinSendCom *this = (WinSendCom*)(This - 1);
+    return InterlockedIncrement(&this->refcount);
+}
+
+static STDMETHODIMP_(ULONG)
+ISupportErrorInfo_Release(ISupportErrorInfo *This)
+{
+    WinSendCom *this = (WinSendCom*)(This - 1);
+    return this->lpVtbl->Release((IDispatch*)this);
+}
+
+static STDMETHODIMP
+ISupportErrorInfo_InterfaceSupportsErrorInfo(ISupportErrorInfo *This, REFIID riid)
+{
+    WinSendCom *this = (WinSendCom*)(This - 1);
+    return S_OK; /* or S_FALSE */
+}
+
+/* ---------------------------------------------------------------------- */
+
+
 /* Description:
  *  Evaluates the string in the assigned interpreter. If the result
  *  is a valid address then set to the result returned by the evaluation.
  */
 static HRESULT
-Send(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult)
+Send(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult, EXCEPINFO* pExcepInfo, UINT *puArgErr)
 {
     HRESULT hr = S_OK;
     int r = TCL_OK;
@@ -224,6 +284,42 @@ Send(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult)
                 pvResult->vt = VT_BSTR;
                 pvResult->bstrVal = SysAllocString(Tcl_GetUnicode(Tcl_GetObjResult(obj->interp)));
             }
+            if (r == TCL_ERROR)
+            {
+                hr = DISP_E_EXCEPTION;
+                if (pExcepInfo)
+                {
+                    Tcl_Obj *opError, *opErrorInfo, *opErrorCode;
+                    ICreateErrorInfo *pCEI;
+                    IErrorInfo *pEI;
+                    HRESULT ehr;
+
+                    opError = Tcl_GetObjResult(obj->interp);
+                           opErrorInfo = Tcl_GetVar2Ex(obj->interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+                    opErrorCode = Tcl_GetVar2Ex(obj->interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+
+                    Tcl_ListObjAppendElement(obj->interp, opErrorCode, opErrorInfo);
+
+                    pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError));
+                    pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode));
+                    pExcepInfo->scode = E_FAIL;
+
+                    ehr = CreateErrorInfo(&pCEI);
+                    if (SUCCEEDED(ehr))
+                    {
+                        ehr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch);
+                        ehr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription);
+                        ehr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource);
+                        ehr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void**)&pEI);
+                        if (SUCCEEDED(ehr))
+                        {
+                            SetErrorInfo(0, pEI);
+                            pEI->lpVtbl->Release(pEI);
+                        }
+                        pCEI->lpVtbl->Release(pCEI);
+                    }
+                }
+            }
         }
         VariantClear(&v);
     }

diff --git a/WinSendCom.h b/WinSendCom.h
index d8a4efbabf91fe6b0310d4d1656b2d0692d9d5f3..2220085aa30949a6465d7545d331fb2732c14b1d 100644 (file)
--- a/WinSendCom.h
+++ b/WinSendCom.h
@@ -13,6 +13,7 @@
  */
 typedef struct WinSendCom_t {
     IDispatchVtbl *lpVtbl;
+    ISupportErrorInfoVtbl *lpVtbl2;
     long           refcount;
     Tcl_Interp     *interp;
 } WinSendCom;

diff --git a/winsend.c b/winsend.c
index cd00290bbfdf8f1ac226ab6efaaf59258d92a4ce..2997e7412d8bf6581382ab6af7828bba24beb792 100644 (file)
--- a/winsend.c
+++ b/winsend.c
@@ -633,7 +633,7 @@ Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp,
     DISPPARAMS dp;
     EXCEPINFO ei;
     UINT uiErr = 0;
-    HRESULT hr = S_OK;
+    HRESULT hr = S_OK, ehr = S_OK;
     Tcl_Obj *cmd = NULL;
 
     cmd = Tcl_ConcatObj(objc - 3, &objv[3]);
@@ -650,13 +650,32 @@ Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp,
     dp.rgvarg = &vCmd;
 
     hr = pdispInterp->lpVtbl->Invoke(pdispInterp, 1, &IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD, &dp, &vResult, &ei, &uiErr);
-    if (SUCCEEDED(hr))
+    ehr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR);
+    if (SUCCEEDED(ehr))
+        Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1));
+    if (hr == DISP_E_EXCEPTION)
     {
-        hr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR);
-        if (SUCCEEDED(hr))
-            Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1));
+        Tcl_Obj *opError, *opErrorCode, *opErrorInfo;
+
+        if (ei.bstrSource != NULL)
+        {
+            int len;
+            char * szErrorInfo;
+
+            opError = Tcl_NewUnicodeObj(ei.bstrSource, -1);
+            Tcl_ListObjIndex(interp, opError, 0, &opErrorCode);
+            Tcl_SetObjErrorCode(interp, opErrorCode);
+
+            Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo);
+            szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len);
+            Tcl_AddObjErrorInfo(interp, szErrorInfo, len);
+        }
     }
 
+
+    SysFreeString(ei.bstrDescription);
+    SysFreeString(ei.bstrSource);
+    SysFreeString(ei.bstrHelpFile);
     VariantClear(&vCmd);
 
     return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR);