// XTension.cpp : Defines the entry point for the DLL application.


#include "stdafx.h"
#include "scolplugin.h"
#include "memory.h"
#include "classes.h"


//$BLG - v5.01 : Modif
//#define OBJXTVER "XTension.pkg 1.0"
#define OBJXTVER "XTension.pkg 1.1"


int XTobj;
int WM_XTEvent;


#define __LOGIT__


#undef log
#undef MMechostr
//$BLG - v4.6a5 - Del
//#define log
#define MMechostr

#ifndef log
void log (char* msg)
{
#ifdef __LOGIT__
                  
  FILE* f;

  f = fopen("c:\\_Scol_ActiveX.log","a+");
  if (f) 
  {
  	fprintf(f, "%s\n", msg);
    fclose(f);
  }
#endif
}
#endif


cbmachine ww;


#define STRLEN(x) (((strlen(x) + 5)>>2) + 1)


HWND HScol;


#undef __COM_ERROR

int __COM_ERROR (HRESULT res, char * file, int line)
{            
  //char buf[1024];
//  if (res==S_OK) return 1;
  _com_error err(res);
  //MMechostr(1,"COM %s (%d): %s\n",file,line,err.ErrorMessage());
  //sprintf(buf,"COM %s (%d): %s",file,line,err.ErrorMessage());
  //log(buf);
  return 0;                                            
} 

#define __COM_ERROR(x) __COM_ERROR(x, __FILE__, __LINE__)



extern "C" int _AXstring2GUID(mmachine m) 
{ 
  USES_CONVERSION;

  LPOLESTR str;
  GUID id;
  int string, len, dest;

log(".cpp: _AXstring2GUID()");

  string = MMget(m, 0)>>1;
  if (string == NIL) {MMset(m, 0, NIL); return 0;}
  len = MMsizestr(m, string);
  str = T2OLE(MMstartstr(m, string));

  //MMechostr (1,"from %s\n",MMstartstr(m,string));
  
  switch (CLSIDFromString (str, &id))
  {
  case NOERROR :
    //MMechostr (1,"Conversion ok\n");
    break;
  case REGDB_E_WRITEREGDB :
    //MMechostr (1,"REGDB_E_WRITEREGDB Error\n");
    return 0;
    break;
  default:
    //MMechostr (1,"Unknown Error\n");
    return 0;
    break;
  }

  StringFromCLSID(id, &str);
  //MMechostr (1,"to %s\n",OLE2T(str));
 
  dest = MMmalloc(m, (sizeof(GUID) + 5) / 4, TYPEBUF);
  if (dest == NIL) return MERRMEM;
  memcpy(MMstartstr(m, dest), &id, sizeof(GUID));

  MMset(m, 0, dest*2+1);
  return 0;
}


#define OBJTYPXTENSION  21
#define RFLXTENSION_EVENT 0

RFLstruct* CreateRFLstruct(Object *obj, DISPID dispidmember, DISPPARAMS* pdispparams)
{
  USES_CONVERSION;
  RFLstruct *res;

log(".cpp: CreateRFLstruct()");

  res = new RFLstruct;
  if (!res) return NULL;

  res->obj = obj;
  res->dispid = dispidmember;
  res->nelems = pdispparams->cArgs;
  res->elems = new char*[pdispparams->cArgs * sizeof(char*)];
  for (unsigned int i = 0; i<pdispparams->cArgs; i++)
  {
    char *str;
    VARIANTARG var;
    VariantInit(&var);
    if (VariantChangeType(&var, pdispparams->rgvarg+i, 0, VT_BSTR) != S_OK)
    {
      //MMechostr(1,"Can't change type...\n");
      res->elems[i] = NULL;
    }
    else
    {
      str = OLE2T(var.bstrVal);
      //MMechostr(1,"* %s\n",str);
      res->elems[i] = new char[strlen(str)+1];
      if (res->elems[i]) strcpy(res->elems[i], str);
    }
  }
  return res;
}



int DisconnectPoint(Object *object, IConnectionPoint *pCP)
{
  //$BLG - v5.01: Del
  //unsigned long count;
  CONNECTDATA cdata;
  
  HRESULT hr;
  char buf[256];

log(".cpp: DisconnectPoint()");
  
  if (!pCP) return 0;
  
  IEnumConnections *pEnum;
  //MMechostr(1,"Unadvise connections on point...");
log(">0");
  pCP->EnumConnections(&pEnum);
log(">1");
  if (!pEnum) return 0;
  
  //$BLG - v5.01: Del
  //pEnum->Next(1, &cdata, &count);
 log(">2");
 //$BLG - v5.01: Modif
  //while (count) 
  while ((pEnum->Next(1, &cdata, NULL)) == S_OK)						// <- AddRef
  {
    //$BLG - v5.01: Modif
    /*
    if (cdata.pUnk == (IDispatch*)&(object->Dispatch))
      pCP->Unadvise(cdata.dwCookie);
    */
    log(".");
    if (cdata.pUnk == (IDispatch*)&(object->Dispatch))
    {
      log("..");
      hr = pCP->Unadvise(cdata.dwCookie);
      sprintf(buf, "%d", cdata.dwCookie);
      log(buf);
      if (hr == S_OK)		log("S_OK");
      else if (hr == CONNECT_E_NOCONNECTION) log("CONNECT_E_NOCONNECTION ");
      else log("E_UNEXPECTED");
      log("...");
      //object->Dispatch.Release();
      //Note: les dwCookies sont bien incrémentés à la création, et on ne trouve que le premier en n exemplaires en sortie !!!
      //On devrait pouvoir faire 3 Unadvice, pas 1 !!!
      //Qui plus est, on ne fait cela que sur 1 des 2 IIDs !!!
      //Résultat: on n'en libère qu'un sur 6 !!!

     	object->Dispatch.Release();														// <- Release
    }
    log("...<");
    //$BLG - v5.01: Del
    //pEnum->Next(1, &cdata, &count);
  }
  pEnum->Release();

log("<");

  //MMechostr(1,"OK\n");
  return 0;
}


int DisconnectSink(IID iid, Object *object)
{
  IConnectionPointContainer *pCPContainer;
  IConnectionPoint *CPArray;
  ULONG count = 10, c = 0;

log(".cpp: DisconnectSink()");

  if (object->pOleObject->QueryInterface(IID_IConnectionPointContainer, (void**)&pCPContainer) != S_OK)
  {
    //MMechostr(1,"No IConnectionPointContainer interface.\n");
    log("< No IConnectionPointContainer interface - ret 0");
    return 0;
  }
  
  //$BLG - v5.01: Add
  //pCPContainer->AddRef();
  
  if (pCPContainer->FindConnectionPoint(iid, &CPArray) != S_OK)
  {
    //MMechostr(1,"No Connection Point Enumerator.\n");
    
    //$BLG - v5.01: Add
    //pCPContainer->Release();
    
    log("< No Connection Point Enumerator - ret 0");
    return 0;
  }

  //$BLG - v5.01: Modif
  /*
  if (CPArray)
    DisconnectPoint(object, CPArray);
//  pCPContainer->Release();
*/
  if (CPArray)
  {
    //CPArray->AddRef();
    log("CPArray: DisconnectPoint ...");
    DisconnectPoint(object, CPArray);
  }
  
  //$BLG - v5.01: Add
  //CPArray->Release();
  //pCPContainer->Release();
  
  log("< ret 1");
  return 1;
}



int ConnectPoint(Object *object, IConnectionPoint *pCP)
{
  DWORD dwCookie;
  
  HRESULT hr;
  char buf[256];

log(".cpp: ConnectPoint()");
  
  if (!pCP) return 0;
  
  //$BLG - v5.01: Add
  
  //MMechostr(1,"Advise connection point...");
  hr = pCP->Advise((IDispatch*)&(object->Dispatch), &dwCookie);
  if (hr == S_OK) log("S_OK");
  else if (hr == E_OUTOFMEMORY) log("E_OUTOFMEMORY ");
  else if (hr == E_UNEXPECTED) log("E_UNEXPECTED");
  else if (hr == E_POINTER) log("E_POINTER");
  else if (hr == CONNECT_E_ADVISELIMIT) log("CONNECT_E_ADVISELIMIT");
  else log("CONNECT_E_CANNOTCONNECT");
  
  sprintf(buf, "%d", dwCookie);
  log(buf);
  
  //$BLG - v5.01: Add
  //object->Dispatch.Release();
  
log("<");  
  //MMechostr(1,"OK\nRelease Connection point...");
//  pCP->Release();
  //MMechostr(1,"OK\n");
  return 0;
}


int ConnectPoints(Object *object)
{
  IConnectionPointContainer *pCPContainer;
  IConnectionPoint *CPArray;
  IEnumConnectionPoints *pEnumCP;
  //$BLG - v5.01: del
  //ULONG count = 10, c = 0;

log(".cpp: ConnectPoints()");

  if (object->pOleObject->QueryInterface(IID_IConnectionPointContainer, (void**)&pCPContainer) != S_OK)
  {
    //MMechostr(1,"No IConnectionPointContainer interface.\n");
    return 0;
  }
  if (pCPContainer->EnumConnectionPoints(&pEnumCP) != S_OK)
  {
    //MMechostr(1,"No Connection Point Enumerator.\n");
    return 0;
  }

  //MMechostr(1,"Reseting connection point enumerator...");
//  pEnumCP->Reset();
  //MMechostr(1,"OK\n");
  
  //$BLG - v5.01: Modif
  /*
  pEnumCP->Next(1, &CPArray, &count);
  while (count)
  {                                                               
    //MMechostr(1,"Analisys of connection point #%d...\n",c++);
    ConnectPoint(object, CPArray);
    //MMechostr(1,"\n");
    pEnumCP->Next(1, &CPArray, &count);
  }
  pEnumCP->Release();
  */
  while ((pEnumCP->Next(1, &CPArray, NULL)) == S_OK)
  {
    ConnectPoint(object, CPArray);
  }
  pEnumCP->Release();
  
  //MMechostr(1,"Total of connection point #%d...\n",c);
//  pCPContainer->Release();
  return 1;
}


int ConnectSink(IID iid, Object *object)
{
  IConnectionPointContainer *pCPContainer;
  IConnectionPoint *CPArray;
//  IEnumConnectionPoints  *pEnumCP;
  ULONG count = 10, c = 0;

log(".cpp: ConnectSink()");

  if (object->pOleObject->QueryInterface(IID_IConnectionPointContainer, (void**)&pCPContainer) != S_OK)
  {
    //MMechostr(1,"No IConnectionPointContainer interface.\n");
    log("< No IConnectionPointContainer interface - ret 0");
    return 0;
  }
  if (pCPContainer->FindConnectionPoint(iid, &CPArray) != S_OK)
  {
    //MMechostr(1,"No Connection Point Enumerator.\n");
    log("< No Connection Point Enumerator - ret 0");
    return 0;
  }

  if (CPArray)
  {
    log("CParray > ConnectPoint ... ");
    ConnectPoint(object, CPArray);
  }
  
//  pCPContainer->Release();
  
  log("< ret 1");
  return 1;
}



// *****************************************************************************
// _AXCreateInstance
// *****************************************************************************
extern "C" int _AXCreateInstance(mmachine m)
{
  USES_CONVERSION;
  int guid;
  GUID *id;
  int obj;
  Object *object;

  LPOLESTR str;
  HRESULT ret = NULL;

log("\n");
log("\n.cpp: _AXCreateInstance()");

  guid = MMget(m, 0)>>1;

//  MMset(m,0,NIL);

  if (guid == NIL) return 0;

  id = (GUID*)MMstartstr(m, guid);
  
  StringFromCLSID(*id, &str);
  //MMechostr (1,"to %s\n",OLE2T(str));

  //log("CoCreateInstance !!!!!!!!!!!!");

  obj = MMmalloc(m, 1, TYPEBUF);
  if (obj == NIL)
  {
    //MMechostr (1," Can't get new obj\n");
    MMpull(m);
//    MMpull(m);
    MMset(m, 0, NIL); 
    return obj;
  }

  MMset(m, 0, (obj*2)+1);

  object = new Object;
  if (!object)
  {
    //MMechostr (1," Can't get new object\n");
    MMpull(m);
//    MMpull(m);
    MMset(m, 0, NIL); 
    return 0;
  }
  
  //$BLG - v5.01: Add
  log("< new obj");

  MMstore(m, obj, 0, (int)object);

  CoGetClassObject(*id, CLSCTX_SERVER, 0, IID_IClassFactory, (void**)&object->pClassFactory);

  if (!object->pClassFactory) 
  {
    //MMechostr (1," ClassFactory\n");
    MMpull(m);
//    MMpull(m);
    MMset(m, 0, NIL); 
    delete object;
    return 0;
  }
//    pOleObject=NULL;
  if (object->pClassFactory->CreateInstance(0, IID_IOleObject, (void**)&object->pOleObject) != S_OK)
  {
    //MMechostr (1," ClassFactory::CreateInstance\n");
    MMpull(m);
//    MMpull(m);
    MMset(m, 0, NIL); 
    delete object;
    return 0;
  }
  if (!object->pOleObject)
  {
    //MMechostr (1," pOleObject=NULL\n");
    MMpull(m);
//    MMpull(m);
    MMset(m, 0, NIL); 
    delete object;
    return 0;
  }

  //MMechostr(1,"Let's go for connection points...\n");
  //$BLG - v5.01: Del (Points connections seem to work without that)
  //ConnectSink(IID_IPropertyNotifySink, object);
  log("$BLG: Removed call to ConnectSink");
  ConnectPoints(object);
  //MMechostr(1,".................................\n");

//  MMset(m,0,ax*2+1); 
  //log("Create Instance OK");
  return OBJcreate(m, XTobj, (int)object, -1, 0);
}


// *****************************************************************************
// _AXDestroyInstance
// *****************************************************************************
extern "C" int _AXDestroyInstance(mmachine m)
{
  int ax;
  Object *p;

log("\n");
log("\n.cpp: _AXDestroyInstance()");

//MMechostr(0, "_AXDestroyInstance\0");

  ax = MMpull(m)>>1;
  if (ax == NIL) 
    return MMpush(m, NIL);

log("\n.cpp: _AXDestroyInstance: AX");

  p = (Object *)MMfetch(m, ax, 0);

  if (!p)
    return MMpush(m, NIL);

log("\n.cpp: _AXDestroyInstance: OB");

  MMstore(m, ax, 0, 0);

log("\n.cpp: _AXDestroyInstance: ST");

  OBJdelTH(m, XTobj, (int)p);
  
//MMechostr(0,"<OK\n");
//log("<OK");

log("\n.cpp: _AXDestroyInstance: OK");
  
  return MMpush(m, NIL);
}


// *****************************************************************************
// _AXSetSite
// *****************************************************************************
extern "C" int _AXSetSite(mmachine m)
{
  int objwin, ax;
  USES_CONVERSION;
	RECT rcPos;
  HWND hwnd = NULL;
  PtrObjVoid OB;
  PtrObjWindow Window;
  //char buf[80];
  Object *object;

log("\n");
log("\n.cpp: _AXSetSite()");

  ax = MMpull(m)>>1;
  objwin = MMpull(m)>>1;

  if (objwin!=NIL) 
  {
    OB = (PtrObjVoid) &m->tape [objwin + SizeHeader];
    Window = (ObjWindow *) &m->tape [(OB->Buffer>>1) + SizeHeader];
    hwnd = Window->WHandler;
  }
  else return MMpush(m, NIL);

  if (ax == NIL)
    return MMpush(m, NIL);

  object = (Object*)MMfetch(m, ax, 0);

  if (!object) return MMpush(m, NIL);

  //log("**************");

  //sprintf(buf,"HWND: %X",hwnd);
  //log(buf);

  //log("**************");
  //  hwnd=h;
//    MessageBox ("Subclassage de la fenetre...\n");
//    SubclassWindow(h);
  object->OleClientSite.setHWND(hwnd);

	if (!object->pOleObject)
    return MMpush(m, NIL);

  log("AXSetSite.............Query IOleControl Interface");
  __COM_ERROR(object->pOleObject->QueryInterface(IID_IOleControl, (void**)&object->pOleControl));
  if (object->pOleControl)
  {
    //log("IOLEControl OK....... Unfreezing events....");
//    __COM_ERROR(object->pOleControl->FreezeEvents(FALSE));
  }

// MessageBox ("Activation du controle...\n");
  log("AXSetSite.............SetClientSite");
  __COM_ERROR(object->pOleObject->SetClientSite(&object->OleClientSite));
  
  log("AXSetSite.............SetHostNames");
  __COM_ERROR(object->pOleObject->SetHostNames(T2OLE("SCOL"),NULL));
	
	GetClientRect(hwnd, &rcPos);

//  log("AXSetSite.............SetHostName");
//  __COM_ERROR(object->pOleObject->SetHostNames(T2OLE("SCOL"),NULL));
	
//  log("AXSetSite.............DoVerb OLEIVERB_INPLACEACTIVATE");
//  __COM_ERROR(object->pOleObject->DoVerb(OLEIVERB_INPLACEACTIVATE, NULL, &object->OleClientSite, 0, hwnd, &rcPos));
  
  log("AXSetSite.............DoVerb OLEIVERB_UIACTIVATE");
	__COM_ERROR(object->pOleObject->DoVerb(OLEIVERB_UIACTIVATE, NULL, &object->OleClientSite, 0, hwnd, &rcPos));
  
  log("AXSetSite.............DoVerb OLEIVERB_SHOW");
	//$BLG - v5.01: Del (Is that really useful after UIACTIVATE ?)
	//__COM_ERROR(object->pOleObject->DoVerb(OLEIVERB_SHOW, NULL, &object->OleClientSite, 0, hwnd, &rcPos));
	log("< $BLG: Removed this call");

  log("AXSetSite.............ConnectPoints");
  //$BLG - v5.01: Del (Seems to be done in other functions too)
  log("< $BLG: Removed this call");
  //ConnectPoints(object);

  //log("AXSetSite.............OK");
  return MMpush(m, (ax*2)+1);
}


BOOL ObjectTypeInfo(LPUNKNOWN pObj, LPTYPEINFO *ppITypeInfo)
{
  HRESULT hr;
  LPPROVIDECLASSINFO pIProvideClassInfo;

log(".cpp: ObjectTypeInfo()");

  //$BLG - Modif
  //if (NULL==pObj || NULL==ppITypeInfo)
  if ((NULL == pObj) || (NULL == ppITypeInfo))
    return FALSE;

  *ppITypeInfo = NULL;

  hr = pObj->QueryInterface(IID_IProvideClassInfo, (void**)&pIProvideClassInfo);

  if (FAILED(hr))
    return FALSE;

  hr = pIProvideClassInfo->GetClassInfo(ppITypeInfo);
  pIProvideClassInfo->Release();

  return SUCCEEDED(hr);
}


#if 0
BOOL ObjectTypeInfoEvents(LPUNKNOWN pObj, LPTYPEINFO *ppITypeInfo)
{
  HRESULT          hr;
  LPTYPEINFO       pITypeInfoAll;
  LPTYPEATTR       pTA;

log(".cpp: ObjectTypeInfoEvents()");

  if (NULL==pObj || NULL==ppITypeInfo)
  return FALSE;

  if (!ObjectTypeInfo(pObj, &pITypeInfoAll))
  return FALSE;

  *ppITypeInfo = NULL;

  if (SUCCEEDED(pITypeInfoAll->GetTypeAttr(&pTA)))
  {
    UINT      i;
    int       iFlags;

    for (i = 0; i < pTA->cImplTypes; i++)
    {
      //Get the implementation type for this interface
      hr = pITypeInfoAll->GetImplTypeFlags(i, &iFlags);

      if (FAILED(hr))
        continue;

//      if ((iFlags & IMPLTYPEFLAG_FDEFAULT) && (iFlags & IMPLTYPEFLAG_FSOURCE))
      if (iFlags & IMPLTYPEFLAG_FSOURCE)
      {
        HREFTYPE   hRefType = NULL;

        /*
        * This is the interface we want. Get a handle to
        * the type description from which we can then get
        * the ITypeInfo.                               WS_TRANSPARENT
        */
        pITypeInfoAll->GetRefTypeOfImplType(i, &hRefType);
        hr = pITypeInfoAll->GetRefTypeInfo(hRefType, ppITypeInfo);
        //MMechostr(1,"\n** Found 1 event interface (%d - %x) **\n\n",i,ppITypeInfo);
//        break;
      }
    }
    pITypeInfoAll->ReleaseTypeAttr(pTA);
  }

  pITypeInfoAll->Release();
  return (NULL != *ppITypeInfo);
}
#endif


bool IsEventInterface(LPUNKNOWN pObj, IID iid)
{
  IConnectionPointContainer *pCPContainer;
  IConnectionPoint *CPArray;
//  IEnumConnectionPoints  *pEnumCP;
  ULONG count = 10, c = 0;

log(".cpp: IsEventInterface()");

  if (pObj->QueryInterface(IID_IConnectionPointContainer, (void**)&pCPContainer) != S_OK)
  {
    //MMechostr(1,"No IConnectionPointContainer interface.\n");
    return 0;
  }
  if (pCPContainer->FindConnectionPoint(iid, &CPArray) != S_OK)
  {
    //MMechostr(1,"No Connection Point Enumerator.\n");
    return 0;
  }

  if (CPArray)
    return 1;
//  pCPContainer->Release();
  return 0;
}

/*
bool IsEventInterface(LPUNKNOWN pObj,IID iid)
{
  IConnectionPointContainer *pCPContainer;
  IConnectionPoint *CPArray[10];
  IEnumConnectionPoints  *pEnumCP;
  ULONG count=10,c=0;
  IID _iid;

  if (pObj->QueryInterface(IID_IConnectionPointContainer,(void**)&pCPContainer)!=S_OK)
  {
    //MMechostr(1,"No IConnectionPointContainer interface.\n");
    return false;
  }
  if (pCPContainer->EnumConnectionPoints(&pEnumCP)!=S_OK)
  {
    //MMechostr(1,"No Connection Point Enumerator.\n");
    return false;
  }

  //MMechostr(1,"Reseting connection point enumerator...");
//  pEnumCP->Reset();
  //MMechostr(1,"OK\n");
  while (count==10)
  {
    pEnumCP->Next(10,CPArray,&count);
    for (ULONG i=0;i<count;i++)
    {
      //MMechostr(1,"Analisys of connection point #%d...\n",c++);
      CPArray[i]->GetConnectionInterface(&_iid);
      if (!memcmp(&_iid,&iid,sizeof(IID))) return true;
    }
  }
  return false;
}
*/


int EnumInterface(mmachine m, Object *object, int obj)
{
  IProvideClassInfo *pProvideClassInfo;
  ITypeInfo *pTypeInfo;
  USES_CONVERSION;
  ITypeLib *pTypeLib;
  int infocount, count = 0;
  unsigned int j;
  TYPEATTR *typeattr;

log(".cpp: EnumInterface()");

  object->pOleObject->QueryInterface(IID_IProvideClassInfo, (void**)&pProvideClassInfo);
  if (!pProvideClassInfo)
    return MMpush(m, NIL);

  __COM_ERROR(pProvideClassInfo->GetClassInfo(&pTypeInfo));
  if (pTypeInfo)
  {
    __COM_ERROR(pTypeInfo->GetContainingTypeLib(&pTypeLib, &j));
    if (!pTypeLib)
      return MMpush(m, NIL);
    infocount = pTypeLib->GetTypeInfoCount();
    for (int n = 0; n < infocount; n++)
    {
      ITypeInfo *ptypeinfo;

      pTypeLib->GetTypeInfo(n, &ptypeinfo);
      if (ptypeinfo)
      {
        ptypeinfo->GetTypeAttr(&typeattr);
////// DANGEROUS GAME:
				//$BLG - v5.01 - Del (The above message is not from me).         
				//Trying to remove this as the wanted links seems to be already present.
				//Furthermore, most calls in my tests fail, so...
				//Removed only the next line, next 3 commented lines were not removed by me.
        //ConnectSink(typeattr->guid, object);
/*        if (IsEventInterface(object->pOleObject,typeattr->guid)) 
          //MMechostr(1,"==> Found the event interface (%d) <==\n",n);
        else*/
        {
          if (typeattr->typekind&TKIND_DISPATCH && (!(typeattr->typekind&TKIND_RECORD)))
          {
            //MMechostr(1,"Normal interface (%d)\n",n);
            if (MMpush(m, obj*2+1)) return MERRMEM;
            if (MMpush(m, n*2)) return MERRMEM;
            if (MMpush(m, 4)) return MERRMEM;
            if (MBdeftab(m)) return MERRMEM;
            obj = MMfetch(m, (MMget(m, 0)>>1), 0)>>1;
            count ++;
          }
          else 0;//MMechostr(1,"Not an interface (%d)\n",n);
        }
        //$BLG - v5.01: Add
        //DisconnectSink(typeattr->guid, object);
        
        ptypeinfo->ReleaseTypeAttr(typeattr);
      }
      else 0;//MMechostr(1,"Could not get type info for this interface...");
    }
  }
  else
  {
    //MMechostr(1,"*** This object doesn't provide a TypeInfo interface\n");
  }

  if (MMpush(m, NIL)) return MERRMEM;
  
  for (int n = 0; n < count; n++) 
  {
    //MMechostr(1,".");
    if (MMpush(m, 4)) return MERRMEM;
    if (MBdeftab(m)) return MERRMEM;
  }
  return 0;
}


int FreeInterfaces(Object *object)
{
  IProvideClassInfo *pProvideClassInfo;
  ITypeInfo *pTypeInfo;
  USES_CONVERSION;
  ITypeLib *pTypeLib;
  int infocount, count = 0;
  unsigned int j;
  TYPEATTR *typeattr;

log(".cpp: FreeInterfaces()");

  if (!object) return 0;
  if (!object->pOleObject) return 0;

  object->pOleObject->QueryInterface(IID_IProvideClassInfo, (void**)&pProvideClassInfo);
  if (!pProvideClassInfo) return 0;
  __COM_ERROR(pProvideClassInfo->GetClassInfo(&pTypeInfo));
  if (pTypeInfo)
  {
    __COM_ERROR(pTypeInfo->GetContainingTypeLib(&pTypeLib, &j));
    if (!pTypeLib)
      return 0;
    infocount = pTypeLib->GetTypeInfoCount();
    for (int n = 0; n < infocount; n++)
    {
      ITypeInfo *ptypeinfo;
      pTypeLib->GetTypeInfo(n, &ptypeinfo);
      if (ptypeinfo)
      {
        ptypeinfo->GetTypeAttr(&typeattr);
        DisconnectSink(typeattr->guid, object);
        ptypeinfo->ReleaseTypeAttr(typeattr);
      }
    }
  }
  
  //$BLG - v5.01: Add
  DisconnectSink(IID_IPropertyNotifySink, object);
  
  return 0;
}


int FindInterface(Object*object, MEMBERID memid, char*resbuf)
{
  USES_CONVERSION;
  IProvideClassInfo *pProvideClassInfo;
  ITypeInfo *pTypeInfo;
  ITypeLib *pTypeLib;
  int infocount, count = 0;
  unsigned int i, j;
  BSTR bstrName;

log(".cpp: FindInterface()");

  strcpy(resbuf, "");

  object->pOleObject->QueryInterface(IID_IProvideClassInfo, (void**)&pProvideClassInfo);
  if (!pProvideClassInfo)
    return 0;

  __COM_ERROR(pProvideClassInfo->GetClassInfo(&pTypeInfo));
  if (pTypeInfo)
  {
    __COM_ERROR(pTypeInfo->GetContainingTypeLib(&pTypeLib, &j));
    if (!pTypeLib)
      return 0;
    infocount = pTypeLib->GetTypeInfoCount();
    for (int n = 0; n < infocount; n++)
    {
      ITypeInfo *ptypeinfo;

      pTypeLib->GetTypeInfo(n, &ptypeinfo);
      if (ptypeinfo)
      {
        TYPEATTR *ptypeattr;
        FUNCDESC *pFuncDesc;
        ptypeinfo->GetTypeAttr(&ptypeattr);
        for (i = 0; i < ptypeattr->cFuncs; i++)
        {
          ptypeinfo->GetFuncDesc(i, &pFuncDesc);
          if (pFuncDesc->memid == memid)
          {
            //MMechostr(1,"Found the function...");
            if (ptypeinfo->GetDocumentation(memid, &bstrName, NULL, NULL, NULL) == S_OK)
            {
              char *t = OLE2T(bstrName);
              SysFreeString(bstrName);
              //MMechostr(1,"%s\n",t);
              strcpy(resbuf, t);
            }
          }
          ptypeinfo->ReleaseFuncDesc(pFuncDesc);
        }
        ptypeinfo->ReleaseTypeAttr(ptypeattr);
      }
    }
  }
  else
  {
    //MMechostr(1,"*** This object doesn't provide a TypeInfo interface\n");
  }

  return 0;
}


// *****************************************************************************
// _AXEnumInterfaces
// *****************************************************************************
extern "C" int _AXEnumInterfaces(mmachine m)
{
  int ax, funs = NIL;
  Object *object;

log("\n");
log("\n.cpp: _AXEnumInterfaces()");

  //MMechostr(1,"\n\nGetting Interface list... \n\n");
  ax = MMpull(m)>>1;
  if (ax == NIL)
    return MMpush(m, NIL);

  object = (Object *)MMfetch(m, ax, 0);
  if (object == NULL)
    return MMpush(m, NIL);

  return EnumInterface(m, object, ax);
}


int GetInterfaceInfo(mmachine m, Object *object,int interf)
{
  IProvideClassInfo *pProvideClassInfo;
  ITypeInfo *pTypeInfo;
  USES_CONVERSION;
  TYPEATTR *typeattr;
  ITypeLib *pTypeLib;
  unsigned int j;
  BSTR bstrName, bstrDoc, bstrHelpFile;
  DWORD HelpContext;
  ITypeInfo *ptypeinfo;

log(".cpp: GetInterfaceInfo()");

  //MMechostr(1,"*** GET INTERFACE INFO\n");
  object->pOleObject->QueryInterface(IID_IProvideClassInfo, (void**)&pProvideClassInfo);
  if (!pProvideClassInfo)
    return MMpush(m, NIL);

  pProvideClassInfo->GetClassInfo(&pTypeInfo);
  if (pTypeInfo)
  {
    pTypeInfo->GetContainingTypeLib(&pTypeLib, &j);
    if (!pTypeLib)
      return MMpush(m, NIL);

    pTypeLib->GetDocumentation(interf, &bstrName, &bstrDoc, &HelpContext, &bstrHelpFile);

//    //MMechostr(1,"     Interface: %s  (%s) %s\n",OLE2T(bstrName),OLE2T(bstrDoc),OLE2T(bstrHelpFile));
    if (bstrName) 
    {
    	if (Mpushstrbloc(m, OLE2T(bstrName))) return MERRMEM;
    }
    else if (Mpushstrbloc(m, "UnknownName")) return MERRMEM;
    
    if (bstrDoc) 
    {
    	if (Mpushstrbloc(m, OLE2T(bstrDoc))) return MERRMEM;
    }
    else if (Mpushstrbloc(m, "UnknownDoc")) return MERRMEM;

    if (bstrHelpFile) 
    {
    	if (Mpushstrbloc(m, OLE2T(bstrHelpFile))) return MERRMEM;
    }
    else if (Mpushstrbloc(m, "UnknownHelp")) return MERRMEM;

//    __asm { int 3 };
    pTypeLib->GetTypeInfo(interf, &ptypeinfo);
    if (ptypeinfo)
    {
      ptypeinfo->GetTypeAttr(&typeattr);
      if (IsEventInterface(object->pOleObject, typeattr->guid)) 
      {
        if (MMpush(m, 2) < 0) return MERRMEM;
      }
      else
      {
        if (MMpush(m, 0) < 0) return MERRMEM;
      }
      ptypeinfo->ReleaseTypeAttr(typeattr);
    }
    else if (MMpush(m, 0) < 0) return MERRMEM;

    if (bstrName) CoTaskMemFree(bstrName);
    if (bstrDoc) CoTaskMemFree(bstrDoc);
    if (bstrHelpFile) CoTaskMemFree(bstrHelpFile); 

    if (MMpush(m, 4*2)) return MERRMEM;

    return MBdeftab(m);
  }
  else
    //MMechostr(1,"*** This object doesn't provide a TypeInfo interface\n");
  //MMechostr(1,"*** GET INTERFACE INFO OK\n");
  return MMpush(m, NIL);
}


// *****************************************************************************
// _AXGetInterfaceInfo
// *****************************************************************************
int _AXGetInterfaceInfo(mmachine m)
{
  int obj, object, n;
  Object *Obj;

log("\n");
log(".cpp: _AXGetInterfaceInfo()");

  obj = MMpull(m)>>1;

  object = MMfetch(m, obj, 0)>>1;
  n = MMfetch(m, obj, 1)>>1;

  Obj = (Object*)MMfetch(m, object, 0);
  if (Obj == NULL) 
  {
    //MMechostr(1,"Bad object...");
    return MMpush(m, NIL);
  }

  //MMechostr(1,"(object= %x)(interface: %d)\n",object,n);
  return GetInterfaceInfo(m, Obj, n);
}


int GetFuncs(mmachine m, Object*object, int interf, int obj)
{
  IProvideClassInfo *pProvideClassInfo;
  ITypeInfo *pTypeInfo, *ptypeinfo;
  USES_CONVERSION;
  ITypeLib *pTypeLib;
  unsigned int i, j, count = 0;
  BSTR bstrName, bstrDoc, bstrHelpFile;
  TYPEATTR *attr;
  FUNCDESC *pfuncdesc;
  char buf[1024];
  int invkind, nargs, dispid;

log(".cpp: GetFuncs()");

  object->pOleObject->QueryInterface(IID_IProvideClassInfo, (void**)&pProvideClassInfo);
  if (!pProvideClassInfo)
    return MMpush(m, NIL);

  pProvideClassInfo->GetClassInfo(&pTypeInfo);
  if (pTypeInfo)
  {
    pTypeInfo->GetContainingTypeLib(&pTypeLib, &j);
    if (!pTypeLib)
      return MMpush(m, NIL);

    pTypeLib->GetTypeInfo(interf, &ptypeinfo);
    if (!ptypeinfo)
      return MMpush(m, NIL);

    ptypeinfo->GetTypeAttr(&attr);
    if (!attr) return MMpush(m, NIL);

    for (i = 0; i < attr->cFuncs; i++)
    {
//      if (MMpush(m,NIL)) return MERRMEM;

      ptypeinfo->GetFuncDesc(i, &pfuncdesc);
      if (!pfuncdesc) 
      {
        //MMechostr(1,"Function %d can't provide FUNCDESC struct.\n",i);
      }
      else
      {
        ptypeinfo->GetDocumentation(pfuncdesc->memid, &bstrName, &bstrDoc, NULL, &bstrHelpFile);
        invkind = pfuncdesc->invkind;
        nargs = pfuncdesc->cParams;
        dispid = pfuncdesc->memid;
        ptypeinfo->ReleaseFuncDesc(pfuncdesc);
        //$BLG
        //Note: put_Movie is "coded" as Movie (put_ is added later, as well as get_)
        //log(OLE2T(bstrName));
//      //MMechostr(1,"Function %d : %s [%s - %s].\n",i,OLE2T(bstrName),OLE2T(bstrDoc),OLE2T(bstrHelpFile));

/*
	//$BLG
  if (invkind == DISPATCH_METHOD)
  {
  	log("DISPATCH_METHOD");
  }
  else if (invkind == DISPATCH_PROPERTYGET)
  {
  	log("DISPATCH_PROPERTYGET");
  }
  else if (invkind == DISPATCH_PROPERTYPUT)  // <- Ex: put_Movie
  {
  	log("DISPATCH_PROPERTYPUT");
  }
  else if (invkind == DISPATCH_PROPERTYPUTREF)
  {
  	log("DISPATCH_PROPERTYPUTREF");
  }
  else if (invkind == INVOKE_PROPERTYGET)
  {
  	log("INVOKE_PROPERTYGET");
  }
  else if (invkind == INVOKE_PROPERTYPUT)
  {
  	log("INVOKE_PROPERTYPUT");
  }
*/
        
        //$BLG
        /*
        if (invkind==INVOKE_PROPERTYGET)
          strcpy(buf,"get_");
        else if (invkind==INVOKE_PROPERTYPUT)
          strcpy(buf,"put_");
        else if (invkind==DISPATCH_METHOD)
          strcpy(buf,"");
        */
        if ((invkind == INVOKE_PROPERTYGET) || (invkind == DISPATCH_PROPERTYGET))
          strcpy(buf, "get_");
        else if ((invkind == INVOKE_PROPERTYPUT) || (invkind == DISPATCH_PROPERTYPUT))
          strcpy(buf, "put_");
        else if (invkind == DISPATCH_METHOD)
          strcpy(buf, "");

        strcat(buf, OLE2T(bstrName));
        //$BLG
        //log("FUN:");
        //log(buf);

        if (MMpush(m, (obj*2)+1)) return MERRMEM;
        if (MMpush(m, i*2)) return MERRMEM;

        if (bstrName) 
        {
        	if (Mpushstrbloc(m, buf)) return MERRMEM;
        }
        else if (Mpushstrbloc(m, "UnknownName")) return MERRMEM;
      
        if (bstrDoc) 
        {
        	if (Mpushstrbloc(m, OLE2T(bstrDoc))) return MERRMEM;
        }
        else if (Mpushstrbloc(m, "UnknownDoc")) return MERRMEM;

        if (bstrHelpFile) 
        {
        	if (Mpushstrbloc(m, OLE2T(bstrHelpFile))) return MERRMEM;
        }
        else if (Mpushstrbloc(m, "UnknownHelpFile")) return MERRMEM;

        if (MMpush(m, nargs*2)) return MERRMEM;
        if (MMpush(m, dispid*2)) return MERRMEM;

        if (MMpush(m, IsEventInterface(object->pOleObject, attr->guid)*2)) return MERRMEM;
        if (MMpush(m, invkind*2)) return MERRMEM;

        if (bstrName) CoTaskMemFree(bstrName);
        if (bstrDoc) CoTaskMemFree(bstrDoc);
        if (bstrHelpFile) CoTaskMemFree(bstrHelpFile);      

        if (MMpush(m, 9*2)) return MERRMEM;
        if (MBdeftab(m)) return MERRMEM;
        obj = MMfetch(m, MMget(m, 0)>>1, 0)>>1;

        count++;
      }
    }

    //MMechostr(1,"OK\n");

    //MMechostr(1,"Count = %d\n",count);
    //MMechostr(1,"Unfold list...");
      
    if (MMpush(m, NIL)) return MERRMEM;
    for (i = 0; i < count; i++)
    {
      if (MMpush(m, 2*2)) return MERRMEM;
      if (MBdeftab(m)) return MERRMEM;
    }
    //MMechostr(1,"OK\n");
    ptypeinfo->ReleaseTypeAttr(attr);
    
    return 0;
  }
  else
    //MMechostr(1,"*** This object doesn't provide a TypeInfo interface\n");
  return MMpush(m, NIL);
}


// *****************************************************************************
// _AXGetFuncList
// *****************************************************************************
extern "C" int _AXGetFuncList(mmachine m)
{
  int ax, obj, funs = NIL, interf;
  Object *object;

log("\n");
log(".cpp: _AXGetFuncList()");

  //MMechostr(1,"\n\nGetting Functions list... \n\n");
  obj = MMpull(m)>>1;
  if (obj == NIL) return MMpush(m, NIL);
  ax = MMfetch(m, obj, 0)>>1;
  interf = MMfetch(m, obj, 1)>>1;

  if (ax == NIL) return MMpush(m, NIL);
  object = (Object*)MMfetch(m, ax, 0);

  if (object == NULL) 
  {
    //MMechostr(1,"Bad object...");
    return MMpush(m, NIL);
  }

  //MMechostr(1,"(object= %x)\n",object);
  return GetFuncs(m, object, interf, obj);
}


void FreeArgTable(DISPPARAMS DispParams)
{
	UINT i;

log(".cpp: FreeArgTable()");
	
	for (i = 0 ; i < DispParams.cArgs ; i++)
	{
		if (DispParams.rgvarg[i].bstrVal) SysFreeString(DispParams.rgvarg[i].bstrVal);
	}
	delete DispParams.rgvarg;
}


// *****************************************************************************
// _AXCallFunc
// *****************************************************************************
// fun _AXCallFunc (AXFun [S r1]) I
extern "C" int _AXCallFunc(mmachine m)
{
  USES_CONVERSION;
  int fun, params, interf, ax, nArgs, i;
  long dispidMember;
  Object *object;
  IDispatch *pDispatch;
  VARIANT VarResult, temp;
  DISPPARAMS DispParams = {NULL, NULL, 0, 0};
  int invkind;
  //$BLG - v4.6a5 : Add 3 next lines
  HRESULT hres;
  //char buf[256];
  int lDataType; //Unused at the moment (Not used with the proper functions: cf REMs below)

log("\n");
log(".cpp: _AXCallFunc()");

  //$BLG
  //log("BLG: Call _AXCallFunc\n");

  params = MMpull(m)>>1;
  fun = MMpull(m)>>1;

  //MMechostr(1,"Test fun\n");
  if (fun == NIL) return MMpush(m, NIL);
  if (MMfetch(m, fun, 7)>>1) return MMpush(m, NIL);

  interf = MMfetch(m, fun, 0)>>1;   
  //MMechostr(1,"Test interf\n");
  if (interf == NIL) return MMpush(m, NIL);

  ax = MMfetch(m, interf, 0)>>1;
  //MMechostr(1,"Test ax\n");
  if (ax == NIL) return MMpush(m, NIL);

  object = (Object*)MMfetch(m, ax, 0);
  //MMechostr(1,"Test object\n");
  if (object == NULL) return MMpush(m, NIL);

  __COM_ERROR(object->pOleControl->QueryInterface(IID_IDispatch, (void**)&pDispatch));

  if (!pDispatch) return MMpush(m, NIL);
  
  //$BLG - v5.01: Add
  //log("MyAdd");
  //pDispatch->AddRef();

  nArgs=MMfetch(m, fun, 5)>>1;
  //$BLG - v4.6a5 : Modif
  //DispParams.rgvarg=new VARIANTARG[nArgs];
  if (nArgs == 0)
  {
  	//log("---");
  	//log("BLIP0");
  	DispParams.rgvarg = NULL;
  }
  else
  {
  	DispParams.rgvarg = new VARIANTARG[nArgs];
  }
  
  //$BLG - v4.6a5 : Del (VariantInit, below, sets the variant to VT_EMPTY)
  //for (i=0;(i<nArgs);i++) DispParams.rgvarg[i].bstrVal=NULL;
  
  DispParams.cArgs = 0;
  //$BLG - v4.6a5: Added 2 next lines
  DispParams.cNamedArgs = 0;
  DispParams.rgdispidNamedArgs = NULL;  

  //MMechostr(1,"nArgs:%d\n",nArgs);
  //log("Args #");
  //log(itoa(nArgs, buf, 10));
  for (i = 0; (i < nArgs); i++)
  {
    int s;

		//log("---");

    if (params == NIL) break;

    VariantInit(&DispParams.rgvarg[i]);
    
    //$BLG - v4.6a5 : Added 2(3) next lines (cf above Del)
    DispParams.rgvarg[i].bstrVal = NULL;
    //DispParams.rgvarg[i].boolVal=NULL;
    DispParams.rgvarg[i].lVal = NULL;

		s = MMfetch(m, params, 0)>>1;
		if (s == NIL)
		{
			//log("BLIP1");
			//MMechostr(1,"Arg %d: NIL\n",i);
			DispParams.rgvarg[i].bstrVal = SysAllocString(T2OLE(""));
			//$BLG - v4.6a5: Added next lines
			if (!DispParams.rgvarg[i].bstrVal) 
	    {
	      //log("BSTR Alloc failed");
	      //MMechostr(1,"!DispParams.rgvarg[%d].bstrVal\n",i);
	      FreeArgTable(DispParams);
	      return MMpush(m, NIL);
	    }
		  DispParams.rgvarg[i].vt = VT_BSTR;
		  lDataType = VT_BSTR;
		}
    else
    {
			char *S;
		
			//$BLG - v4.6a5 : Add
			long lRes;
			
			S = MMstartstr(m, s);
			MMechostr(1,"Arg %d: %s\n", i, S);
			//log(S);
			//$BLG - v4.6a5: Del
			//DispParams.rgvarg[i].bstrVal=SysAllocString(T2OLE(S));

			//log("BLIP2");
			lRes = atol(S);
			//log(ltoa(lRes, buf, 10));
			if ((lRes == 0L) && strcmp(S, "0"))
			{
				DispParams.rgvarg[i].bstrVal = SysAllocString(T2OLE(S));
		    if (!DispParams.rgvarg[i].bstrVal) 
		    {
		      //log("BSTR Alloc failed");
		      //MMechostr(1,"!DispParams.rgvarg[%d].bstrVal\n",i);
		      FreeArgTable(DispParams);
		      return MMpush(m, NIL);
		    }
		    DispParams.rgvarg[i].vt = VT_BSTR;
		    //$BLG - v4.6a5 : Add
		    lDataType = VT_BSTR;
				//log("BSTR");
				//log(OLE2T(DispParams.rgvarg[i].bstrVal));
			}
			else
			{
				DispParams.rgvarg[i].lVal = lRes;
				DispParams.rgvarg[i].vt = VT_I4;
				//$BLG - v4.6a5 : Add
				lDataType = VT_I4;
				//log("LONG");
				//log(ltoa(DispParams.rgvarg[i].lVal, buf, 2));
			}
    }
/*  
	    //$BLG - v4.6a5 : Moved above
	    if (!DispParams.rgvarg[i].bstrVal) 
	    {
	      log("BSTR Alloc failed");
	      //MMechostr(1,"!DispParams.rgvarg[%d].bstrVal\n",i);
	      FreeArgTable(DispParams);
	      return MMpush(m,NIL);
	    }
	    DispParams.rgvarg[i].vt=VT_BSTR;
	  }
*/
    
    //log(OLE2T(DispParams.rgvarg[0].bstrVal));

    DispParams.cArgs++;
    params = MMfetch(m, params, 1)>>1;
  }

//log("---");

  //$BLG - v4.6a5 : Add
  DISPID dispidNamed = DISPID_PROPERTYPUT;
    
  dispidMember = MMfetch(m, fun, 6)>>1;
  invkind = MMfetch(m, fun, 8)>>1;
  //$BLG - v4.6a5 : Added test and "base" handling for Flash
  if (invkind == DISPATCH_METHOD)
  {
  	//log("DISPATCH_METHOD");
  }
  else if (invkind == DISPATCH_PROPERTYGET)
  {
  	//log("DISPATCH_PROPERTYGET");
  }
  else if (invkind == DISPATCH_PROPERTYPUT)  // <- Result for Flash
  {
  	//log("DISPATCH_PROPERTYPUT");
  	DispParams.cNamedArgs = 1;
    DispParams.rgdispidNamedArgs = &dispidNamed;
  }
  else if (invkind == DISPATCH_PROPERTYPUTREF)
  {
  	//log("DISPATCH_PROPERTYPUTREF");
  	DispParams.cNamedArgs = 1;
    DispParams.rgdispidNamedArgs = &dispidNamed;
  }

  //MMechostr(1,"DispParams.cArgs: %d\n",DispParams.cArgs);

//  OLECHAR FAR* szMember=T2OLE("GoHome");
//  OLECHAR FAR* szMember=T2OLE("GoForward");
//  __COM_ERROR(pDispatch->GetIDsOfNames(IID_NULL,&szMember,1,LOCALE_USER_DEFAULT,&dispidMember));
//  object->pOleControl->FreezeEvents(TRUE);
  //MMechostr(1,"dispidMember:%d\n",dispidMember);
//  method=DISPATCH_METHOD;

  //log(OLE2T(DispParams.rgvarg[0].bstrVal));
	//log("0");
  //$BLG - v4.6a5 : Added 3(4) next lines
  VariantInit(&VarResult);
  VarResult.bstrVal = NULL;
  //VarResult.boolVal = NULL;
  //$BLG - v4.6a5 : Modif
  VariantChangeType(&VarResult, &VarResult, VARIANT_NOUSEROVERRIDE, VT_BSTR);
	//VariantChangeType(&VarResult,&VarResult,VARIANT_NOUSEROVERRIDE,lDataType);
  //$BLG
  //__COM_ERROR(pDispatch->Invoke(dispidMember,IID_NULL,NULL,invkind,&DispParams,&VarResult,NULL,NULL));
  hres = pDispatch->Invoke(dispidMember, IID_NULL, NULL, invkind, &DispParams, &VarResult, NULL, NULL);
  __COM_ERROR(hres);
  //log("1");
/*
  if (hres==S_OK)
  {
  	log("S_OK");
  }
  else if (hres==DISP_E_BADPARAMCOUNT)
  {
  	log("DISP_E_BADPARAMCOUNT");
  }
  else if (hres==DISP_E_BADVARTYPE)
  {
  	log("DISP_E_BADVARTYPE");
  }
  else if (hres==DISP_E_EXCEPTION)
  {
  	log("DISP_E_EXCEPTION");
  }
  else if (hres==DISP_E_MEMBERNOTFOUND)
  {
  	log("DISP_E_MEMBERNOTFOUND");
  }
  else if (hres==DISP_E_NONAMEDARGS)
  {
  	log("DISP_E_NONAMEDARGS");
  }
  else if (hres==DISP_E_OVERFLOW)
  {
  	log("DISP_E_OVERFLOW");
  }
  else if (hres==DISP_E_PARAMNOTFOUND)
  {
  	log("DISP_E_PARAMNOTFOUND");
  }
  else if (hres==DISP_E_TYPEMISMATCH)
  {
  	log("DISP_E_TYPEMISMATCH");
  }
  else if (hres==DISP_E_UNKNOWNINTERFACE)
  {
  	log("DISP_E_UNKNOWNINTERFACE");
  }
  else if (hres==DISP_E_UNKNOWNLCID)
  {
  	log("DISP_E_UNKNOWNLCID");
  }
  else if (hres==DISP_E_PARAMNOTOPTIONAL)
  {
  	log("DISP_E_PARAMNOTOPTIONAL");
  }
*/
  //log(OLE2T(DispParams.rgvarg[0].bstrVal));

  //object->pOleControl->FreezeEvents(FALSE);
  FreeArgTable(DispParams);

  log("OldRel");
  pDispatch->Release();

  VariantInit(&temp);

  //$BLG - v4.6a5: Fixed this step
  //if (VariantChangeType(&temp,&VarResult,0,VT_BSTR)==S_OK)
  //hres = VariantChangeType(&temp,&VarResult,VARIANT_NOUSEROVERRIDE,lDataType);
  //$BLG - v4.6a5: New modif
  //hres = VariantChangeType(&temp,&VarResult,VARIANT_NOUSEROVERRIDE,VT_BSTR);
  //$BLG - v4.6a5: New modif
  if (VarResult.boolVal != VT_EMPTY)  // <- Should be an error
  {
    //log("VT_BOOL");
    //if (VarResult.bstrVal != NULL) log("Not empty");
    hres = VariantChangeType(&temp, &VarResult, VARIANT_LOCALBOOL, VT_BSTR);
  }
  else
  {
    //log("OTHER");
    hres = VariantChangeType(&temp, &VarResult, VARIANT_NOUSEROVERRIDE, VT_BSTR);
  }
  if (hres == S_OK)  
  {
    //$BLG - v4.6a5 : Added test and fixed bug (Now getting S_OK)
    //log("S_OK");
    //log(OLE2T(VarResult.bstrVal)); // <- output seen in the log if the value is NULL : (null)
    //log("0");
    //log(OLE2T(temp.bstrVal));      // <- output not seen in the log when previous value was NULL (but in our tests, we have no idea about the variant's type, maybe not bstr, although this doesn't explain why we do not get anything, or maybe simply a \n)
    //log("1");
    return Mpushstrbloc(m, OLE2T(temp.bstrVal));
  }
  else
  {
    //$BLG - v4.6a5 : Added test and fixed bug (Now getting S_OK)
/*
    if (hres == DISP_E_BADVARTYPE)
    {
    	log("DISP_E_BADVARTYPE");
    }
    else if (hres == DISP_E_OVERFLOW)
    {
    	log("DISP_E_OVERFLOW");
    }
    else if (hres == DISP_E_TYPEMISMATCH)
    {
    	log("DISP_E_TYPEMISMATCH");
    }    	
    else if (hres == E_INVALIDARG)
    {
    	log("E_INVALIDARG");
    }
    else if (hres == E_OUTOFMEMORY)
    {
    	log("E_OUTOFMEMORY");
    }      
*/
    return MMpush(m, NIL);
  }
}


// *****************************************************************************
// _AXGetFuncInfo
// *****************************************************************************
extern "C" int _AXGetFuncInfo(mmachine m)
{
  int fun, obj;

log("\n");
log(".cpp: _AXGetFuncInfo()");

  fun = MMpull(m)>>1;
  if (fun == NIL) return MMpush(m, NIL);
  obj = MMfetch(m, fun, 0)>>1;
  if (obj == NIL) return MMpush(m, NIL);
  if (!MMfetch(m, obj, 0)) return MMpush(m, NIL);


  if (MMpush(m, fun*2+1)) return MERRMEM;
  fun = MMget(m, 0)>>1;
  MMset(m, 0, MMfetch(m, fun, 2));

  if (MMpush(m, fun*2+1)) return MERRMEM;
  fun = MMget(m, 0)>>1;
  MMset(m, 0, MMfetch(m, fun, 3));
  
  if (MMpush(m, fun*2+1)) return MERRMEM;
  fun = MMget(m, 0)>>1;
  MMset(m, 0, MMfetch(m, fun, 4));

  if (MMpush(m, fun*2+1)) return MERRMEM;
  fun = MMget(m, 0)>>1;
  MMset(m, 0, MMfetch(m, fun, 5));

  if (MMpush(m, 4*2)) return MERRMEM;
  return MBdeftab(m);
}


#if 0
// VT_UI1
extern "C" int _AXS2VARIANT (mmachine m)
{
  USES_CONVERSION;
  int myvar,s;
  char *S;
  VARIANT *var;
//  VARIANT *varref;
  VARIANT dest;
  BSTR *v;

log(".cpp: _AXS2VARIANT()");

  s = MMpull(m)>>1;
  myvar = MMpull(m)>>1;

  if (myvar == NIL) 
  {
    MMpush(m, NIL);
    return 0;
  }

//  GetVars(m,myvar,var,varref);

  S = MMstartstr(m, s);
  dest.vt = VT_BSTR;

  v = new BSTR(T2OLE(S));
  dest.bstrVal = *v;

//  if (var->vt!=VT_ERROR);
//  VariantChangeType (var,&dest,0,var->vt);

  return MMpush (m, myvar*2+1);
}

extern "C" int _AXVARIANT2S (mmachine m)
{
  USES_CONVERSION;
  int myvar;
  VARIANT *var;
//  VARIANT *varref;
  VARIANT temp;

log(".cpp: _AXVARIANT2S()");

  myvar = MMpull(m)>>1;

  if (myvar == NIL) 
  {
    MMpush(m, NIL);
    return 0;
  }

//  GetVars(m,myvar,var,varref);
  VariantInit(&temp);

  if (VariantChangeType (&temp, var, 0, VT_BSTR) == S_OK)
    return Mpushstrbloc(m, OLE2T(temp.bstrVal));
  else
    return MMpush(m, NIL);
}
#endif


// *****************************************************************************
// _AXEnumControls
// *****************************************************************************
extern "C" int _AXEnumControls(mmachine m)
{
  long lCount = 0;
  int oldtuple = NIL;

log("\n");
log(".cpp: _AXEnumControls()");

  while (1)
  {
    HKEY Root, Root1, Root2;
    char Name[512], Name1[512], Name2[512], clsid[512];
    long lCopied;
    lCopied = 100;
    RegOpenKey(HKEY_CLASSES_ROOT, "", &Root);
    if ((RegEnumKey(Root, lCount, Name, 100)))
      break;
    lCount++;
    strcpy(Name2, Name);
    strcpy(Name1, Name);
    strcat(Name1, "\\CLSID");
    RegOpenKey(HKEY_CLASSES_ROOT, Name1, &Root1);
    RegQueryValue(Root1, 0, Name, &lCopied);
    lCopied = 100;
    strcpy(Name1, "CLSID\\");
    strcpy(clsid, Name);
    strcat(Name1, Name);
    strcat(Name1, "\\Control");
    if (!RegOpenKey(HKEY_CLASSES_ROOT, Name1, &Root2))
    {
      int hname, iname, guid, tuple;

      RegQueryValue(Root, Name2, Name, &lCopied);
      // Name contient le Nom , Name2 le prog ID et clsid le CLSID
      //MMechostr(1,"Human Name: %30s   Internal Name: %30s   CLSID:%s\n",Name,Name2,clsid);
      hname = MMmalloc(m, STRLEN(Name), TYPEBUF);
      if (hname == NIL) return MERRMEM;
      strcpy((char*)MMstartstr(m, hname), Name);
      MMstore(m, hname, 0, strlen(Name));
      MMpush(m, hname*2+1);
      
      iname = MMmalloc(m, STRLEN(Name2), TYPEBUF);
      if (iname == NIL) return MERRMEM;
      strcpy((char*)MMstartstr(m, iname), Name2);
      MMstore(m, iname, 0, strlen(Name2));
      MMpush(m, iname*2+1);
      
      guid = MMmalloc(m, STRLEN(clsid), TYPEBUF);
      if (guid == NIL) return MERRMEM;
      strcpy((char*)MMstartstr(m, guid), clsid);
      MMstore(m, guid, 0, strlen(clsid));

      iname = MMpull(m)>>1;
      hname = MMpull(m)>>1;

      tuple = MMmalloc(m, 4, TYPETAB);
      if (tuple == NIL) return MERRMEM;
      MMstore(m, tuple, 0, hname*2+1);
      MMstore(m, tuple, 1, iname*2+1);
      MMstore(m, tuple, 2, guid*2+1);
      MMstore(m, tuple, 3, oldtuple*2+1);
      oldtuple = tuple;
      //      memcpy(MMstartstr(m,dest),&id,16);
    }
    RegCloseKey(Root);
    RegCloseKey(Root1);
    RegCloseKey(Root2);
  }

  return MMpush(m, oldtuple*2+1);
}


// *****************************************************************************
// _AXSetSize
// *****************************************************************************
int _AXSetSize(mmachine m)
{
  int ax, x, y, w, h;
  Object *object;
  SIZEL size;
  IOleInPlaceObject *p;

log("\n");
log(".cpp: _AXSetSize()");

  h = MMpull(m)>>1;
  w = MMpull(m)>>1;
  y = MMpull(m)>>1;
  x = MMpull(m)>>1;
  ax = MMget(m,0)>>1;

  //MMechostr(1,"_AXSetSize %d %d\n",w,h);

  if (w == NIL) return 0;
  if (h == NIL) return 0;
  if (ax == NIL) return 0;
  object = (Object*)MMfetch(m, ax, 0);

  size.cx = w;
  size.cy = h;

  if (object == NULL) 
  {
    //MMechostr(1,"Bad object...");
    return 0;
  }

  if (object->pOleObject)
  {
    //MMechostr(1,"Setting size of AX object.\n");
    object->pOleObject->SetExtent(DVASPECT_CONTENT, &size);
  }

  if (object->pOleObject->QueryInterface(IID_IOleInPlaceObject, (void **)&p) != S_OK)
  {
    //MMechostr(1,"Unable to get IOleInPlaceObject.\n");
    return 0;
  }
  RECT rect;
  rect.left = x;
  rect.right = w;
  rect.top = y;
  rect.bottom = h;
  //MMechostr(1,"_AXSetSize rect x=%d y=%d w=%d h=%d\n",x,y,w,h);
  p->SetObjectRects(&rect, &rect);

  return 0;
}


// *****************************************************************************
// _AXrflEvent
// *****************************************************************************
int _AXrflEvent(mmachine m)
{
log("\n");
log(".cpp: _AXrflEvent()");

	return OBJaddreflex(m, XTobj, RFLXTENSION_EVENT);
}




// *****************************************************************************
// ActiveX Package
// *****************************************************************************

#define NXTensionPKG 16

char * XTensionname [ NXTensionPKG ] = 
{
	"_AXstring2GUID",
	"_AXCreateInstance",
	"_AXDestroyInstance",
	"_AXEnumControls",
	"_AXEnumInterfaces",
	"_AXSetSite",
	"_AXGetFuncList",
	"_AXGetFuncInfo",
	"_AXCallFunc",
	"_AXrflEvent",
	"_AXGetInterfaceInfo",
	"_AXSetSize",
	
	"AX",
	"GUID",
	"AXFun",
	"AXInterface"
};

char * XTensiontype [ NXTensionPKG ] = 
{
	"fun [S] GUID",
	"fun [Chn GUID] AX",
	"fun [AX] AX",
	"fun [] [S S S r1]",
	"fun [AX] [AXInterface r1]",
	"fun [ObjWin AX] AX",
	"fun [AXInterface] [AXFun r1]",
	"fun [AXFun] [S S S I]",
	"fun [AXFun [S r1]] S",
	"fun [AX fun [AX u0 S [S r1]] S u0] AX",
	"fun [AXInterface] [S S S I]",
	"fun [AX I I I I] AX",
	
	NULL,
	NULL,
	NULL,
	NULL
};

int XTensionnarg [ NXTensionPKG ] = 
{
	1,
	2,
	1,
	0,
	1,
	2,
	1,
	1,
	2,
	3,
	1,
	5,
	
	TYPTYPE,
	TYPTYPE,
	TYPTYPE,
	TYPTYPE
};

int (*XTensionfun[NXTensionPKG])(mmachine m)= 
{
	_AXstring2GUID,
	_AXCreateInstance,
	_AXDestroyInstance,
	_AXEnumControls,
	_AXEnumInterfaces,
	_AXSetSite,
	_AXGetFuncList,
	_AXGetFuncInfo,
	_AXCallFunc,
	_AXrflEvent,
	_AXGetInterfaceInfo,
	_AXSetSize,
	
	NULL,
	NULL,
	NULL,
	NULL
};



int AXdestroy (mmachine m, int handsys, int objm);
int xAXfun(mmachine m, HWND hwnd, unsigned msg, UINT wParam, LONG lParam, int *ret);

int AXdestroy (mmachine m, int handsys, int objm)
{
  Object *object;
 
 log(".cpp: AXdestroy()");
 
  //MMechostr(1,"AXObject Destroy.... handsys: %X  objm: %X\n",handsys,objm);
  object = (Object *)handsys;
  if (object) delete object;
  return 0;
}

int xAXfun(mmachine m, HWND hwnd, unsigned msg, UINT wParam, LONG lParam, int *ret)
//int AXfun (mmachine m,short wParam,long lParam)
{
  char buf[1024];
  RFLstruct *p = (RFLstruct *)lParam;
 
 log(".cpp: xAXfun()");
 
  if (!p) return 0;
  if (!p->obj) return 0;

  int k = OBJbeginreflex(m, XTobj,(int)p->obj, RFLXTENSION_EVENT);
  if (k == 0)
	{
    FindInterface(p->obj, p->dispid, buf);
    //MMechostr(1,"Invoke received: [DispID: %d] [%s] ",(int)p->dispid,buf);
    if (Mpushstrbloc(m, buf) < 0) return MERRMEM;
    for (int i = 0; i < p->nelems; i++)
    {
      if (p->elems[i])
      {
        if (Mpushstrbloc(m, p->elems[i]) < 0) return MERRMEM;
        //MMechostr(1," - %s",p->elems[i]);
      }
      else
      {
        //MMechostr(1," - [null]");
        if (MMpush(m, NIL)<0) return MERRMEM;
      }
//	    delete p->elems[i];
    }
    if (MMpush(m, NIL)<0) return MERRMEM;
    for (i=0; i<p->nelems; i++)
    {    
      if (MMpush(m,4) < 0) return MERRMEM;
      if (MBdeftab(m) < 0) return MERRMEM;
    }
    //MMechostr(1,"\n");
    if (OBJcallreflex(m, 2)) return 0;
  }

  p->obj->Dispatch.DeleteReflex(p);
//  delete p->elems;
//  delete p;
  
  return 0;
}



extern "C" __declspec(dllexport) int SCOLloadXTension(mmachine m, cbmachine w)
{
  int k;
  ww = w;

log(".cpp: Load XTension");

	MMechostr(0, "BLG: Load XTension\n");

  k = (PKhardpak(m, OBJXTVER, NXTensionPKG, XTensionname, XTensionfun, XTensionnarg, XTensiontype));
  __COM_ERROR(OleInitialize(NULL));
  XTobj=OBJregister(1, 0, AXdestroy, "OBJXT");
  //MMechostr(1, "Dll Loaded\n");
  WM_XTEvent = OBJgetUserEvent();
  //MMechostr(1, "WM_XTEvent=%d\n",WM_XTEvent);
  HScol = (HWND)SCgetExtra("hscol");;
  OBJdefEvent(WM_XTEvent, (int (__cdecl *)(struct Mmachine *, int, unsigned int, int, int, int *))xAXfun);

#ifdef __LOGIT__
  FILE* f = fopen("c:\\_Scol_ActiveX.log","w");
  if (f) 
  {
    fprintf(f, "Session startup!\n\n");
    fclose(f);
  }
#endif

log(".cpp: XTension Loaded");

  //MMechostr(0, "Loaded XTension....\n");

  return k;
}