SEXP R_create(SEXP className) { DWORD context = CLSCTX_SERVER; SEXP ans; CLSID classId; IID refId = IID_IDispatch; IUnknown *unknown, *punknown = NULL; HRESULT hr = R_getCLSIDFromString(className, &classId); if(FAILED(hr)) COMError(hr); SCODE sc = CoCreateInstance(classId, punknown, context, refId, (void **) &unknown); if(FAILED(sc)) { TCHAR buf[512]; GetScodeString(sc, buf, sizeof(buf)/sizeof(buf[0])); PROBLEM "Failed to create COM object: %s", buf ERROR; } //Already AddRef in the CoCreateInstance // so no need to do it now ( unknown->AddRef()) ans = R_createRCOMUnknownObject((void *) unknown, "COMIDispatch"); return(ans); }
SEXP R_connect_hWnd(SEXP className, SEXP excel_hWnd, SEXP raiseError) { IUnknown *unknown = NULL; HRESULT hr; SEXP ans = R_NilValue; CLSID classId; LONG_PTR l_hwnd; HWND temp_hwdn; if(R_getCLSIDFromString(className, &classId) == S_OK) { l_hwnd = (LONG_PTR)INTEGER(excel_hWnd)[0]; temp_hwdn = (HWND)l_hwnd; hr = AccessibleObjectFromWindow(temp_hwdn, OBJID_NATIVEOM, classId, (void**)&unknown); if(hr == S_OK) { void *ptr; hr = unknown->QueryInterface(IID_IDispatch, &ptr); ans = R_createRCOMUnknownObject((void *) ptr, "COMIDispatch"); } else { if(LOGICAL(raiseError)[0]) { /* From COMError.cpp - COMError */ TCHAR buf[512]; GetScodeString(hr, buf, sizeof(buf)/sizeof(buf[0])); PROTECT(ans = mkString(buf)); SET_CLASS(ans, mkString("COMErrorString")); UNPROTECT(1); return(ans); } else return(R_NilValue); } } else { PROBLEM "Couldn't get clsid from the string" WARN; } return(ans); }
SEXP R_connect(SEXP className, SEXP raiseError) { IUnknown *unknown = NULL; HRESULT hr; SEXP ans = R_NilValue; CLSID classId; if(R_getCLSIDFromString(className, &classId) == S_OK) { hr = GetActiveObject(classId, NULL, &unknown); if(SUCCEEDED(hr)) { void *ptr; hr = unknown->QueryInterface(IID_IDispatch, &ptr); ans = R_createRCOMUnknownObject((void *) ptr, "COMIDispatch"); } else { if(LOGICAL(raiseError)[0]) { /* From COMError.cpp - COMError */ TCHAR buf[512]; GetScodeString(hr, buf, sizeof(buf)/sizeof(buf[0])); PROTECT(ans = mkString(buf)); SET_CLASS(ans, mkString("COMErrorString")); UNPROTECT(1); return(ans); } else return(R_NilValue); } } else { PROBLEM "Couldn't get clsid from the string" WARN; } return(ans); }
//////////////////////////////////////////////////////////////////////// // // Client Side Errors - translate a COM failure to a Python exception // //////////////////////////////////////////////////////////////////////// PyObject *PyCom_BuildPyException(HRESULT errorhr, IUnknown *pUnk /* = NULL */, REFIID iid /* = IID_NULL */) { PyObject *obEI = NULL; TCHAR scodeStringBuf[512]; GetScodeString(errorhr, scodeStringBuf, sizeof(scodeStringBuf)/sizeof(scodeStringBuf[0])); #ifndef MS_WINCE // WINCE doesnt appear to have GetErrorInfo() - compiled, but doesnt link! if (pUnk != NULL) { assert(iid != IID_NULL); // If you pass an IUnknown, you should pass the specific IID. // See if it supports error info. ISupportErrorInfo *pSEI; HRESULT hr; Py_BEGIN_ALLOW_THREADS hr = pUnk->QueryInterface(IID_ISupportErrorInfo, (void **)&pSEI); if (SUCCEEDED(hr)) { hr = pSEI->InterfaceSupportsErrorInfo(iid); pSEI->Release(); // Finished with this object } Py_END_ALLOW_THREADS if (SUCCEEDED(hr)) { IErrorInfo *pEI; Py_BEGIN_ALLOW_THREADS hr=GetErrorInfo(0, &pEI); Py_END_ALLOW_THREADS if (hr==S_OK) { obEI = PyCom_PyObjectFromIErrorInfo(pEI, errorhr); PYCOM_RELEASE(pEI); } } }
void COMError(HRESULT hr) { TCHAR buf[512]; GetScodeString(hr, buf, sizeof(buf)/sizeof(buf[0])); /* PROBLEM buf ERROR; */ SEXP e; PROTECT(e = allocVector(LANGSXP, 3)); SETCAR(e, Rf_install("COMStop")); SETCAR(CDR(e), mkString(buf)); SETCAR(CDR(CDR(e)), ScalarInteger(hr)); Rf_eval(e, R_GlobalEnv); UNPROTECT(1); /* Won't come back to here. */ }
SEXP getArray(SAFEARRAY *arr, int dimNo, int numDims, long *indices) { long lb, ub, n, i; HRESULT status; SEXP ans; int rtype = -1; status = SafeArrayGetLBound(arr, dimNo, &lb); if(FAILED(status)) { TCHAR buf[512]; GetScodeString(status, buf, sizeof(buf)/sizeof(buf[0])); PROBLEM "Can't get lower bound of array: %s", buf ERROR; } status = SafeArrayGetUBound(arr, dimNo, &ub); if(FAILED(status)) { TCHAR buf[512]; GetScodeString(status, buf, sizeof(buf)/sizeof(buf[0])); PROBLEM "Can't get upper bound of array: %s", buf ERROR; } n = ub-lb+1; PROTECT(ans = NEW_LIST(n)); for(i = 0; i < n; i++) { SEXP el; indices[dimNo - 1] = lb + i; if(dimNo == 1) { VARIANT variant; VariantInit(&variant); status = SafeArrayGetElement(arr, indices, &variant); if(FAILED(status)) { TCHAR buf[512]; GetScodeString(status, buf, sizeof(buf)/sizeof(buf[0])); PROBLEM "Can't get element %d of array %s", (int) indices[dimNo-1], buf ERROR; } el = R_convertDCOMObjectToR(&variant); } else { el = getArray(arr, dimNo - 1, numDims, indices); } if(i == 0) rtype = TYPEOF(el); else if(rtype != -1 ){ if(TYPEOF(el) != rtype) rtype = -1; } SET_VECTOR_ELT(ans, i, el); } if(numDims == 1 && rtype != -1) { switch(rtype) { case INTSXP: case LGLSXP: case REALSXP: case STRSXP: ans = UnList(ans); break; } } UNPROTECT(1); return(ans); }