suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed bug that prevented from accessing ActiveX components that did not expose type information.

Browse Source 
Signed-off-by: José Lopes <jose.lopes@ist.utl.pt>
This commit is contained in:
Jose Lopes 2011-05-27 16:01:03 +01:00 committed by Matthew Flatt
parent bbfeb85440
commit 84415dd4a9
1 changed files with 43 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/mysterx/mysterx.cxx
View File

@ -1076,7 +1076,7 @@ Scheme_Object *mx_set_coclass_from_progid(int argc, Scheme_Object **argv)
return scheme_void; return scheme_void;
} }
ITypeInfo *typeInfoFromComObject(MX_COM_Object *obj) ITypeInfo *typeInfoFromComObject(MX_COM_Object *obj, bool exn)
{ {
HRESULT hr; HRESULT hr;
ITypeInfo *pITypeInfo; ITypeInfo *pITypeInfo;
@ -1084,18 +1084,37 @@ ITypeInfo *typeInfoFromComObject(MX_COM_Object *obj)
unsigned int count; unsigned int count;
pITypeInfo = obj->pITypeInfo; pITypeInfo = obj->pITypeInfo;
if (pITypeInfo) return pITypeInfo;
if (pITypeInfo)
return pITypeInfo;
pIDispatch = obj->pIDispatch; pIDispatch = obj->pIDispatch;
pIDispatch->GetTypeInfoCount(&count); pIDispatch->GetTypeInfoCount(&count);
if (count == 0)
if (count == 0) {
if (exn) {
scheme_signal_error("COM object does not expose type information"); scheme_signal_error("COM object does not expose type information");
} else {
return NULL;
}
}
hr = pIDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pITypeInfo); hr = pIDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pITypeInfo);
if (FAILED(hr) || pITypeInfo == NULL) if (FAILED(hr) || pITypeInfo == NULL)
codedComError("Error getting COM type information", hr); codedComError("Error getting COM type information", hr);
obj->pITypeInfo = pITypeInfo; obj->pITypeInfo = pITypeInfo;
return pITypeInfo; return pITypeInfo;
} }
ITypeInfo *typeInfoFromComObjectExn(MX_COM_Object *obj)
{
return typeInfoFromComObject(obj, true);
}
Scheme_Object *mx_com_get_object_type(int argc, Scheme_Object **argv) Scheme_Object *mx_com_get_object_type(int argc, Scheme_Object **argv)
{ {
ITypeInfo *pITypeInfo; ITypeInfo *pITypeInfo;
@ -1105,7 +1124,7 @@ Scheme_Object *mx_com_get_object_type(int argc, Scheme_Object **argv)
GUARANTEE_COM_OBJ("com-object-type", 0); GUARANTEE_COM_OBJ("com-object-type", 0);
obj = (MX_COM_Object *)argv[0]; obj = (MX_COM_Object *)argv[0];
pITypeInfo = typeInfoFromComObject(obj); pITypeInfo = typeInfoFromComObjectExn(obj);
retval = (MX_COM_Type *)scheme_malloc_tagged(sizeof(MX_COM_Type)); retval = (MX_COM_Type *)scheme_malloc_tagged(sizeof(MX_COM_Type));
retval->so.type = mx_com_type_type; retval->so.type = mx_com_type_type;
retval->released = FALSE; retval->released = FALSE;
@ -1142,7 +1161,7 @@ Scheme_Object *mx_com_is_a(int argc, Scheme_Object **argv)
GUARANTEE_COM_OBJ("com-is-a?", 0); GUARANTEE_COM_OBJ("com-is-a?", 0);
GUARANTEE_COM_TYPE("com-is-a?", 1); GUARANTEE_COM_TYPE("com-is-a?", 1);
pITypeInfo1 = typeInfoFromComObject((MX_COM_Object *)argv[0]); pITypeInfo1 = typeInfoFromComObjectExn((MX_COM_Object *)argv[0]);
pITypeInfo2 = MX_COM_TYPE_VAL((MX_COM_Type *)argv[1]); pITypeInfo2 = MX_COM_TYPE_VAL((MX_COM_Type *)argv[1]);
return typeInfoEq(pITypeInfo1, pITypeInfo2) ? scheme_true : scheme_false; return typeInfoEq(pITypeInfo1, pITypeInfo2) ? scheme_true : scheme_false;
} }
@ -1164,7 +1183,7 @@ Scheme_Object *mx_com_help(int argc, Scheme_Object **argv)
? MX_COM_TYPE_VAL(argv[0]) ? MX_COM_TYPE_VAL(argv[0])
: (MX_COM_OBJ_VAL(argv[0]) == NULL) : (MX_COM_OBJ_VAL(argv[0]) == NULL)
? (scheme_signal_error("com-help: NULL COM object"), (ITypeInfo*)NULL) ? (scheme_signal_error("com-help: NULL COM object"), (ITypeInfo*)NULL)
: typeInfoFromComObject((MX_COM_Object *)argv[0]); : typeInfoFromComObjectExn((MX_COM_Object *)argv[0]);
hr = pITypeInfo->GetDocumentation(MEMBERID_NIL, NULL, NULL, NULL, hr = pITypeInfo->GetDocumentation(MEMBERID_NIL, NULL, NULL, NULL,
&helpFileName); &helpFileName);
@ -1570,7 +1589,7 @@ MX_TYPEDESC *typeDescFromTypeInfo(LPCTSTR name, INVOKEKIND invKind,
return retval; return retval;
} }
MX_TYPEDESC *getMethodType(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind) MX_TYPEDESC *getMethodType(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind, bool exn)
{ {
IDispatch *pIDispatch; IDispatch *pIDispatch;
MX_TYPEDESC *pTypeDesc; MX_TYPEDESC *pTypeDesc;
@ -1593,10 +1612,16 @@ MX_TYPEDESC *getMethodType(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
if (pITypeInfo == NULL) if (pITypeInfo == NULL)
scheme_signal_error("Can't find event type information"); scheme_signal_error("Can't find event type information");
} else } else {
pITypeInfo = typeInfoFromComObject(obj); pITypeInfo = typeInfoFromComObject(obj, exn);
if (pITypeInfo == NULL) {
return NULL;
}
}
pTypeDesc = typeDescFromTypeInfo(name, invKind, pITypeInfo); pTypeDesc = typeDescFromTypeInfo(name, invKind, pITypeInfo);
// pTypeDesc may be NULL // pTypeDesc may be NULL
if (pTypeDesc != NULL) if (pTypeDesc != NULL)
addTypeToTable(obj, name, invKind, pTypeDesc); addTypeToTable(obj, name, invKind, pTypeDesc);
@ -1604,6 +1629,11 @@ MX_TYPEDESC *getMethodType(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
return pTypeDesc; return pTypeDesc;
} }
MX_TYPEDESC *getMethodTypeExn(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
{
return getMethodType(obj, name, invKind, true);
}
static int dispatchCmp(const char * s1, const char * * s2) static int dispatchCmp(const char * s1, const char * * s2)
{ {
return lstrcmp(s1, *s2); return lstrcmp(s1, *s2);
@ -1724,7 +1754,7 @@ Scheme_Object *mx_do_get_methods(int argc, Scheme_Object **argv,
scheme_signal_error("com-{methods, {get, set}-properties}: NULL COM object"); scheme_signal_error("com-{methods, {get, set}-properties}: NULL COM object");
return NULL; return NULL;
} else { } else {
pITypeInfo = typeInfoFromComObject((MX_COM_Object *)argv[0]); pITypeInfo = typeInfoFromComObjectExn((MX_COM_Object *)argv[0]);
} }
hr = pITypeInfo->GetTypeAttr(&pTypeAttr); hr = pITypeInfo->GetTypeAttr(&pTypeAttr);
@ -2428,7 +2458,7 @@ Scheme_Object *mx_do_get_method_type(int argc, Scheme_Object **argv,
scheme_signal_error("com-method-type: IDispatch methods not available"); scheme_signal_error("com-method-type: IDispatch methods not available");
if (MX_COM_OBJP(argv[0])) if (MX_COM_OBJP(argv[0]))
pTypeDesc = getMethodType((MX_COM_Object *)argv[0], name, invKind); pTypeDesc = getMethodTypeExn((MX_COM_Object *)argv[0], name, invKind);
else { else {
pITypeInfo = pITypeInfo =
@ -4312,7 +4342,7 @@ static Scheme_Object *mx_make_call(int argc, Scheme_Object **argv,
// check arity, types of method arguments // check arity, types of method arguments
pTypeDesc = getMethodType((MX_COM_Object *)argv[0], name, invKind); pTypeDesc = getMethodType((MX_COM_Object *)argv[0], name, invKind, false);
#ifndef _WIN64 #ifndef _WIN64
// try direct call via function pointer // try direct call via function pointer