Esempio n. 1
0
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);
}
Esempio n. 2
0
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);
}
Esempio n. 3
0
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);
}
Esempio n. 4
0
SEXP
R_convertDCOMObjectToR(VARIANT *var)
{
  SEXP ans = R_NilValue;

  VARTYPE type = V_VT(var);

#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
  errorLog("Converting VARIANT to R %d\n", V_VT(var));
#endif


  if(V_ISARRAY(var)) {
#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
  errorLog("Finishing convertDCOMObjectToR - convert array\n");
#endif
    return(convertArrayToR(var));
  } else if(V_VT(var) == VT_DISPATCH || (V_ISBYREF(var) && ((V_VT(var) & (~ VT_BYREF)) == VT_DISPATCH)) ) {
    IDispatch *ptr;
    if(V_ISBYREF(var)) {

#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
      errorLog("BYREF and DISPATCH in convertDCOMObjectToR\n");
#endif

      IDispatch **tmp = V_DISPATCHREF(var);
      if(!tmp)
	return(ans);
      ptr = *tmp;
    } else
      ptr = V_DISPATCH(var);
       //xxx
    if(ptr) 
      ptr->AddRef();
    ans = R_createRCOMUnknownObject((void*) ptr, "COMIDispatch");
#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
    errorLog("Finished convertDCOMObjectToR  COMIDispatch\n");
#endif
    return(ans);
  }



  if(V_ISBYREF(var)) {
    VARTYPE rtype = type & (~ VT_BYREF);

#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
    errorLog("ISBYREF() in convertDCOMObjectToR: ref type %d\n", rtype);
#endif

    if(rtype == VT_BSTR) {
        BSTR *tmp;
        const char *ptr = "";
#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
	errorLog("BYREF and BSTR convertDCOMObjectToR  (scalar string)\n");
#endif
        tmp = V_BSTRREF(var);
        if(tmp)
  	  ptr = FromBstr(*tmp);
        ans = R_scalarString(ptr);
	return(ans);
    } else if(rtype == VT_BOOL || rtype == VT_I4 || rtype == VT_R8){
      return(createVariantRef(var, rtype));
    } else {
        fprintf(stderr, "Unhandled by-reference conversion type %d\n", V_VT(var));fflush(stderr);
	return(R_NilValue);        
    }
  }

  switch(type) {

    case VT_BOOL:
      ans = R_scalarLogical( (Rboolean) (V_BOOL(var) ? TRUE : FALSE));
      break;

    case VT_UI1:
    case VT_UI2:
    case VT_UI4:
    case VT_UINT:
      VariantChangeType(var, var, 0, VT_I4);
      ans = R_scalarReal((double) V_I4(var));
      break;

    case VT_I1:
    case VT_I2:
    case VT_I4:
    case VT_INT:
      VariantChangeType(var, var, 0, VT_I4);
      ans = R_scalarInteger(V_I4(var));
      break;

    case VT_R4:
    case VT_R8:
    case VT_I8:
      VariantChangeType(var, var, 0, VT_R8);
      ans = R_scalarReal(V_R8(var));
      break;

    case VT_CY:
    case VT_DATE:
    case VT_HRESULT:
    case VT_DECIMAL:
      VariantChangeType(var, var, 0, VT_R8);
      ans = numberFromVariant(var, type);
      break;

    case VT_BSTR:
      {
	char *ptr = FromBstr(V_BSTR(var));
        ans = R_scalarString(ptr);
      }
      break;

    case VT_UNKNOWN:
      {
       IUnknown *ptr = V_UNKNOWN(var);
       //xxx
       if(ptr)
         ptr->AddRef();
       ans = R_createRCOMUnknownObject((void**) ptr, "COMUnknown");
      }
       break;
  case VT_EMPTY:
  case VT_NULL:
  case VT_VOID:
    return(R_NilValue);
    break;


/*XXX Need to fill these in */
  case VT_RECORD:
  case VT_FILETIME:
  case VT_BLOB:
  case VT_STREAM:
  case VT_STORAGE:
  case VT_STREAMED_OBJECT:
    /*  case LPSTR: */
  case VT_LPWSTR:
  case VT_PTR:
  case VT_ERROR:
  case VT_VARIANT:
  case VT_CARRAY:
  case VT_USERDEFINED:
  default:
    fprintf(stderr, "Unhandled conversion type %d\n", V_VT(var));fflush(stderr);
    //XXX this consumes the variant. So the variant clearance in Invoke() does it again!
    ans = createRVariantObject(var, V_VT(var));
  }

#if defined(RDCOM_VERBOSE) && RDCOM_VERBOSE
  errorLog("Finished convertDCOMObjectToR\n");
#endif

  return(ans);
}