/* 
Author:  David Zimmer <dzzie@yahoo.com>
Site:    http://sandsprite.com

Notes: Not all COM types are currently handled, but enough to be useful
this is still a bit of work in progress. I will make additions as
I use it and find it necessary.

Script Basic Declarations to use this extension:

declare sub CreateObject alias "CreateObject" lib "test.exe"
declare sub CallByName alias "CallByName" lib "test.exe"
declare sub ReleaseObject alias "ReleaseObject" lib "test.exe"
declare sub TypeName alias "TypeName" lib "test.exe"
declare sub DescribeInterface alias "DescribeInterface" lib "test.exe"

const VbGet = 2
const VbLet = 4
const VbMethod = 1
const VbSet = 8

Example:

'you can load objects either by ProgID or CLSID
'obj = CreateObject("SAPI.SpVoice") 
obj = CreateObject("{96749377-3391-11D2-9EE3-00C04F797396}")

if obj = 0 then 
print "CreateObject failed!\n"
else
CallByName(obj, "rate", VbLet, 2)
CallByName(obj, "volume", VbLet, 60)
CallByName(obj, "speak", VbMethod, "This is my test")
ReleaseObject(obj)
end if 

*/

#include <stdio.h>
#include <list>
#include <string>
#include <map>

#include <comdef.h> 
#include <AtlBase.h>
#include <AtlConv.h>
#include <atlsafe.h>

#include "basext.h"

int           com_dbg = 0;
int           initilized = 0;
pSupportTable g_pSt = NULL;

#define nullptr NULL 
#define EXPORT comment(linker, "/EXPORT:"__FUNCTION__"="__FUNCDNAME__)

extern HRESULT TypeName(IDispatch* pDisp, std::string *retVal);
extern void __stdcall DescribeInterface(IDispatch* pDisp);

//vbCallType aligns with DISPATCH_XX values for Invoke
enum vbCallType{ VbGet = 2, VbLet = 4, VbMethod = 1, VbSet = 8 };
enum colors{ mwhite=15, mgreen=10, mred=12, myellow=14, mblue=9, mcyan=11, mpurple=5, mgrey=7, mdkgrey=8 };

//char* to wide string
LPWSTR __C2W(char *szString){
  DWORD n;
  char *sz = NULL;
  LPWSTR ws= NULL;
  if(*szString && szString){
    sz = strdup(szString);
    n = MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, sz, -1, NULL, 0);
    if(n){
      ws = (LPWSTR)malloc(n*2);
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, sz, -1, ws, n);
    }
  }
  free(sz);
  return ws;
}

// BSTR to C String conversion
char* __B2C(BSTR bString)
{
  int i;
  int n = (int)SysStringLen(bString);
  char *sz;
  sz = (char *)malloc(n + 1);

  for(i = 0; i < n; i++){
    sz[i] = (char)bString[i];
  }
  sz[i] = 0;
  return sz;
}

//script basic STRING type to char*
char* GetCString(VARIABLE v){

  int   slen;
  char* s;
  char* myCopy = NULL;

  s = STRINGVALUE(v);
  slen = STRLEN(v);
  if(slen==0)
    return strdup("");

  myCopy = (char*)malloc(slen+1);
  if(myCopy==0)
    return 0;

  memcpy(myCopy,s, slen);
  myCopy[slen]=0;
  return myCopy;

}


void color_printf(colors c, const char *format, ...)
{
  DWORD dwErr = GetLastError();
  HANDLE hConOut = GetStdHandle( STD_OUTPUT_HANDLE );

  if(format){
    char    buf[1024]; 
    va_list args; 
    va_start(args,format); 
    try{
      _vsnprintf(buf,1024,format,args);
      SetConsoleTextAttribute(hConOut, c);
      printf("%s",buf);
      SetConsoleTextAttribute(hConOut,7); 
    }
    catch(...){}
  }

  SetLastError(dwErr);
}

VARIANT __stdcall SBCallBackEx(int EntryPoint, VARIANT *pVal)
{
#pragma EXPORT

  pSupportTable pSt = g_pSt;
  VARIABLE      FunctionResult;
  _variant_t    vRet;

  if(pSt == NULL){
    MessageBox(0, "pSupportTable is not set?", "", 0);
    return vRet.Detach();
  }

  USES_CONVERSION;
  char        buf[1024] = {0};
  long        lResult;
  long        lb;
  long        ub;
  SAFEARRAY*  pSA = NULL;

  //we only accept variant arrays..
  if (V_VT(pVal) == (VT_ARRAY | VT_VARIANT | VT_BYREF)) //24588
    pSA = *(pVal->pparray); 
  //else if (V_ISARRAY(pVal) && V_ISBYREF(pVal)) //array of longs here didnt work out maybe latter
  //	pSA = *(pVal->pparray); 
  else { 
    if (V_VT(pVal) == (VT_ARRAY | VT_VARIANT)) 
      pSA = pVal->parray; 
    else 
      return vRet.Detach();//"Type Mismatch [in] Parameter." 
  };

  long dim = SafeArrayGetDim(pSA);
  if(dim != 1)
    return vRet.Detach();

  lResult = SafeArrayGetLBound(pSA, 1, &lb);
  lResult = SafeArrayGetUBound(pSA, 1, &ub);

  lResult = SafeArrayLock(pSA);
  if(lResult)
    return vRet.Detach();

  _variant_t  vOut;
  _bstr_t     cs; 
  int         sz = ub-lb+1;
  VARIABLE    pArg = besNEWARRAY(0,sz);

  //here we proxy the array of COM types into the array of script basic types element by element.
  //	note this we only support longs and strings. floats will be rounded, objects converted to objptr()
  //  bytes and integers are ok too..basically just not float and currency..which SB doesnt support anyway..
  for (long l=lb; l<=ub; l++) {
    if( SafeArrayGetElement(pSA, &l, &vOut) == S_OK ){
      if(vOut.vt == VT_BSTR){
        char* cstr = __B2C(vOut.bstrVal);
        int   slen = strlen(cstr);

        pArg->Value.aValue[l] = besNEWMORTALSTRING(slen);
        memcpy(STRINGVALUE(pArg->Value.aValue[l]),cstr,slen);
        free(cstr);
      }
      else{
        if(vOut.vt == VT_DISPATCH){
          //todo register handle? but how do we know the lifetime of it..
          //might only be valid until this exits, or forever?
        }
        pArg->Value.aValue[l] = besNEWMORTALLONG;
        LONGVALUE(pArg->Value.aValue[l]) = vOut.lVal;
      }
    }
  }

  lResult = SafeArrayUnlock(pSA);
  if (lResult)
    return vRet.Detach();

  besHOOK_CALLSCRIBAFUNCTION(EntryPoint,
    pArg->Value.aValue,
    sz,
    &FunctionResult);

  for (long l=0; l <= sz; l++) {
    besRELEASE(pArg->Value.aValue[l]);
    pArg->Value.aValue[l] = NULL;
  }

  if(FunctionResult->vType == VTYPE_STRING){
    char* myStr = GetCString(FunctionResult);

    vRet.SetString(myStr);
    free(myStr);
  }
  else{
    switch( TYPE(FunctionResult) ){	  
      case VTYPE_DOUBLE:
      case VTYPE_ARRAY:
      case VTYPE_REF:
        MessageBoxA(0, "Arguments of SB types [double, ref, array] not supported!", "Error", 0);
        break;
      default:
        vRet = LONGVALUE(FunctionResult);
    }
  }

  besRELEASE(pArg);
  besRELEASE(FunctionResult);

  return vRet.Detach();
}


int __stdcall SBCallBack(int EntryPoint, int arg)
{
#pragma EXPORT

  pSupportTable pSt = g_pSt;
  VARIABLE FunctionResult;
  VARIABLE pArg;
  VARIABLE arg0 = besNEWMORTALLONG;
  int retVal;

  if(pSt==NULL){
    MessageBox(0,"pSupportTable is not set?","",0);
    return -1;
  }

  arg0->Value.lValue = arg;
  arg0->vType = VTYPE_LONG;
  pArg = besNEWARRAY(0,0);
  pArg->Value.aValue[0] = arg0;

  //#define besHOOK_CALLSCRIBAFUNCTION(X,Y,Z,W) (pSt->pEo->pHookers->HOOK_CallScribaFunction(pSt->pEo,(X),(Y),(Z),(W)))
  //int (*HOOK_CallScribaFunction)(pExecuteObject, unsigned long, pFixSizeMemoryObject *, unsigned long, pFixSizeMemoryObject *);

  besHOOK_CALLSCRIBAFUNCTION(EntryPoint,
    pArg->Value.aValue,
    1,
    &FunctionResult);

  retVal = FunctionResult->Value.lValue;
  besRELEASE(pArg);
  besRELEASE(FunctionResult);

  return retVal;
}



/*besVERSION_NEGOTIATE
int versmodu(int Version, char *pszVariation, void **ppModuleInternal)
{
#pragma EXPORT

printf("The function bootmodu was started and the requested version is %d\n",Version);
printf("The variation is: %s\n",pszVariation);
printf("We are returning accepted version %d\n",(int)INTERFACE_VERSION);
return (int)INTERFACE_VERSION; //2.1 uses version 11, 2.2 also uses version 11 but structure has changed

}*/

//note the braces..required so if(x)RETURN0(msg) uses the whole blob 
//should this be goto cleanup instead of return 0? 
#define RETURN0(msg) {if(com_dbg) color_printf(mred, "%s\n", msg); \
  LONGVALUE(besRETURNVALUE) = 0; \
  goto cleanup;}

besFUNCTION(TypeName)

  VARIABLE  Argument ;
  char*     unk = "Failed";

  besRETURNVALUE = besNEWMORTALLONG;

  if( besARGNR != 1)
    RETURN0("TypeName takes one argument!") 

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  if( TYPE(Argument) != VTYPE_LONG)
    RETURN0("TypeName requires a long argument!")
  if( LONGVALUE(Argument) == 0)
    RETURN0("TypeName(NULL) called!")

  IDispatch* IDisp = (IDispatch*)LONGVALUE(Argument);

  try{
    std::string retVal;
    if(TypeName(IDisp, &retVal) == S_OK){
      besALLOC_RETURN_STRING(retVal.length());
      memcpy(STRINGVALUE(besRETURNVALUE), retVal.c_str(), retVal.length());
    }
    else{
      besALLOC_RETURN_STRING(strlen(unk));
      memcpy(STRINGVALUE(besRETURNVALUE), unk, strlen(unk));
    }
  }
  catch(...){
    RETURN0("Invalid IDisp pointer?")
  }

cleanup:

besEND

besFUNCTION(DescribeInterface)

  VARIABLE  Argument ;
  char*     unk = "Failed";

  besRETURNVALUE = besNEWMORTALLONG;

  if( besARGNR != 1)
    RETURN0("DescribeInterface takes one argument!") 

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  if( TYPE(Argument) != VTYPE_LONG)
    RETURN0("DescribeInterface requires a long argument!")
  if( LONGVALUE(Argument) == 0)
    RETURN0("DescribeInterface(NULL) called!")

  IDispatch* IDisp = (IDispatch*)LONGVALUE(Argument);

  try{
    DescribeInterface(IDisp);
  }
  catch(...){
    RETURN0("DescribeInterface threw an error?")
  }

cleanup:

besEND

//ReleaseObject(obj)
besFUNCTION(ReleaseObject)

  VARIABLE Argument ;

  besRETURNVALUE = besNEWMORTALLONG;

  if( besARGNR != 1)
    RETURN0("ReleaseObject takes one argument!") 

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  if( TYPE(Argument) != VTYPE_LONG)
    RETURN0("ReleaseObject requires a long argument!")
  if( LONGVALUE(Argument) == 0)
    RETURN0("ReleaseObject(NULL) called!")

  IDispatch* IDisp = (IDispatch*)LONGVALUE(Argument);

  try{
    IDisp->Release();
  }
  catch(...){
    RETURN0("Invalid IDisp pointer?")
  }

  Argument->Value.lValue = 0;

cleanup:

besEND

bool isValidIDisp(IDispatch* pDisp)
{
    HRESULT hr = S_OK;

    if (!pDisp)
        return false; // NULL ptr to interface
    
    CComPtr<ITypeInfo> spTypeInfo;
    hr = pDisp->GetTypeInfo(0, 0, &spTypeInfo); // make it do something useful

    if(SUCCEEDED(hr))
       return true; // interface is alive and kickin' ...

    return false; // ... else dead and gone
}

//MLL: Object CreateObject(:SET, "ProgID")
besFUNCTION(CreateObject)

  char*       myCopy = NULL;
  LPWSTR      wStr = NULL;
  VARIABLE    arg_obj;
  CLSID       clsid;
  HRESULT     hr;
  IDispatch*  IDisp = NULL;

  besRETURNVALUE = besNEWMORTALLONG;

  if (com_dbg)
    color_printf(myellow, "\nCreateObject %ld args\n", besARGNR);

  if (besARGNR < 2)
    RETURN0("CreateObject requires 2 args!") 

  arg_obj = besARGUMENT(1);
  besDEREFERENCE(arg_obj);

  // MLL: VB-like ssyntactic sugar
  if ( TYPE(arg_obj) != VTYPE_LONG || LONGVALUE(arg_obj) != VbSet)
    RETURN0("CreateObject 1st argument must be a :SET!")

  arg_obj = besARGUMENT(2);
  besDEREFERENCE(arg_obj);

  if ( TYPE(arg_obj) != VTYPE_STRING)
    RETURN0("CreateObject 2nd argument must be a string!")

  if ( arg_obj->Size == 0)
    RETURN0("CreateObject 2nd argument is empty!")

  if (!initilized) {
    CoInitialize(NULL);
    initilized = 1;
  }

  myCopy = GetCString(arg_obj);
  if (!myCopy)
    RETURN0("Malloc failed low mem!")

  wStr = __C2W(myCopy);
  if (!wStr)
    RETURN0("Unicode conversion failed!")

  if (com_dbg)
    color_printf(myellow, "CreateObject(:SET, %s)\n", myCopy);

  if (myCopy[0] == '{')
    hr = CLSIDFromString( wStr , &clsid); //its a string CLSID directly
  else
    hr = CLSIDFromProgID( wStr , &clsid); //its a progid
  if( hr != S_OK  )
    RETURN0("Failed to get clsid!")

  hr =  CoCreateInstance( clsid, NULL, CLSCTX_INPROC_SERVER, IID_IDispatch,(void**)&IDisp);
  if ( hr != S_OK ){
    //ok maybe its an activex exe..
    hr = CoCreateInstance( clsid, NULL, CLSCTX_LOCAL_SERVER, IID_IDispatch,(void**)&IDisp);
    if ( hr != S_OK )
      RETURN0("CoCreateInstance failed! Does object support IDispatch?")
  }

  if(com_dbg)
    color_printf(mgreen, "%s seems to return %svalid IDISPATCH pointer\n",
    myCopy, IDisp, isValidIDisp(IDisp) ? "" : "in");

  //todo: keep track of valid objects we create for release/call sanity check latter?
  //	  tracking would break operation though if an embedded host used setvariable to add an obj reference..
  //      unless it used an AddObject(name,pointer) method to add it to the tracker..
  //      how else can we know if a random number is a valid com object other than tracking?
  //      handled with a try/catch block in CallByName right now

cleanup:
  LONGVALUE(besRETURNVALUE) = (int)IDisp;    
  if(myCopy)
    free(myCopy);
  if(wStr)
    free(wStr);

besEND

// the idea behind this one is that we can use a string to embed a type specifier
// to explicitly declare and cast a variable to the type we want such as "VT_I2:2"
//
// in testing with VB6 however, if we pass .vt = VT_I4 when vb6 expects a VT_I1 (char)
// it works as long as the value is < 255, also works with VT_BOOL
//
// do we really need this function ? I prefer less complexity if possible.
//
// Note: there are many COM types, I have no plans to cover them all
//bool HandleSpecial(VARIANTARG* va, char* str) { // MLL: NOT NEEDED FOR NOW!
//
//  if (str == 0)
//    return false;
//  if (strlen(str) == 0)
//    return false;
//
//  std::string s = str;
//
//  if (s.length() < 3)
//    return false;
//  if (s.substr(0, 3) != "VT_")
//    return false;
//
//  int pos = s.find(":", 0);
//  if (pos < 1)
//    return false;
//
//  std::string cmd = s.substr(0, pos);
//  if ((int)s.length() < pos + 2)
//    return false;
//
//  s = s.substr(pos + 1);
//
//  //todo implement handling of these types (there are many more than this)
//  if (cmd == "VT_I1") {
//    return false;
//  } else if (cmd == "VT_I2") {
//    return false;
//  } else if (cmd == "VT_I8") {
//    return false;
//  } else if (cmd == "VT_BOOL") {
//    return false;
//  } else if (cmd == "VT_DISPATCH") {
//    long id_ptr = atol(s.c_str());
//    if(com_dbg)
//      color_printf(mcyan, "%d is %svalid IDispatch pointer\n", id_ptr,
//      isValidIDisp((IDispatch*)id_ptr) ? "" : "in");
//    // MLL HACK: va->lVal and va->pdispVal are a union, so ...
//    va->vt = VT_DISPATCH; // ... we tag this variant as an IDispatch* ...
//    va->lVal = id_ptr; // ... but write its ptr value as an ordinary long to avoid compiler type mismatches
//    //va->pdispVal->AddRef(); // MLL: Still I don't think we really need it in this context!
//  }
//
//  return true;
//}

/*
arguments in [] are optional, default calltype = method
callbyname object, "procname", [vbcalltype = VbMethod], [arg0], [arg1] ...
*/	

besFUNCTION(CallByName)

  int							slen;
  int							com_args = 0;
  unsigned long   __refcount_;
  char*						myCopy = NULL;
  LPWSTR					wMethodName = NULL;
  vbCallType			CallType = VbMethod;
  std::list<BSTR>	bstrs;
  VARIANTARG*			pvarg = NULL;
  VARIABLE				arg_obj;
  VARIABLE				arg_procName;
  VARIABLE				arg_CallType;
  LEFTVALUE       Lval;
  bool						hasBuffers = false; // MLL: "call has buffers" flag

  besRETURNVALUE = besNEWMORTALLONG;
  LONGVALUE(besRETURNVALUE) = 0;

  g_pSt = pSt; //we are caching a copy of support table for SBCallback to use

  if (com_dbg)
    color_printf(myellow, "\nCallByName %ld args\n", besARGNR);

  if (besARGNR < 2)
    RETURN0("CallByName requires at least 2 args!") 

  arg_obj = besARGUMENT(1);
  besDEREFERENCE(arg_obj);

  if ( TYPE(arg_obj) != VTYPE_LONG)
    RETURN0("CallByName 1st argument must be a long!")

  arg_procName = besARGUMENT(2);
  besDEREFERENCE(arg_procName);

  if ( TYPE(arg_procName) != VTYPE_STRING)
    RETURN0("CallByName 2nd argument must be a string!")

  if( besARGNR >= 3 ){
    arg_CallType = besARGUMENT(3);
    besDEREFERENCE(arg_CallType);
    CallType = (vbCallType)LONGVALUE(arg_CallType);
  }

  myCopy = GetCString(arg_procName);
  if (!myCopy)
    RETURN0("Malloc failed low mem!")

  wMethodName = __C2W(myCopy);
  if (!wMethodName)
    RETURN0("Unicode conversion failed!")

  if ( LONGVALUE(arg_obj) == 0)
    RETURN0("CallByName(NULL) called!")

  IDispatch*	IDisp = (IDispatch*)LONGVALUE(arg_obj);
  DISPID			dispid; // long integer containing the dispatch ID
  HRESULT			hr;

  // Get the Dispatch ID for the method name, 
  // try block is in case client passed in an invalid pointer
  try{
    hr = IDisp->GetIDsOfNames(IID_NULL, &wMethodName, 1, LOCALE_USER_DEFAULT, &dispid);
    if( FAILED(hr) )
      RETURN0("GetIDsOfNames failed!")
  }
  catch(...){
    RETURN0("Invalid IDisp pointer?")
  }

  VARIANT    retVal;
  DISPPARAMS dispparams;

  memset(&dispparams, 0, sizeof(dispparams));
  memset(&retVal, 0, sizeof(retVal)); // MLL: lazy bones!

  com_args = besARGNR - 3;
  if(com_args < 0)
    com_args = 0;

  if(com_dbg)
    color_printf(myellow, "CallByName(obj=%x, method='%s', calltype=%d , comArgs=%d)\n",
    LONGVALUE(arg_obj), myCopy, CallType, com_args);

  // Allocate memory for all VARIANTARG parameters.
  if(com_args > 0){
    pvarg = new VARIANTARG[com_args];
    if(pvarg == NULL)
      RETURN0("Failed to alloc VARIANTARGs!")
  }

  dispparams.rgvarg = pvarg;
  if(com_args > 0)
    memset(pvarg, 0, sizeof(VARIANTARG) * com_args);
  dispparams.cArgs = com_args;  // num of args function takes
  dispparams.cNamedArgs = 0;

  /* map in argument values and types    ->[ IN REVERSE ORDER ]<-    */
  for(int i=0; i < com_args; i++){
    VARIABLE arg_x;

    arg_x = besARGUMENT(3 + com_args - i);
    // MLL: !!! DO NOT besDEREFERENCE(arg_x) !!!

    switch( TYPE(arg_x) ){ //script basic type to COM variant type
      case VTYPE_ARRAY:
        RETURN0("Arguments of SB type array currently not supported!")
      case VTYPE_DOUBLE:
dbl_literal:
        pvarg[i].vt = VT_R8;
        pvarg[i].dblVal = DOUBLEVALUE(arg_x);
        if(com_dbg)
          color_printf(mgreen, "VTYPE_DOUBLE: %f (iter=%d)\n", pvarg[i].dblVal, i);
        break;
      case VTYPE_LONG:
lng_literal:
        if (CallType == VbSet) {
          CallType = VbMethod; // MLL: !!! A MUST !!!
          // MLL HACK: va->lVal and va->pdispVal are a union, so ...
          pvarg[i].vt = VT_DISPATCH; // ... we tag this variant as an IDispatch* ...
          pvarg[i].lVal = LONGVALUE(arg_x); // ... but write its ptr value as an ordinary long to avoid compiler type mismatches
          //pvarg[i]->pdispVal->AddRef(); // MLL: Still I don't think we really need it in this context!
          if(com_dbg)
            color_printf(mgreen, "VTYPE_LONG/IDISPATCH: %x is %svalid pointer\n", LONGVALUE(arg_x),
            isValidIDisp((IDispatch*)LONGVALUE(arg_x)) ? "" : "in");
        }
        else {
          pvarg[i].vt = VT_I4;
          pvarg[i].lVal = LONGVALUE(arg_x);
          if(com_dbg)
            color_printf(mgreen, "VTYPE_LONG: %d (iter=%d)\n", pvarg[i].lVal, i);
        }
        break;
      case VTYPE_REF: // MLL: check typeof original var this reference points to
        besLEFTVALUE(arg_x, Lval);

        if (Lval) { // shouldn't fail
          if (TYPE(*Lval) == VTYPE_UNDEF || TYPE(*Lval) == VTYPE_STRING) { // default/explicit string buffer
            if ((*Lval)->Size && TYPE(*Lval) == VTYPE_STRING) { // string buffer must be empty otherwise treated as literal
              arg_x = *Lval;
              if(com_dbg)
                color_printf(mgreen, "FROM BYREF => ");
              goto str_literal;
            }
            else {
              BSTR bstr = SysAllocString(L"");

              if(com_dbg)
                color_printf(mgrey, "VTYPE_UNDEF/BYREF: DEFAULT STRING BUFFER (iter=%d)\n", i);

              bstrs.push_back(bstr);
              pvarg[i].vt = VT_BSTR | VT_BYREF; // add BYREF tag
              pvarg[i].pbstrVal = &bstr; // set pointer to BSTR buffer
            }
          }
          else if (TYPE(*Lval) == VTYPE_LONG) { // integer variable
            if (LONGVALUE(*Lval)) { // integer buffer must be 0 otherwise treated as literal
              arg_x = *Lval;
              if(com_dbg)
                color_printf(mgreen, "FROM BYREF => ");
              goto lng_literal;
            }

            pvarg[i].vt = VT_I4 | VT_BYREF;
            pvarg[i].pintVal = (int*)*Lval; // fetch directly to SB variable
            if(com_dbg)
              color_printf(mgreen, "VTYPE_LONG/BYREF: INTEGER BUFFER %d (iter=%d)\n", LONGVALUE(*Lval), i);
          }
          else if (TYPE(*Lval) == VTYPE_DOUBLE) { // double variable
            if (DOUBLEVALUE(*Lval) != 0.0) { // double buffer must be 0.0 otherwise treated as literal
              arg_x = *Lval;
              if(com_dbg)
                color_printf(mgreen, "FROM BYREF => ");
              goto dbl_literal;
            }

            pvarg[i].vt = VT_R8 | VT_BYREF;
            pvarg[i].pdblVal = (double*)*Lval; // fetch directly to SB variable
            if(com_dbg)
              color_printf(mgreen, "VTYPE_DOUBLE/BYREF: DOUBLE BUFFER %f (iter=%d)\n", DOUBLEVALUE(*Lval), i);
          }
          else {
            RETURN0("References to script basic arrays not supported")
          }
        }
        else
          RETURN0("Invalid Lval pointer?");

        hasBuffers = true; // set BYREF buffer flag
        break;
      case VTYPE_STRING:
str_literal:
        char*   myStr = GetCString(arg_x);
        LPWSTR	wStr = __C2W(myStr);
        BSTR		bstr = SysAllocString(wStr);

        bstrs.push_back(bstr); //track these to free after call to prevent leak
        if (CallType == VbSet) {
          CallType = VbMethod; // MLL: !!! A MUST !!!
          if(com_dbg)
            color_printf(mgreen, "VTYPE_STRING/IDISPATCH: %s (iter=%d)\n", myStr, i);
        }
        else if(com_dbg)
          color_printf(mgreen, "VTYPE_STRING: %s (iter=%d)\n", myStr, i);

        pvarg[i].vt = VT_BSTR;
        pvarg[i].bstrVal = bstr;
        free(myStr);
        free(wStr);
        break;			  
    }
  }

  if(com_dbg && hasBuffers)
    color_printf(mcyan, "!!! HAS BUFFERS !!!\n");

  //invoke should not need a try catch block because IDisp is already known to be ok and COM should only return a hr result?

  //property put gets special handling..
  if(CallType == VbLet){
    DISPID mydispid = DISPID_PROPERTYPUT;

    dispparams.rgdispidNamedArgs = &mydispid;
    dispparams.cNamedArgs = 1;
    hr = IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, NULL, NULL, NULL); //no return value arg
    if( FAILED(hr) )
      RETURN0("Invoke failed!")
    goto cleanup;
  }

  hr = IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, &retVal, NULL, NULL);
  if( FAILED(hr) )
    RETURN0("Invoke failed!")

  char* cstr = 0;
  //map in return value to scriptbasic return val
  switch(retVal.vt) {
    case VT_EMPTY: 
      if(com_dbg) {
        color_printf(mblue, "VT_EMPTY returned : ");
        color_printf(myellow, "return value from COM function was empty\n", retVal.lVal);
      }
      break;
    case VT_BSTR:
      if(com_dbg)
        color_printf(mpurple, "VT_BSTR returned : ");
      cstr = __B2C(retVal.bstrVal);
      slen = strlen(cstr);
      if(com_dbg)
        color_printf(myellow, "return value from COM function was string: %s\n", cstr);
      besALLOC_RETURN_STRING(slen);
      memcpy(STRINGVALUE(besRETURNVALUE), cstr, slen);
      free(cstr);
      break;
    case VT_I4:  /* this might be being really lazy but at least with VB6 it works ok.. */
      if(com_dbg)
        color_printf(mblue, "VT_I4 returned : ");
    case VT_I2: 
    case VT_I1: 
    case VT_BOOL:
    case VT_UI1:
    case VT_UI2:
    case VT_UI4:
    case VT_I8:
    case VT_UI8:
    case VT_INT:
    case VT_UINT:
      if(retVal.vt != VT_I4)
        if(com_dbg)
          color_printf(mblue, "VT_BOOL to VT_UI8 returned : ");
    case VT_DISPATCH:
      //if(retVal.vt == VT_DISPATCH) todo: register handle // MLL: ??? WAT ???
      if(retVal.vt == VT_DISPATCH) {
        if (com_dbg) {
          color_printf(mblue, 
          "VT_DISPATCH returned : ");
          color_printf(myellow, "return value from COM function was integer: %x\n",
          retVal.lVal);
        }
      }
      else if (com_dbg)
        color_printf(myellow, "return value from COM function was integer: %d\n", retVal.lVal);
      LONGVALUE(besRETURNVALUE) = retVal.lVal;
      break;
    case VT_R8: // MLL: !!! YET UNTESTED !!!
      if(com_dbg)
        color_printf(myellow, "return value from COM function was double: %f\n", retVal.dblVal);
      besRETURN_DOUBLE(retVal.dblVal);
      break;
    default:
      color_printf(mred, "currently unsupported VT return type: %x\n", retVal.vt);
      break;
  }

  if (hasBuffers) { // MLL: else skip this loop for speed reasons
    for (int i=0; i < com_args; i++){
      VARIABLE arg_x = besARGUMENT(3 + com_args - i);
      // MLL: !!! DO NOT besDEREFERENCE(arg_x) !!!

      switch(pvarg[i].vt & VT_BYREF) {
        case VT_BYREF:
          if ((TYPE(arg_x) & VTYPE_REF) == VTYPE_REF) {
            besLEFTVALUE(arg_x, Lval);
            if (TYPE(*Lval) == VTYPE_UNDEF || TYPE(*Lval) == VTYPE_STRING) {
              char* myStr = __B2C(*pvarg[i].pbstrVal);
              slen = strlen(myStr);

              besRELEASE(*Lval);
              *Lval = besNEWSTRING(slen);
              if (!*Lval)
                RETURN0("Malloc failed low mem!");
              memcpy(STRINGVALUE(*Lval), myStr, slen);
              free(myStr);
            }
            else if (TYPE(*Lval) == VTYPE_LONG)
              LONGVALUE(*Lval) = *pvarg[i].pintVal;
            else if (TYPE(*Lval) == VTYPE_DOUBLE)
              DOUBLEVALUE(*Lval) = *pvarg[i].pdblVal;
          }
      }
    }
  }

cleanup:

  for (std::list<BSTR>::iterator it=bstrs.begin(); it != bstrs.end(); ++it)
    SysFreeString(*it);
  if(pvarg)
    delete pvarg;
  if(wMethodName)
    free(wMethodName); //return0 maybe should goto cleanup cause these would leak 
  if(myCopy)
    free(myCopy);

besEND
