Dear Thomas,
I switched to R-2.8.0, and I had to realize as others also reported in
this mailing list, that under R-2.8.0 the rcom package does not work
properly. My concrete problem was that the following code (a similar to
that one) caused a crash of R.
XL<-comGetObject("excel.application")
a<-XL[["activecell"]]
b<-a[["offset",3,3]]
XL[["range",a,b]]<-matrix(1:16,a,b)
It turned out that the result of XL[["range",a,b]] is NULL, and
debugview showed the error code
com_property_get: error 80020009 getting property "range".
I started look for the problem, and I realized that the way of passing
COMObject pointers has changed. Fortunately in the util.c file one can
find the previous version of the code. This does not compile for 2.8.0
because the allocString function is not available in this version.
This can be corrected easily and with this version the above code as
well as the following one reported by
Christian Asseburg works properly.
library(rcom)
E<-comCreateObject("Excel.Application")
W1<-E[["Workbooks"]]$Add()
S1<-E[["ActiveSheet"]]
W2<-E[["Workbooks"]]$Add()
S1$Copy(Before=W2[["Worksheets",1]])
May I propose that until the problem with COMObject
pointers is solved the official version include the previous version
of SEXP2Variant and Variant2SEXP functions. To save your time the modified
version of util.c is attached. The only changes are
#if 0 instead of #if 1
and all allocString is replaced with the appropriate mkChar call.
I minor problem with the Makevars file of rcom. It sets the
PKG_LIBS flag, however it does not set
PKG_CPPFLAGS:=-I"$(RSCPROXY_DIR:%libs=%include)"
to find the include files from the installed rscproxy package.
Best wishes
Vilmos
--
Vilmos Prokaj
Eötvös Loránd University,
Department of Probability and Statistics
Pázmány Péter sétány 1/C
Budapest, 1117
Hungary
e-mail:[EMAIL PROTECTED]
/*******************************************************************************
* RCOM : COM Client and Server for R
* Copyright (C) 2003-2005 Thomas Baier
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
* ---------------------------------------------------------------------------
*
* $Id: SC_proxy.h,v 1.6 2003/09/13 15:14:09 murdoch Exp $
*
******************************************************************************/
#include <stdlib.h>
#include <assert.h>
#include "rcom.h"
#include "bdx.h"
#include "bdx_util.h"
#include "bdx_com.h"
#include "bdx_SEXP.h"
/** get the CLSID from an ANSI string (prod id or clsid string) */
/*
** 07-07-30 | baier | now (char const*) instead of (char*)
*/
HRESULT com_getCLSID(char const* str,LPCLSID pclsid)
{
HRESULT hr;
OLECHAR* _pclsid;
_pclsid = com_getOLECHAR (str);
hr = CLSIDFromProgID(_pclsid,pclsid);
free(_pclsid);
return hr;
}
/* 1 helyett 0 */
#if 0
/** create a VARIANT from an SEXP */
BOOL SEXP2Variant(SEXP sexp,VARIANT* variant)
{
BDX_Data* lBdx = NULL;
int lRc;
assert (variant != NULL);
/* create a BDX structure from the SEXP */
/* RCOM_TRACE(printf("SEXP2Variant: calling SEXP2BDX\n")); */
lRc = SEXP2BDX(sexp,&lBdx);
if(lRc != 0) {
RCOM_TRACE(printf("conversion of SEXP to BDX failed with error %d\n",
lRc));
}
/* convert the BDX structure to VARIANT */
/* RCOM_TRACE(printf("SEXP2Variant: calling BDX2Variant\n")); */
lRc = BDX2Variant(lBdx,variant);
/* RCOM_TRACE(printf("SEXP2Variant: calling bdx_free\n")); */
bdx_free(lBdx);
if(lRc == 0) {
return TRUE;
}
RCOM_TRACE(printf("conversion from BDX to VARIANT failed with error %d\n",
lRc));
return FALSE;
}
/** create an SEXP from a VARIANT */
BOOL Variant2SEXP(VARIANT* variant,SEXP* sexp)
{
BDX_Data* lBdx;
int lRc;
assert(sexp != NULL);
assert(variant != NULL);
/* create a BDX structure from the VARIANT */
lRc = Variant2BDX(*variant,&lBdx);
if(lRc != 0) {
RCOM_TRACE(printf("conversion of VARIANT to BDX failed with error %d\n",
lRc));
*sexp = NULL;
return FALSE;
}
/* convert the BDX structure to SEXP */
lRc = BDX2SEXP(lBdx,sexp);
bdx_free(lBdx);
if(lRc != 0) {
*sexp = NULL;
return FALSE;
}
return TRUE;
}
#else
/** create a VARIANT from an SEXP */
BOOL SEXP2Variant(SEXP sexp,VARIANT* variant)
{
assert (variant != NULL);
/*
* we support the following types at the moment
*
* integer (scalar, vectors and arrays)
* real (scalars, vectors and arrays)
* logical (scalars, vectors and arrays)
* string (scalars, vectors and arrays)
* COM objects (IDispatch)
* null
*
* we should support soon
*
* complex vectors
* generic vectors
* bug: no dimensions stored
*/
/*
* external pointer? length doesn't matter then
*/
if(TYPEOF(sexp) == EXTPTRSXP) {
/* is it a COM object? */
RCOM_OBJHANDLE handle = com_getHandle (sexp);
if (handle != RCOM_NULLHANDLE) {
/* valid COM object */
variant->vt = VT_DISPATCH;
variant->pdispVal = com_getObject (handle);
#ifdef __cplusplus
variant->pdispVal->AddRef();
#else
variant->pdispVal->lpVtbl->AddRef(variant->pdispVal);
#endif
} else {
/* pointer as a plain integer */
variant->vt = VT_I4;
variant->lVal = (unsigned long) R_ExternalPtrAddr(sexp);
}
return TRUE;
}
/* RCOM_TRACE(printf("SEXP2Variant: length of SEXP is %d\n",LENGTH(sexp)));
*/
if (LENGTH (sexp) == 0) {
variant->vt = VT_EMPTY;
return FALSE;
} else if (LENGTH (sexp) == 1) {
/* scalars */
switch (TYPEOF (sexp)) {
case NILSXP:
variant->vt = VT_NULL;
/* RCOM_TRACE(printf("SEXP2Variant: converting to VT_NULL\n")); */
break;
case LGLSXP:
variant->vt = VT_BOOL;
variant->boolVal = LOGICAL (sexp)[0] ? VARIANT_TRUE : VARIANT_FALSE;
/* RCOM_TRACE(printf("SEXP2Variant: converting %d to VT_BOOL\n",
LOGICAL(sexp)[0]));*/
break;
case INTSXP:
variant->vt = VT_I4;
variant->lVal = INTEGER (sexp)[0];
/* RCOM_TRACE(printf("SEXP2Variant: converting %d to VT_I4\n",
INTEGER(sexp)[0]));*/
break;
case REALSXP:
variant->vt = VT_R8;
variant->dblVal = REAL (sexp)[0];
/* RCOM_TRACE(printf("SEXP2Variant: converting %g to VT_R8\n",
REAL(sexp)[0]));*/
break;
case EXTPTRSXP:
{
/* is it a COM object? */
RCOM_OBJHANDLE handle = com_getHandle (sexp);
if (handle != RCOM_NULLHANDLE) {
/* valid COM object */
variant->vt = VT_DISPATCH;
variant->pdispVal = com_getObject (handle);
#ifdef __cplusplus
variant->pdispVal->AddRef();
#else
variant->pdispVal->lpVtbl->AddRef(variant->pdispVal);
#endif
} else {
/* pointer as a plain integer */
variant->vt = VT_I4;
variant->lVal = (unsigned long) R_ExternalPtrAddr(sexp);
}
}
break;
case STRSXP:
variant->vt = VT_BSTR;
variant->bstrVal = ANSI2BSTR(CHAR(STRING_ELT(sexp,0)));
/* RCOM_TRACE(printf("SEXP2Variant: converting string \"%s\" to
BSTR\n",
CHAR(STRING_ELT(sexp,0))));*/
/* OutputDebugStringW(variant->bstrVal); */
break;
/*
* case VECSXP : printf ("type: generic vectors\n");
* break;
* case CPLXSXP : printf ("type: complex variables\n");
* break;
*/
default:
variant->vt = VT_EMPTY;
return FALSE;
}
return TRUE;
} else {
/* is it a vector or an array? */
SEXP lDimension;
SAFEARRAYBOUND* sabounds = NULL;
int sadims = 0;
int i;
int totalsize = 1;
void* sadata = NULL;
lDimension = getAttrib (sexp,R_DimSymbol);
PROTECT (lDimension);
/* get dimension infos, allocate SAFEARRAYBOUND[] array */
if (TYPEOF (lDimension) == NILSXP) {
sadims = 1;
sabounds = (SAFEARRAYBOUND*) malloc (sizeof (SAFEARRAYBOUND));
sabounds[0].cElements = LENGTH (sexp);
totalsize = sabounds[0].cElements;
sabounds[0].lLbound = 0;
RCOM_TRACE(printf("SEXP2Variant: R_DimSymbol is NILSXP\n"));
} else if (TYPEOF (lDimension) == INTSXP) {
sadims = LENGTH (lDimension);
sabounds = (SAFEARRAYBOUND*) calloc (sadims,sizeof (SAFEARRAYBOUND));
for (i = 0;i < sadims;i++) {
sabounds[i].cElements = INTEGER (lDimension)[i];
sabounds[i].lLbound = 0;
totalsize *= sabounds[i].cElements;
}
RCOM_TRACE(printf("SEXP2Variant: sexp has %d dimensions\n",sadims));
} else {
RCOM_TRACE(printf("SEXP2Variant: invalid dimension attribute\n"));
UNPROTECT (1);
return FALSE;
}
UNPROTECT (1); lDimension = NULL;
/* check for the types */
switch (TYPEOF (sexp)) {
case LGLSXP:
variant->vt = VT_BOOL;
break;
case INTSXP:
variant->vt = VT_I4;
break;
case REALSXP:
variant->vt = VT_R8;
break;
case STRSXP:
variant->vt = VT_BSTR;
break;
/*
* case VECSXP : printf ("type: generic vectors\n");
* break;
* case CPLXSXP : printf ("type: complex variables\n");
* break;
*/
case NILSXP:
default:
variant->vt = VT_EMPTY;
free (sabounds);
RCOM_ERR(printf("SEXP2Variant: unknown data type for SEXP\n"));
return FALSE;
}
/* allocate memory for the SafeArray itself */
variant->parray = SafeArrayCreate (variant->vt,sadims,sabounds);
variant->vt |= VT_ARRAY;
free (sabounds); sabounds = NULL;
if (variant->parray == NULL) {
RCOM_ERR(printf("SEXP2Variant: creation of SAFEARRAY failed\n"));
return FALSE;
}
/* access the data */
if (FAILED (SafeArrayAccessData (variant->parray,&sadata))) {
SafeArrayDestroy (variant->parray);
RCOM_ERR(printf("SEXP2Variant: accessing SAFEARRAY failed\n"));
return FALSE;
}
/* transfer data from SEXP to the SAFEARRAY */
for (i = 0;i < totalsize; i++) {
switch (TYPEOF (sexp)) {
case LGLSXP :
((VARIANT_BOOL*) sadata)[i] = LOGICAL (sexp)[i] ? VARIANT_TRUE :
VARIANT_FALSE;
break;
case INTSXP :
((long*) sadata)[i] = INTEGER (sexp)[i];
break;
case REALSXP :
((double*) sadata)[i] = REAL (sexp)[i];
break;
case STRSXP :
((BSTR*) sadata)[i] = ANSI2BSTR(CHAR (STRING_ELT(sexp,i)));
break;
/*
* case VECSXP : printf ("type: generic vectors\n");
* break;
* case CPLXSXP : printf ("type: complex variables\n");
* break;
*/
}
/* release the data pointer */
SafeArrayUnaccessData (variant->parray);
}
}
return TRUE;
}
/** create an SEXP from a VARIANT */
/* 04-07-13 | TB | check for reference type and return an error */
/* 04-07-19 | TB | don't protect strings in a vector */
/* 04-10-11 | baier | allocString() for length only (don't count trailing 0) */
BOOL Variant2SEXP(VARIANT* variant,SEXP* sexp)
{
int protCnt = 0;
assert (sexp != NULL);
*sexp = R_NilValue;
if(V_ISBYREF(variant)) {
RCOM_ERR(printf("Variant2SEXP: VT_BYREF not supported\n"));
return FALSE;
}
if (V_ISARRAY (variant)) {
/* allocate a dimensions vector */
SEXP lDimensions;
unsigned int i;
unsigned int lTotalSize = 1;
/* vector: check dimensions */
unsigned int dim_count = SafeArrayGetDim (variant->parray);
PROTECT (lDimensions = allocVector (INTSXP,dim_count));
protCnt++;
for (i = 0;i < dim_count;i++)
{
long lUpperBound;
long lLowerBound;
if (FAILED (SafeArrayGetLBound (variant->parray,i+1,&lLowerBound)))
{
RCOM_ERR(printf("Variant2SEXP: failed to get array lower
bounds\n"));
*sexp = R_NilValue;
UNPROTECT(protCnt);
return FALSE;
}
if (FAILED (SafeArrayGetUBound (variant->parray,i+1,&lUpperBound)))
{
RCOM_ERR(printf("Variant2SEXP: failed to get array upper
bounds\n"));
*sexp = R_NilValue;
UNPROTECT(protCnt);
return FALSE;
}
INTEGER (lDimensions)[i] = lUpperBound - lLowerBound + 1;
lTotalSize *= (lUpperBound - lLowerBound + 1);
}
switch (variant->vt & VT_TYPEMASK) {
case VT_BOOL: {
VARIANT_BOOL HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (LGLSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
if (array[i] == VARIANT_FALSE) {
LOGICAL(*sexp)[i] = 0;
} else if (array[i] == VARIANT_TRUE) {
LOGICAL(*sexp)[i] = 1;
} else {
RCOM_ERR(printf("Variant2SEXP: invalid VT_BOOL value of %08x\n",
array[i]));
UNPROTECT(protCnt);
return FALSE;
}
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_I2: {
short HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i];
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_I4: {
long HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i];
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_UI1: {
unsigned char HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i];
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_R4: {
float HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (REALSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
REAL(*sexp)[i] = array[i];
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_R8: {
double HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (REALSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
REAL(*sexp)[i] = array[i];
}
SafeArrayUnlock (variant->parray);
break;
}
case VT_BSTR: {
BSTR HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
*sexp = PROTECT (allocVector (STRSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
char* ansiStr = BSTR2ANSI (array[i]);
// SEXP strsexp = allocString (strlen(ansiStr));
/* PROTECT (strsexp); protCnt++; */
// strcpy (CHAR(strsexp),ansiStr);
SET_STRING_ELT(*sexp, i, mkChar(ansiStr));
free (ansiStr);
}
SafeArrayUnlock (variant->parray);
break;
}
/* a COM object (dispatch) */
case VT_DISPATCH: {
RCOM_ERR(printf("Variant2SEXP: arrays of objects are not supported\n"));
UNPROTECT(protCnt);
return FALSE;
}
case VT_VARIANT: {
RCOM_TRACE(printf("Variant2SEXP: VT_VARIANT in VT_ARRAY: checking
types\n"));
VARIANT HUGEP* array;
if (SafeArrayAccessData (variant->parray,(void*) &array) != S_OK) {
RCOM_ERR(printf("Variant2SEXP: failed to access array data\n"));
UNPROTECT(protCnt);
return FALSE;
}
/* check the common data type for all elements in the array */
VARTYPE vt = VT_EMPTY;
for(i = 0;i < lTotalSize;i++) {
if(vt == VT_VOID) {
RCOM_ERR(printf("Variant2SEXP: multiple different types found,
converting to string!\n"));
break;
} else if((vt != VT_EMPTY) && (vt != (array[i].vt & VT_TYPEMASK))) {
vt = VT_VOID;
} else {
vt = array[i].vt & VT_TYPEMASK;
}
}
switch(vt) {
case VT_BOOL:
*sexp = PROTECT (allocVector (LGLSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
if (array[i].boolVal == VARIANT_FALSE) {
LOGICAL(*sexp)[i] = 0;
} else if (array[i].boolVal == VARIANT_TRUE) {
LOGICAL(*sexp)[i] = 1;
} else {
RCOM_ERR(printf("Variant2SEXP: invalid VT_BOOL value of %08x\n",
array[i].boolVal));
UNPROTECT(protCnt);
return FALSE;
}
}
break;
case VT_I2:
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i].iVal;
}
break;
case VT_I4:
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i].lVal;
}
break;
case VT_UI1:
*sexp = PROTECT (allocVector (INTSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
INTEGER(*sexp)[i] = array[i].bVal;
}
break;
case VT_R4:
*sexp = PROTECT (allocVector (REALSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
REAL(*sexp)[i] = array[i].fltVal;
}
break;
case VT_R8:
*sexp = PROTECT (allocVector (REALSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
REAL(*sexp)[i] = array[i].dblVal;
}
break;
case VT_BSTR:
*sexp = PROTECT (allocVector (STRSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
char* ansiStr = BSTR2ANSI(array[i].bstrVal);
// SEXP strsexp = allocString (strlen(ansiStr));
/* PROTECT (strsexp); protCnt++; */
//strcpy (CHAR(strsexp),ansiStr);
SET_STRING_ELT(*sexp, i, mkChar(ansiStr));
free (ansiStr);
break;
}
break;
case VT_VOID:
/* arrays of different variants always come as strings */
*sexp = PROTECT (allocVector (STRSXP,lTotalSize)); protCnt++;
setAttrib (*sexp,R_DimSymbol,lDimensions);
for (i = 0;i < lTotalSize;i++) {
char* ansiStr = NULL;
switch(array[i].vt & VT_TYPEMASK) {
case VT_BOOL: /* boolean: 0x0000 is false, 0xffff is true (boolVal)
*/
ansiStr = (char*) malloc(20);
strcpy(ansiStr,(array[i].boolVal == VARIANT_TRUE) ? "TRUE":"FALSE");
break;
/* integer data */
case VT_I2: /* 2-byte signed integer (iVal) */
ansiStr = (char*) malloc(20);
sprintf(ansiStr,"%d",array[i].iVal);
break;
/* integer data */
case VT_I4: /* 4-byte signed integer (lVal) */
ansiStr = (char*) malloc(20);
sprintf(ansiStr,"%ld",array[i].lVal);
break;
case VT_UI1: /* unsigned one-byte integer (bVal) */
ansiStr = (char*) malloc(20);
sprintf(ansiStr,"%d",array[i].bVal);
break;
case VT_R4: /* 4-byte IEEE floating point (fltVal) */
ansiStr = (char*) malloc(20);
sprintf(ansiStr,"%f",array[i].fltVal);
break;
case VT_R8: /* 8-byte IEEE floating point (dblVal) */
ansiStr = (char*) malloc(20);
sprintf(ansiStr,"%f",array[i].dblVal);
break;
/* string data */
case VT_BSTR:
ansiStr = BSTR2ANSI (array[i].bstrVal);
break;
default:
RCOM_ERR(printf("Variant2SEXP: unknown VARTYPE %d\n",
array[i].vt & VT_TYPEMASK));
ansiStr = (char*) malloc(1);
ansiStr[0] = 0x0;
break;
}
// SEXP strsexp = allocString (strlen(ansiStr));
// PROTECT (strsexp); protCnt++;
// strcpy (CHAR(strsexp),ansiStr);
SET_STRING_ELT(*sexp,i, mkChar(ansiStr));
free (ansiStr);
}
break;
default:
SafeArrayUnlock (variant->parray);
UNPROTECT(protCnt);
return FALSE;
}
SafeArrayUnlock (variant->parray);
UNPROTECT(protCnt);
return TRUE;
}
default:
RCOM_ERR(printf("Variant2SEXP: failed because of unsupported data type
%08x,%08x\n",
variant->vt,variant->vt & VT_TYPEMASK));
UNPROTECT(protCnt);
return FALSE;
}
RCOM_TRACE(printf("Array done\n"));
} else {
switch (variant->vt & VT_TYPEMASK) {
/* boolean data */
case VT_BOOL: /* boolean: 0x0000 is false, 0xffff is true (boolVal) */
*sexp = PROTECT (allocVector (LGLSXP,1)); protCnt++;
LOGICAL(*sexp)[0] = (variant->boolVal == VARIANT_TRUE) ? 1 : 0;
break;
/* integer data */
case VT_I2: /* 2-byte signed integer (iVal) */
*sexp = PROTECT (allocVector (INTSXP,1)); protCnt++;
INTEGER(*sexp)[0] = variant->iVal;
break;
/* integer data */
case VT_I4: /* 4-byte signed integer (lVal) */
*sexp = PROTECT (allocVector (INTSXP,1)); protCnt++;
INTEGER(*sexp)[0] = variant->lVal;
break;
case VT_UI1: /* unsigned one-byte integer (bVal) */
*sexp = PROTECT (allocVector (INTSXP,1)); protCnt++;
INTEGER(*sexp)[0] = variant->bVal;
break;
case VT_R4: /* 4-byte IEEE floating point (fltVal) */
*sexp = PROTECT (allocVector (REALSXP,1)); protCnt++;
REAL(*sexp)[0] = variant->fltVal;
break;
case VT_R8: /* 8-byte IEEE floating point (dblVal) */
*sexp = PROTECT (allocVector (REALSXP,1)); protCnt++;
REAL(*sexp)[0] = variant->dblVal;
break;
/* string data */
case VT_BSTR: {
char* ansiStr = BSTR2ANSI (variant->bstrVal);
// SEXP strsexp = allocString (strlen(ansiStr));
// PROTECT (strsexp); protCnt++;
// strcpy (CHAR(strsexp),ansiStr);
*sexp = PROTECT (allocVector (STRSXP,1)); protCnt++;
SET_STRING_ELT(*sexp, 0, mkChar(ansiStr));
free (ansiStr);
break;
}
/* a COM object (dispatch) */
case VT_DISPATCH: {
RCOM_OBJHANDLE handle = com_addObject (variant->pdispVal);
/* the object will be release()d when the variant is destroyed. */
#ifdef __cplusplus
variant->pdispVal->AddRef();
#else
variant->pdispVal->lpVtbl->AddRef(variant->pdispVal);
#endif
*sexp = com_createSEXP(handle);
break;
}
case VT_VARIANT: {
RCOM_TRACE(printf("Variant2SEXP: what's that? VT_VARIANT?\n"));
UNPROTECT(protCnt);
return FALSE;
}
default:
UNPROTECT(protCnt);
return FALSE;
}
}
UNPROTECT (protCnt);
return TRUE;
}
#endif
_______________________________________________
Rcom-l mailing list
Rcom-l@mailman.csd.univie.ac.at
http://mailman.csd.univie.ac.at/mailman/listinfo/rcom-l
More information (including a Wiki) at http://rcom.univie.ac.at
