/*[ Title: "com2rebol.c C DLL file" File: %com2rebol.c Date: 7-Jul-2006 Version: 1.0.8 Progress: 0.55 Status: "working" Needs: [] Author: ["Benjamin Maggi" "Anton Rolls"] Language: "English" Purpose: {Wrap DispHelper in a DLL, providing some extra functions to allow Rebol to use COM} Usage: {} License: "BSD" History: [ 1.0.0 [21-Dec-2005 {First version based on Benjamin Maggi's version, Fixed AnsiToUnicode type casting warnings. Had some compiler warnings, fixed by using or casting to the right types: from LPCWSTR -> LPWSTR and LPOLESTR -> LPCOLESTR and casting the CoTaskMemFree argument to the right type (PVOID), Changed showMessage argument and variable names. } "Anton"] 1.0.1 [10-Jun-2006 {removed makeContainer, was not properly functioning and was not used anywhere, setErrorHandler argument changed from int to void (*function)(PDH_EXCEPTION pException), renamed setErrorHandler -> setExceptionHandler } "Anton"] 1.0.2 [11-Jun-2006 {removed initDispHelper and closeDispHelper functions and moved code into LibMain} "Anton"] 1.0.3 [12-Jun-2006 {added setException} "Anton"] 1.0.4 [14-Jun-2006 {renamed LibMain -> DllMain which allowed entry to the dll on loading it, added showMessageF} "Anton"] 1.0.5 [15-Jun-2006 {added getLastException, formatException, formatLastException, showLastException, removed setException, removed setExceptionHandler} "Anton"] 1.0.6 [17-Jun-2006 {renamed PutValue -> putValue, renamed GetValueGeneric -> getValueV} "Anton"] 1.0.7 [21-Jun-2006 {getInteger, getString and getObject now all return HRESULT, added getStringCleanup} "Anton"] 1.0.8 [7-Jul-2006 {added putRef} "Anton"] ] ToDo: { - get exceptions back to rebol, using a struct created in rebol ? - create and pass a DH_EXCEPTION struct to the DLL - most com2rebol.c functions should return HRESULT (which is < 0 when there was an exception), - therefore comlib.r routines also return HRESULT, - comlib.r functions wrap these routine see failure result and look in the DH_EXCEPTION struct, then throw an appropriate rebol error. - vformat: should probably try to change vsnprintf -> vsnwprintf (wide chars) ? and use dhFormatExceptionW etc... - Future: Allow multiple threads: - create a new DH_EXCEPTION_OPTIONS struct per thread. Currently exceptions_options is shared by all threads. That could easily muck things up if two threads both throw an exception. (Although, it looks like disphelper uses some thread handling using InterlockedIncrement ?) http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/interlockedincrement.asp - copy a string from the DLL to rebol using a WM_COPYDATA Window Message, a method used in http://www.codeproject.com/threads/interprocesscommunication.asp The rebol wrapper function would have to wait on the system port when there was an exception. - idea: when threads attach, generate a unique id and pass it back to the thread somehow. Later, this id can be used to select the structures associated with the thread to copy into etc. eg. exception structure } Notes: { COM2REBOL is free open source software provided under the BSD license. It's Based on "DispHelper" by xmouse. See http://disphelper.sourceforge.net/ Some code I tried and rejected, because rebol callbacks are async. // 1. Create a PDH_EXCEPTION_OPTIONS struct DH_EXCEPTION_OPTIONS exception_options = {0}; DLLIMPORT HRESULT setExceptionHandler( void (*function)(PDH_EXCEPTION) // PDH_EXCEPTION pException ){ // 2. Initialise it with default values and the rebol callback function //ZeroMemory(&exception_options, sizeof(DH_EXCEPTION_OPTIONS)); exception_options.hwnd = (HWND)NULL; // <-- exception_options.szAppName = (LPCWSTR)NULL; exception_options.bShowExceptions = (BOOL)FALSE; exception_options.bDisableRecordExceptions = (BOOL)FALSE; exception_options.pfnExceptionCallback = (DH_EXCEPTION_CALLBACK)function; // set the callback function // the callback will actually be called later by dhExitEx in disphelper.c, should an exception occur // 3. Call dhSetExceptionOptions, passing the struct // dhSetExceptionOptions returns an HRESULT (typedef LONG in windef.h) // which is usually NOERROR (0) or E_INVALIDARG ((HRESULT)0x80070057L) (both defined in winerror.h) dhSetExceptionOptions(&exception_options); } ... return C2R_EXIT(dhCreateObject(objName, NULL, ppDisp), objName); // using C2R_EXIT modified from DH_EXIT } ]*/ #include // (also included by com2rebol.h) #include #define DISPHELPER_INTERNAL_BUILD // Used in disphelper.h #include "disphelper.h" // (also included by com2rebol.h) #include "com2rebol.h" // declares com2rebol public interface function prototypes #include /*---------------------------------------------------------------------------------------------------------- * Procedure: LibMain ID:1 * Purpose: DLL entry point. Called when a dll is loaded or * unloaded by a process, and when new threads are * created or destroyed. * Inputs: hDllInst: Instance handle of the dll * fdwReason: event: attach/detach * lpvReserved: not used * Output: The return value is used only when the fdwReason is * DLL_PROCESS_ATTACH. True means that the dll has * succesfully loaded, False means that the dll is unable * to initialize and should be unloaded immediately. * Errors: *----------------------------------------------------------------------------------------------------------*/ //BOOL WINAPI __declspec(dllexport) LibMain(HINSTANCE hDLLInst, DWORD fdwReason, LPVOID lpvReserved) BOOL APIENTRY DllMain(HINSTANCE Inst, DWORD reason, LPVOID reserved) // <-- this works with DevCPP { switch (reason) { case DLL_PROCESS_ATTACH: // The DLL is being loaded for the first time by a given process. // Perform per-process initialization here. If the initialization // is successful, return TRUE; if unsuccessful, return FALSE. //showMessageF("Process attach, dhInitialize. sizeof(DH_EXCEPTION) == %d", sizeof(DH_EXCEPTION)); dhInitialize(TRUE); //dhToggleExceptions((BOOL)TRUE); // By default, show exceptions in a MessageBox. dhToggleExceptions((BOOL)FALSE); // By default, do not show exceptions in a MessageBox. break; case DLL_PROCESS_DETACH: // The DLL is being unloaded by a given process. Do any // per-process clean up here, such as undoing what was done in // DLL_PROCESS_ATTACH. The return value is ignored. dhUninitialize(TRUE); break; case DLL_THREAD_ATTACH: // A thread is being created in a process that has already loaded // this DLL. Perform any per-thread initialization here. The // return value is ignored. break; case DLL_THREAD_DETACH: // A thread is exiting cleanly in a process that has already // loaded this DLL. Perform any per-thread clean up here. The // return value is ignored. break; } return TRUE; } DLLIMPORT void showMessage(LPCSTR message) { MessageBox(0, message, "com2rebol:", MB_OK | MB_ICONINFORMATION); } // -------------- create formatted strings ------------------ // creates a free()able string, formatted as in printf, with just the right length. DLLIMPORT char * format(const LPCSTR message, ...) { // just wrap around vformat va_list marker; va_start(marker, message); return vformat (message, marker); va_end(marker); } DLLIMPORT char * vformat(const LPCSTR message, __VALIST args) // va_list *args) { char *string; int n, size = 100; // Guess we need no more than 100 bytes. va_list marker; if ((string = malloc (size)) == NULL) return NULL; while (1) { // Try to print in the allocated space. marker = args; n = vsnprintf (string, size, message, marker); //oldShowMessageF("vsnprintf result: %d", n); // I'm getting n = -1 on DevC++ 4.9.9.1 va_end(marker); // If that worked, return the string. if (n > -1 && n < size) return string; // Else try again with more space. if (n > -1) // glibc 2.1 size = n+1; // precisely what is needed else // glibc 2.0 size *= 2; // twice the old size if ((string = realloc (string, size)) == NULL) return NULL; } } // --------- formatted exceptions in message boxes ----------------- // Shows a message box with message string formatted as in printf. /*void oldShowMessageF(const LPCSTR message, ...) { char string[512]; // <-- hardcoded limit 512 characters va_list marker; va_start(marker, message); vsprintf(string, message, marker); MessageBox(0, string, "com2rebol:", MB_OK | MB_ICONINFORMATION); va_end(marker); }*/ // Shows a message box with message string formatted as in printf. DLLIMPORT void showMessageF(const LPCSTR message, ...) { char *string; va_list marker; va_start(marker, message); string = vformat (message, marker); if (string) { MessageBox(0, string, "com2rebol:", MB_OK | MB_ICONINFORMATION); free(string); } va_end(marker); } DLLIMPORT PDH_EXCEPTION getLastException() { PDH_EXCEPTION pException = NULL; dhGetLastException(&pException); // <- assuming no failure return pException; } /*// new.... DLLIMPORT PDH_EXCEPTION copyLastException(PDH_EXCEPTION pException) { dhGetLastException(&pException); // <-- also copy exception strings to rebol //dhCleanupThreadException(); return pException; // <-- probably better to return HRESULT and use DH_ENTER, DH_EXIT }*/ DLLIMPORT LPCSTR formatException(PDH_EXCEPTION pException) { static char szBuffer[1024]; ZeroMemory(szBuffer, sizeof(szBuffer)); BOOL bFixedFont = FALSE; dhFormatExceptionA(pException, szBuffer, ARRAYSIZE(szBuffer), bFixedFont); return szBuffer; // the caller should copy this string before the next call } DLLIMPORT LPCSTR formatLastException() { formatException(getLastException()); } DLLIMPORT void showLastException() { showMessageF(formatLastException()); } // set exception mode: TRUE dhShowException will be called. FALSE dhShowException will not be called. DLLIMPORT void toggleExceptions(int option) { dhToggleExceptions((BOOL)option); } DLLIMPORT HRESULT createObject(LPCSTR ansiObjName, IDispatch **ppDisp) // <-- could pass in an exception struct to copy to ? { LPCOLESTR objName; DH_ENTER(L"createObject"); AnsiToUnicode(ansiObjName, &objName); return DH_EXIT(dhCreateObject(objName, NULL, ppDisp), objName); } /*// new untested way passes in an exception struct... DLLIMPORT HRESULT createObject(LPCSTR ansiObjName, IDispatch **ppDisp, PDH_EXCEPTION pException) { HRESULT hr; LPCOLESTR objName; DH_ENTER(L"CreateObject"); AnsiToUnicode(ansiObjName, &objName); hr = DH_EXIT(dhCreateObject(objName, NULL, ppDisp), objName); if (FAILED(hr)) { // copy current exception to supplied exception struct *pException = *getLastException; // <- clone the 5 strings referred to inside the struct. I am pretty sure rebol would clone these for you. // and cleanup of these strings would probably be done by dhExitEx on the next exception. } return hr; }*/ // Release an object DLLIMPORT HRESULT releaseObject(IDispatch *obj) { SAFE_RELEASE(obj); return NOERROR; } DLLIMPORT HRESULT callMethod(IDispatch *pDisp, LPCSTR szMember, ... ) { HRESULT hr; LPCOLESTR szMemberOle; va_list marker; DH_ENTER(L"callMethod"); va_start(marker, szMember); AnsiToUnicode(szMember, &szMemberOle); hr = dhCallMethodV(pDisp, szMemberOle, &marker); va_end(marker); return DH_EXIT(hr, szMemberOle); } // GetValue variadic wrapper HRESULT getValueV(LPCSTR szIdentifier, void *pResult, IDispatch *pDisp, LPCSTR szMember, va_list *marker) { HRESULT hr; LPCOLESTR szMemberOle; LPWSTR szIdentifierWs; // LPWSTR defined in winnls.h DH_ENTER(L"getValueV"); //------------------------------------------------------------------------------------- DWORD dwSize; dwSize = MultiByteToWideChar(CP_ACP, 0, szIdentifier, -1, NULL, 0); szIdentifierWs = (LPWSTR) malloc (dwSize*sizeof(WCHAR)); if ( !MultiByteToWideChar(CP_ACP, 0, szIdentifier, -1, szIdentifierWs, dwSize) ) { return HRESULT_FROM_WIN32( GetLastError() ); } //------------------------------------------------------------------------------------- AnsiToUnicode(szMember,&szMemberOle); hr = dhGetValueV(szIdentifierWs, pResult, pDisp, szMemberOle, marker); return DH_EXIT(hr, szMemberOle); } DLLIMPORT HRESULT getInteger(UINT *result, IDispatch *pDisp, LPCSTR szMember, ...) { HRESULT hr; va_list marker; LPCOLESTR szMemberOle; DH_ENTER(L"getInteger"); AnsiToUnicode(szMember, &szMemberOle); va_start(marker, szMember); hr = getValueV("%d", result, pDisp, szMember, &marker); va_end(marker); return DH_EXIT(hr, szMemberOle); } // Gets a null terminated string static LPCSTR globalString = 0; DLLIMPORT HRESULT getString(LPCSTR *result, IDispatch *pDisp, LPCSTR szMember, ...) { HRESULT hr; LPCOLESTR szMemberOle; va_list marker; DH_ENTER(L"getString"); AnsiToUnicode(szMember, &szMemberOle); va_start(marker, szMember); //By default %s means ANSI string while %S is a WCHAR. Don't change it ! hr = getValueV("%s", result, pDisp, szMember, &marker); globalString = *result; // <--------- va_end(marker); return DH_EXIT(hr, szMemberOle); } DLLIMPORT void getStringCleanup() { dhFreeString(globalString); } DLLIMPORT HRESULT getObject(IDispatch **result, IDispatch *pDisp, LPCSTR szMember, ...) { HRESULT hr; LPCOLESTR szMemberOle; va_list marker; DH_ENTER(L"getObject"); AnsiToUnicode(szMember, &szMemberOle); va_start(marker, szMember); getValueV("%o", result, pDisp, szMember, &marker); va_end(marker); return DH_EXIT(hr, szMemberOle); } /* Non-variadic version (untested) DLLIMPORT HRESULT getObject(IDispatch **result, LPCSTR szPathNameA, LPCSTR szProgIdA) { HRESULT hr; LPCOLESTR szPathName; LPCOLESTR szProgId; DISPATCH_OBJ(object); AnsiToUnicode(szPathNameA, &szPathName); AnsiToUnicode(szProgIdA, &szProgId); DH_ENTER(L"getObject"); hr = dhGetObject(szPathName, szProgId, result); return DH_EXIT(hr, szProgId); }*/ // putValue variadic wrapper (same as dhPutValue but this converts ansi -> unicode first) DLLIMPORT HRESULT putValue(IDispatch * pDisp, LPCSTR szMember, ...) { HRESULT hr; LPCOLESTR szMemberOle; va_list marker; DH_ENTER(L"putValue"); AnsiToUnicode(szMember,&szMemberOle); va_start(marker, szMember); hr = dhPutValueV(pDisp, szMemberOle, &marker); va_end(marker); return DH_EXIT(hr, szMemberOle); } // putRef (same as dhPutRef but this converts ansi -> unicode first) DLLIMPORT HRESULT putRef(IDispatch * pDisp, LPCSTR szMember, ...) { HRESULT hr; LPCOLESTR szMemberOle; va_list marker; DH_ENTER(L"putRef"); AnsiToUnicode(szMember,&szMemberOle); va_start(marker, szMember); hr = dhPutRefV(pDisp, szMemberOle, &marker); va_end(marker); return DH_EXIT(hr, szMemberOle); } //dhEnumBegin(IEnumVARIANT **ppEnum, IDispatch *pDisp, LPCOLESTR szMember, ...) DLLIMPORT HRESULT enumBegin(IEnumVARIANT **ppEnum, IDispatch *pDisp, LPCSTR szMember, ...) { LPCOLESTR szMemberOle; va_list marker; va_start(marker, szMember); DH_ENTER(L"enumBegin"); AnsiToUnicode(szMember, &szMemberOle); DH_EXIT(dhEnumBeginV(ppEnum, pDisp, szMemberOle, &marker), szMemberOle); } //dhEnumNextObject(IEnumVARIANT * pEnum, IDispatch ** ppDisp) DLLIMPORT HRESULT enumNextObject(IDispatch **ppDisp, IEnumVARIANT *pEnum) { DISPATCH_OBJ(object); DH_ENTER(L"enumNextObject"); DH_EXIT(dhEnumNextObject(pEnum, ppDisp), L"enumNextObject"); // yes the args are the other way around } /*----------------------------------------------------------------------------------------------------------- * Convert ANSI to Wide Char * MSDN Link * http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/unicode_17si.asp *----------------------------------------------------------------------------------------------------------*/ LPCWSTR AnsiToWideChar(LPCSTR ansi) { //DWORD length; // <- we get away with this but I think it's actually wrong type int length; LPWSTR wide; // CP_ACP The current system Windows ANSI code page length = MultiByteToWideChar(CP_ACP, 0, ansi, -1, NULL, 0); wide = (LPWSTR) malloc(length * sizeof(WCHAR)); if ( !MultiByteToWideChar(CP_ACP, 0, ansi, -1, wide, length) ) { return NULL; } return wide; } /* LPCSTR szAnsiIdentifier; LPWSTR szIdentifier; DWORD length = MultiByteToWideChar(CP_ACP, 0, szAnsiIdentifier, -1, NULL, 0); szIdentifier = (LPWSTR) malloc (length * sizeof(WCHAR)); if ( !MultiByteToWideChar(CP_ACP, 0, szAnsiIdentifier, -1, szIdentifier, length) ) { return HRESULT_FROM_WIN32( GetLastError() ); } */ /*------------------------------------------------------------------------------------------------------------ * How To Convert from ANSI to Unicode & Unicode to ANSI for OLE * At MSDN Article ID: 138813 * AnsiToUnicode converts the ANSI string pszA to a Unicode string * and returns the Unicode string through ppszW. Space for the * the converted string is allocated by AnsiToUnicode. /*------------------------------------------------------------------------------------------------------------*/ HRESULT AnsiToUnicode(LPCSTR pszA, LPCOLESTR *ppszW) { ULONG length; DWORD dwError; // If input is null then just return the same. if (NULL == pszA) { *ppszW = NULL; return NOERROR; } // Determine number of wide characters to be allocated for the Unicode string. length = strlen(pszA)+1; // Use of the OLE allocator is required if the resultant Unicode // string will be passed to another COM component and if that // component will free it. Otherwise you can use your own allocator. *ppszW = (LPCOLESTR) CoTaskMemAlloc(length * 2); if (NULL == *ppszW) return E_OUTOFMEMORY; // Convert to Unicode. if (!MultiByteToWideChar(CP_ACP, 0, pszA, length, (LPWSTR)*ppszW, length)) { dwError = GetLastError(); CoTaskMemFree((PVOID)*ppszW); *ppszW = NULL; return HRESULT_FROM_WIN32(dwError); } return NOERROR; }