vuint wtou_test(const WString& string, bool& success)
{
wchar_t* endptr = 0;
vuint result = wcstoul(string.Buffer(), &endptr, 10);
success = endptr == string.Buffer() + string.Length() && utow(result) == string;
return result;
}
//! 64 bit problems - com and dll interface is 32 bit - needs test and thought
static int a2v (J jt, A a, VARIANT *v, int dobstrs)
{
SAFEARRAY FAR* psa;
SAFEARRAYBOUND rgsabound[MAXRANK];
int er;
I i,r,k,kw,t,cb,*pi;
VARTYPE vt;
k=AN(a);
pi=AV(a);
r=AR(a);
t=NOUN&AT(a);
if(r>MAXRANK) return EVRANK;
if(dobstrs && r<2 && (t&LIT+C2T+C4T)) // char scalar or vector returned as BSTR
{
WCHAR *wstr;
BSTR bstr;
if (LIT&t) {
wstr = malloc(sizeof(WCHAR)*k);
kw=tounin((C*)pi, k, wstr, k);
bstr = SysAllocStringLen(wstr, (UINT)kw);
} else if (C4T&t) {
kw=utowsize((C4*)pi, k);
kw=(kw<0)?(-kw):kw;
wstr = malloc(sizeof(WCHAR)*kw);
utow((C4*)pi, k, wstr);
bstr = SysAllocStringLen(wstr, (UINT)kw);
} else
bstr = SysAllocStringLen((WCHAR*)pi, (UINT)k);
v->vt=VT_BSTR;
v->bstrVal=bstr;
if (t&LIT+C4T) free(wstr);
R 0;
}
switch(t)
{
case LIT:
if(!r) {v->vt=VT_UI1; v->bVal = *(C*)pi; return 0;}
vt=VT_UI1;
cb=k*sizeof(char);
break;
case C2T:
if(!r) {v->vt=VT_UI2; v->iVal = *(WCHAR*)pi; return 0;}
vt=VT_UI2;
cb=k*sizeof(WCHAR);
break;
case C4T:
if(!r) {v->vt=VT_UI4; v->iVal = *(UI4*)pi; return 0;}
vt=VT_UI4;
cb=k*sizeof(C4);
break;
case B01:
if(!r) {
v->vt=VT_BOOL;
v->boolVal = *(B*)pi ? VARIANT_TRUE : VARIANT_FALSE;
return 0;
}
vt=VT_BOOL;
break;
case INT:
#if SY_64
if(jt->int64flag) {
if(!r) {v->vt=VT_I8; v->llVal = (I)(*pi); return 0;}
vt=VT_I8;
cb=k*sizeof(long long);
} else {
if(!r) {v->vt=VT_I4; v->lVal = (int)(*pi); return 0;}
vt=VT_I4;
cb=k*sizeof(int);
}
#else
if(!r) {v->vt=VT_I4; v->lVal = (I)(*pi); return 0;}
vt=VT_I4;
cb=k*sizeof(int);
#endif
break;
case FL:
if(!r) {v->vt=VT_R8; v->dblVal = *(D*)pi; return 0;}
vt=VT_R8;
cb=k*sizeof(double);
break;
case BOX:
if(!r)
{
// Pass a scalar box as a 1-elem VARIANT VT_ARRAY.
// It's marked as such by a lower bound set at -1.
// (All "true" boxed arrays will have the usual lb 0.)
rgsabound[0].lLbound = -1;
rgsabound[0].cElements = 1;
if ( ! (psa = SafeArrayCreate (VT_VARIANT, 1, rgsabound)))
return EVWSFULL;
if (0!= (er = a2v (jt, *(A*)pi, (VARIANT*)psa->pvData, dobstrs)))
{
SafeArrayDestroy (psa);
return er;
}
v->vt=VT_ARRAY|VT_VARIANT;
v->parray = psa;
return 0;
}
vt=VT_VARIANT;
cb=k*sizeof(A);
break;
default:
return EVDOMAIN;
}
if(1<r && jt->transposeflag)
RE(a=cant1(a)); // undo shape reversal later!
for(i=0; i<r; ++i)
{
rgsabound[i].lLbound = 0;
// undo shape reversal from cant1() here.
// In case of Transpose(0), the shape is
// still passed in Column-major notation.
rgsabound[i].cElements = (ULONG)AS(a)[r-1-i];
}
psa = SafeArrayCreate(vt, (UINT)r, rgsabound);
if(!psa)
{
return EVWSFULL;
}
switch (NOUN&AT(a))
{
case B01:
{
VARIANT_BOOL *pv = (VARIANT_BOOL*) psa->pvData;
B *ap = BAV(a);
while (k--)
*pv++ = *ap++ ? VARIANT_TRUE : VARIANT_FALSE;
break;
}
case BOX:
{
A* ap;
VARIANT *v;
for (ap=AAV(a), SafeArrayAccessData(psa, &v);
ap<AAV(a)+k;
++ap, ++v)
{
PROLOG(0118);
er=a2v (jt, *ap, v, dobstrs);
tpop(_ttop);
if (er!=0)
{
SafeArrayUnaccessData (psa);
SafeArrayDestroy (psa);
return er;
}
}
SafeArrayUnaccessData (psa);
break;
}
#if SY_64
case INT:
{
if (!jt->int64flag) {
long *p1=psa->pvData;
I *p2=AV(a);
while (k--)
*p1++=(long)*p2++;
}
break;
}
#endif
default:
memcpy(psa->pvData, AV(a), cb);
}
v->vt=VT_ARRAY|vt;
v->parray = psa;
return 0;
}