/* General interface from R to invoke a COM method or property accessor. @type integer giving the invocation kind/style (e.g. property get, property put, invoke) @sreturn logical indicating whether the return value should be converted or not. */ __declspec(dllexport) SEXP R_Invoke(SEXP obj, SEXP methodName, SEXP args, SEXP stype, SEXP sreturn, SEXP ids) { WORD type = R_integerScalarValue(stype, 0); WORD doReturn = R_logicalScalarValue(sreturn, 0); return(R_COM_Invoke(obj, methodName, args, type, doReturn, ids)); }
SEXP R_create(SEXP className, SEXP scontext) { SEXP ans; CLSID classId; IID refId = IID_IDispatch; IUnknown *unknown, *punknown = NULL; HRESULT hr = R_getCLSIDFromString(className, &classId); if(FAILED(hr)) COMError(hr); WORD context = R_integerScalarValue(scontext, 0); 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); }
HRESULT R_convertRObjectToDCOM(SEXP obj, VARIANT *var) { HRESULT status; int type = R_typeof(obj); if(!var) return(S_FALSE); #ifdef RDCOM_VERBOSE errorLog("Type of argument %d\n", type); #endif if(type == EXTPTRSXP && EXTPTR_TAG(obj) == Rf_install("R_VARIANT")) { VARIANT *tmp; tmp = (VARIANT *) R_ExternalPtrAddr(obj); if(tmp) { //XXX VariantCopy(var, tmp); return(S_OK); } } if(ISCOMIDispatch(obj)) { IDispatch *ptr; ptr = (IDispatch *) derefRIDispatch(obj); V_VT(var) = VT_DISPATCH; V_DISPATCH(var) = ptr; //XX ptr->AddRef(); return(S_OK); } if(ISSInstanceOf(obj, "COMDate")) { double val; val = NUMERIC_DATA(GET_SLOT(obj, Rf_install(".Data")))[0]; V_VT(var) = VT_DATE; V_DATE(var) = val; return(S_OK); } else if(ISSInstanceOf(obj, "COMCurrency")) { double val; val = NUMERIC_DATA(GET_SLOT(obj, Rf_install(".Data")))[0]; V_VT(var) = VT_R8; V_R8(var) = val; VariantChangeType(var, var, 0, VT_CY); return(S_OK); } else if(ISSInstanceOf(obj, "COMDecimal")) { double val; val = NUMERIC_DATA(GET_SLOT(obj, Rf_install(".Data")))[0]; V_VT(var) = VT_R8; V_R8(var) = val; VariantChangeType(var, var, 0, VT_DECIMAL); return(S_OK); } /* We have a complex object and we are not going to try to convert it directly but instead create an COM server object to represent it to the outside world. */ if((type == VECSXP && Rf_length(GET_NAMES(obj))) || Rf_length(GET_CLASS(obj)) > 0 || isMatrix(obj)) { status = createGenericCOMObject(obj, var); if(status == S_OK) return(S_OK); } if(Rf_length(obj) == 0) { V_VT(var) = VT_VOID; return(S_OK); } if(type == VECSXP || Rf_length(obj) > 1) { createRDCOMArray(obj, var); return(S_OK); } switch(type) { case STRSXP: V_VT(var) = VT_BSTR; V_BSTR(var) = AsBstr(getRString(obj, 0)); break; case INTSXP: V_VT(var) = VT_I4; V_I4(var) = R_integerScalarValue(obj, 0); break; case REALSXP: V_VT(var) = VT_R8; V_R8(var) = R_realScalarValue(obj, 0); break; case LGLSXP: V_VT(var) = VT_BOOL; V_BOOL(var) = R_logicalScalarValue(obj, 0) ? VARIANT_TRUE : VARIANT_FALSE; break; case VECSXP: break; } return(S_OK); }