New subject: [Bug 53766] vbscript fails to handle SAFEARRAY assignment, access, UBounds, LBounds

8 Oct 2022


      https://bugs.winehq.org/show_bug.cgi?id=53766
Bug ID: 53766
           Summary: vbscript fails to handle SAFEARRAY assignment, access,
                    UBounds, LBounds
           Product: Wine
           Version: 7.16
          Hardware: x86-64
                OS: Linux
            Status: UNCONFIRMED
          Severity: normal
          Priority: P2
         Component: vbscript
          Assignee: wine-bugs@winehq.org
          Reporter: jsm174@gmail.com
      Distribution: ---
While working on leveraging the vbscript engine of Wine for a macos/linux port
of Visual Pinball, I finally have the example table working and am starting to
work through the runtime errors.
The table script requests an array of balls on the table and uses that array to
drop ball shadows and generate rolling sounds.
Take the following code:
Const tnob = 5
Dim rolling()
ReDim rolling(tnob)
Sub RollingTimer_Timer()
    Dim BOT, b
    BOT = GetBalls
For b = 0 to UBound(BOT)
       If BOT(b).z < 30 Then
          rolling(b) = True
       End If
    Next
End Sub
GetBalls is in the application code and returns a SAFEARRAY of IDispatch
pointers:
STDMETHODIMP ScriptGlobalTable::GetBalls(LPSAFEARRAY *pVal)
Currently this will fail at BOT assign_value because VariantCopyInd calls
VariantCopy which calls VARIANT_ValidateType which then returns
DISP_E_BADVARTYPE
I believe I have this now working but I'm not sure if it would impact anything
else for an official patch:
inc/wine/dlls/oleaut32/variant.c:
HRESULT WINAPI VariantCopy(VARIANTARG* pvargDest, const VARIANTARG* pvargSrc)
{
  HRESULT hres = S_OK;
TRACE("(%s,%s)\n", debugstr_variant(pvargDest), debugstr_variant(pvargSrc));
#ifndef __SAFEARRAYFIX__
  if (V_TYPE(pvargSrc) == VT_CLSID || /* VT_CLSID is a special case */
      FAILED(VARIANT_ValidateType(V_VT(pvargSrc))))
    return DISP_E_BADVARTYPE;
#else
  if (V_TYPE(pvargSrc) != VT_SAFEARRAY && (V_TYPE(pvargSrc) == VT_CLSID || /*
VT_CLSID is a special case */
      FAILED(VARIANT_ValidateType(V_VT(pvargSrc)))))
    return DISP_E_BADVARTYPE;
#endif
if (pvargSrc != pvargDest &&
      SUCCEEDED(hres = VariantClear(pvargDest)))
  {
    *pvargDest = *pvargSrc; /* Shallow copy the value */
if (!V_ISBYREF(pvargSrc))
    {
      switch (V_VT(pvargSrc))
      {
      case VT_BSTR:
        V_BSTR(pvargDest) = SysAllocStringByteLen((char*)V_BSTR(pvargSrc),
SysStringByteLen(V_BSTR(pvargSrc)));
        if (!V_BSTR(pvargDest))
          hres = E_OUTOFMEMORY;
        break;
      case VT_RECORD:
        hres = VARIANT_CopyIRecordInfo(pvargDest, pvargSrc);
        break;
      case VT_DISPATCH:
      case VT_UNKNOWN:
        V_UNKNOWN(pvargDest) = V_UNKNOWN(pvargSrc);
        if (V_UNKNOWN(pvargSrc))
          IUnknown_AddRef(V_UNKNOWN(pvargSrc));
        break;
#ifdef __SAFEARRAYFIX__
      case VT_SAFEARRAY:
         hres = SafeArrayCopy(V_ARRAY(pvargSrc), &V_ARRAY(pvargDest));
         break;
#endif
      default:
        if (V_ISARRAY(pvargSrc))
          hres = SafeArrayCopy(V_ARRAY(pvargSrc), &V_ARRAY(pvargDest));
      }
    }
  }
  return hres;
}
inc/wine/dlls/vbscript/interp.c:
static HRESULT variant_call(exec_ctx_t *ctx, VARIANT *v, unsigned arg_cnt,
VARIANT *res)
{
    SAFEARRAY *array = NULL;
    DISPPARAMS dp;
    HRESULT hres;
TRACE("%s\n", debugstr_variant(v));
if(V_VT(v) == (VT_VARIANT|VT_BYREF))
        v = V_VARIANTREF(v);
switch(V_VT(v)) {
    case VT_ARRAY|VT_BYREF|VT_VARIANT:
        array = *V_ARRAYREF(v);
        break;
    case VT_ARRAY|VT_VARIANT:
        array = V_ARRAY(v);
        break;
#ifdef __SAFEARRAYFIX__
    case VT_SAFEARRAY:
        array = V_ARRAY(v);
        break;
#endif
    case VT_DISPATCH:
        vbstack_to_dp(ctx, arg_cnt, FALSE, &dp);
        hres = disp_call(ctx->script, V_DISPATCH(v), DISPID_VALUE, &dp, res);
        break;
    default:
        FIXME("unsupported on %s\n", debugstr_variant(v));
        return E_NOTIMPL;
    }
if(array) {
        if(!res) {
            FIXME("no res\n");
            return E_NOTIMPL;
        }
vbstack_to_dp(ctx, arg_cnt, FALSE, &dp);
        hres = array_access(ctx, array, &dp, &v);
        if(FAILED(hres))
            return hres;
V_VT(res) = VT_BYREF|VT_VARIANT;
        V_BYREF(res) = v;
    }
stack_popn(ctx, arg_cnt);
    return S_OK;
}
inc/wine/dlls/vbscript/global.c:
static HRESULT Global_UBound(BuiltinDisp *This, VARIANT *arg, unsigned
args_cnt, VARIANT *res)
{
    SAFEARRAY *sa;
    HRESULT hres;
    LONG ubound;
    int dim;
assert(args_cnt == 1 || args_cnt == 2);
TRACE("%s %s\n", debugstr_variant(arg), args_cnt == 2 ?
debugstr_variant(arg + 1) : "1");
switch(V_VT(arg)) {
    case VT_VARIANT|VT_ARRAY:
        sa = V_ARRAY(arg);
        break;
    case VT_VARIANT|VT_ARRAY|VT_BYREF:
        sa = *V_ARRAYREF(arg);
        break;
#ifdef __SAFEARRAYFIX__
    case VT_SAFEARRAY:
        sa = V_ARRAY(arg);
        break;
#endif
    default:
        FIXME("arg %s not supported\n", debugstr_variant(arg));
        return E_NOTIMPL;
    }
static HRESULT Global_LBound(BuiltinDisp *This, VARIANT *arg, unsigned
args_cnt, VARIANT *res)
{
    SAFEARRAY *sa;
    HRESULT hres;
    LONG ubound;
    int dim;
assert(args_cnt == 1 || args_cnt == 2);
TRACE("%s %s\n", debugstr_variant(arg), args_cnt == 2 ?
debugstr_variant(arg + 1) : "1");
switch(V_VT(arg)) {
    case VT_VARIANT|VT_ARRAY:
        sa = V_ARRAY(arg);
        break;
    case VT_VARIANT|VT_ARRAY|VT_BYREF:
        sa = *V_ARRAYREF(arg);
        break;
#ifdef __SAFEARRAYFIX__
    case VT_SAFEARRAY:
        sa = V_ARRAY(arg);
        break;
#endif
    default:
        FIXME("arg %s not supported\n", debugstr_variant(arg));
        return E_NOTIMPL;
    }
-- 
Do not reply to this email, post in Bugzilla using the
above URL to reply.
You are receiving this mail because:
You are watching all bug changes.

[Bug 53766] New: vbscript fails to handle SAFEARRAY assignment, access, UBounds, LBounds