From 6527b4a979285b32bd754adc0190eb76a3d6eeb9 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Wed, 19 Dec 2007 00:57:44 +0000 Subject: [PATCH] Support conversion of binary data and lists into arrays --- src/invoke.c | 126 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 80 insertions(+), 46 deletions(-) diff --git a/src/invoke.c b/src/invoke.c index 6bdb67b..45d0ee8 100644 --- a/src/invoke.c +++ b/src/invoke.c @@ -71,6 +71,10 @@ SafeArrayToObj(Tcl_Interp *interp, return hr; } +/* + * Convert a VARIANT into a Tcl object + */ + HRESULT OleVariantObj(Tcl_Interp *interp, const VARIANT *vPtr, Tcl_Obj **resultPtrPtr) { @@ -140,21 +144,89 @@ OleVariantObj(Tcl_Interp *interp, const VARIANT *vPtr, Tcl_Obj **resultPtrPtr) return hr; } +/* + * Convert a Tcl object into a VARIANT. + * NOTE: needs better error handling. + */ + +HRESULT +OleTclToVariant(Tcl_Obj *objPtr, VARIANT *argPtr) +{ + HRESULT hr = S_FALSE; + VariantInit(argPtr); + if (objPtr->typePtr != NULL) { + if (objPtr->typePtr == tclTypes[tclBooleanIndex]) { + int b; + Tcl_GetBooleanFromObj(NULL, objPtr, &b); + argPtr->boolVal = (b ? VARIANT_TRUE : VARIANT_FALSE); + argPtr->vt = VT_BOOL; + } else if (objPtr->typePtr == tclTypes[tclIntegerIndex]) { + Tcl_GetLongFromObj(NULL, objPtr, &argPtr->lVal); + argPtr->vt = VT_I4; + } else if (objPtr->typePtr == tclTypes[tclDoubleIndex]) { + Tcl_GetDoubleFromObj(NULL, objPtr, &argPtr->dblVal); + argPtr->vt = VT_R8; + } else if (objPtr->typePtr == tclTypes[tclByteArrayIndex]) { + int count = 0; + unsigned char *bytesPtr, *arrayPtr; + bytesPtr = Tcl_GetByteArrayFromObj(objPtr, &count); + argPtr->parray = SafeArrayCreateVectorEx(VT_UI1, 0, count, NULL); + SafeArrayAccessData(argPtr->parray, (void **)&arrayPtr); + memcpy(arrayPtr, bytesPtr, count); + SafeArrayUnaccessData(argPtr->parray); + argPtr->vt = VT_ARRAY | VT_UI1; + } else if (objPtr->typePtr == tclTypes[tclListIndex]) { + int count = 0, n = 0; + Tcl_Obj **eltv = NULL; + VARIANT *varPtr = NULL; + Tcl_ListObjGetElements(NULL, objPtr, &count, &eltv); + argPtr->parray = SafeArrayCreateVectorEx(VT_VARIANT, 0, count, NULL); + SafeArrayAccessData(argPtr->parray, (void **)&varPtr); + for (n = 0; n < count; ++n, ++varPtr) { + OleTclToVariant(eltv[n], varPtr); + } + SafeArrayUnaccessData(argPtr->parray); + argPtr->vt = VT_ARRAY | VT_VARIANT; + } else if (objPtr->typePtr == &tclVariantType) { + VariantCopy(argPtr, GET_VARIANTREP(objPtr)); + argPtr->vt = VT_VARIANT; + } else if (objPtr->typePtr == tclTypes[tclCmdNameIndex]) { + OleObjectData *dataPtr = GET_OLEREP(objPtr); + if (dataPtr && dataPtr->magic == OLEDATAMAGIC) { + argPtr->pdispVal = dataPtr->dispatchPtr; + argPtr->pdispVal->lpVtbl->AddRef(argPtr->pdispVal); + argPtr->vt = VT_DISPATCH; + } + } + } + if (argPtr->vt == VT_EMPTY) { + LPOLESTR olestr = NULL; + Tcl_DString ds; + int len = 0, len_ucs = 0; + const char *str = Tcl_GetStringFromObj(objPtr, &len); + Tcl_DStringInit(&ds); + Tcl_UtfToUniCharDString(str, len, &ds); + len_ucs = Tcl_UniCharLen((const Tcl_UniChar *)Tcl_DStringValue(&ds)); + olestr = (LPOLESTR)Tcl_DStringValue(&ds); + argPtr->bstrVal = SysAllocStringLen(olestr, len_ucs); + argPtr->vt = VT_BSTR; + Tcl_DStringFree(&ds); + } + return hr; +} + static DISPPARAMS * OleDispParamsCreate(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - OlePackageData *pkgPtr = NULL; - DISPPARAMS * dp = NULL; - int cn = 0; - - pkgPtr = Tcl_GetAssocData(interp, "ole::package", NULL); - - dp = (DISPPARAMS*)ckalloc(sizeof(DISPPARAMS)); + DISPPARAMS *dp = (DISPPARAMS*)ckalloc(sizeof(DISPPARAMS)); if (dp != NULL) { + int cn = 0; + dp->cArgs = objc; dp->cNamedArgs = 0; dp->rgdispidNamedArgs = NULL; dp->rgvarg = NULL; + if (objc > 0) { dp->rgvarg = (VARIANT*)ckalloc(sizeof(VARIANT) * dp->cArgs); } @@ -162,47 +234,9 @@ OleDispParamsCreate(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) /* Note: this array is filled backwards */ for (cn = 0; cn < objc; cn++) { Tcl_Obj *objPtr = objv[objc - cn - 1]; - Tcl_ObjType *typePtr = NULL; VARIANT *argPtr = &dp->rgvarg[cn]; - VariantInit(argPtr); - if (objPtr->typePtr != NULL) { - if (objPtr->typePtr == tclTypes[tclBooleanIndex]) { - int b; - Tcl_GetBooleanFromObj(NULL, objPtr, &b); - argPtr->boolVal = (b ? VARIANT_TRUE : VARIANT_FALSE); - argPtr->vt = VT_BOOL; - } else if (objPtr->typePtr == tclTypes[tclIntegerIndex]) { - Tcl_GetLongFromObj(NULL, objPtr, &argPtr->lVal); - argPtr->vt = VT_I4; - } else if (objPtr->typePtr == tclTypes[tclDoubleIndex]) { - Tcl_GetDoubleFromObj(NULL, objPtr, &argPtr->dblVal); - argPtr->vt = VT_R8; - } else if (objPtr->typePtr == &tclVariantType) { - VariantCopy(argPtr, GET_VARIANTREP(objPtr)); - argPtr->vt = VT_VARIANT; - } else if (objPtr->typePtr == tclTypes[tclCmdNameIndex]) { - OleObjectData *dataPtr = GET_OLEREP(objPtr); - if (dataPtr && dataPtr->magic == OLEDATAMAGIC) { - argPtr->pdispVal = dataPtr->dispatchPtr; - argPtr->pdispVal->lpVtbl->AddRef(argPtr->pdispVal); - argPtr->vt = VT_DISPATCH; - } - } - } - if (argPtr->vt == VT_EMPTY) { - LPOLESTR olestr = NULL; - Tcl_DString ds; - int len = 0, len_ucs = 0; - const char *str = Tcl_GetStringFromObj(objPtr, &len); - Tcl_DStringInit(&ds); - Tcl_UtfToUniCharDString(str, len, &ds); - len_ucs = Tcl_UniCharLen((const Tcl_UniChar *)Tcl_DStringValue(&ds)); - olestr = (LPOLESTR)Tcl_DStringValue(&ds); - argPtr->bstrVal = SysAllocStringLen(olestr, len_ucs); - argPtr->vt = VT_BSTR; - Tcl_DStringFree(&ds); - } + OleTclToVariant(objPtr, argPtr); } } return dp; -- 2.23.0