From: Pat Thoyts <patthoyts@users.sourceforge.net>
Date: Wed, 19 Dec 2007 00:57:44 +0000 (+0000)
Subject: Support conversion of binary data and lists into arrays
X-Git-Tag: tclole-0-4~1
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=6527b4a979285b32bd754adc0190eb76a3d6eeb9;p=tclole

Support conversion of binary data and lists into arrays
---

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;