diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3b41aeb4c0..dac7352769 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,23 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-06-03 09:11 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * include/rdd.api + + Added necessary conversions. + ; NOTE: 3 functions are not yet implemented in Harbour. + + * contrib/hbw32/w32_regc.c + * contrib/hbw32/tests/testreg.prg + % Optimizations. + * Formatting. + + * contrib/hbw32/w32_ole.c + ! Fixed indentation. + + * contrib/hbhpdf/harupdf.c + ! Fixed hpdf_ReadFromStream() fixed to not overflow + to buffer in hb_storlen_buffer(). + 2008-06-03 01:31 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/vm/extend.c ! hb_storclen_buffer() fixed to free the passed buffer diff --git a/harbour/contrib/hbhpdf/harupdf.c b/harbour/contrib/hbhpdf/harupdf.c index aacd9c09c6..9ee4659873 100644 --- a/harbour/contrib/hbhpdf/harupdf.c +++ b/harbour/contrib/hbhpdf/harupdf.c @@ -183,7 +183,7 @@ HB_FUNC( HPDF_READFROMSTREAM ) if( size < 1024 ) size = 1024; - buffer = ( HPDF_BYTE * ) hb_xgrab( size ); + buffer = ( HPDF_BYTE * ) hb_xgrab( size + 1 ); hb_retnl( (long) HPDF_ReadFromStream( HPDF_Doc_par( 1 ), buffer, &size ) ); diff --git a/harbour/contrib/hbw32/tests/testreg.prg b/harbour/contrib/hbw32/tests/testreg.prg index 34af43d4d0..acb2967034 100644 --- a/harbour/contrib/hbw32/tests/testreg.prg +++ b/harbour/contrib/hbw32/tests/testreg.prg @@ -6,12 +6,13 @@ PROCEDURE Main() - ? GetRegistry( HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaper" ) - ? w32_regRead( "HKCU\Control Panel\Desktop\Wallpaper" ) - ? w32_regRead( "" ) + /* old API */ + ? ">" + hb_ValToStr( GetRegistry( HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaper" ) ) + "<" - // ? w32_regWrite( "HKCU\Control Panel\Desktop\Wallpaper", "harbour.bmp" ) + /* new API */ + ? ">" + hb_ValToStr( w32_regRead( "HKCU\Control Panel\Desktop\Wallpaper" ) ) + "<" + ? ">" + hb_ValToStr( w32_regRead( "" ) ) + "<" - Inkey( 0 ) +// ? w32_regWrite( "HKCU\Control Panel\Desktop\Wallpaper", "harbour.bmp" ) RETURN diff --git a/harbour/contrib/hbw32/w32_ole.c b/harbour/contrib/hbw32/w32_ole.c index 6f5b87869a..41322b5ce9 100644 --- a/harbour/contrib/hbw32/w32_ole.c +++ b/harbour/contrib/hbw32/w32_ole.c @@ -133,2030 +133,2030 @@ static void hb_vmRequestReset( void ) hb_stackSetActionRequest( 0 ); // TOFIX } - // ----------------------------------------------------------------------- - static EXCEPINFO excep; +// ----------------------------------------------------------------------- +static EXCEPINFO excep; - static DISPID lPropPut = DISPID_PROPERTYPUT; - static UINT uArgErr; +static DISPID lPropPut = DISPID_PROPERTYPUT; +static UINT uArgErr; - HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ); - static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ); +HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ); +static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ); - //---------------------------------------------------------------------------// - HB_EXPORT BSTR hb_oleAnsiToSysString( const char * cString ) - { - int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); +//---------------------------------------------------------------------------// +HB_EXPORT BSTR hb_oleAnsiToSysString( const char * cString ) +{ + int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); - if( nConvertedLen ) - { - BSTR bstrString = SysAllocStringLen( NULL, nConvertedLen - 1 ); - - if( MultiByteToWideChar( CP_ACP, 0, cString, -1, bstrString, nConvertedLen ) ) - { - return bstrString; - } - else - { - SysFreeString( bstrString ); - } - } - - return NULL; - } - - //---------------------------------------------------------------------------// - HB_EXPORT LPWSTR hb_oleAnsiToWide( LPSTR cString ) - { - int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); - - if( nConvertedLen ) - { - LPWSTR wString = (LPWSTR) hb_xgrab( nConvertedLen * 2 + 1 ); - - if( MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, wString, nConvertedLen ) ) - { - return wString; - } - else - { - hb_xfree( wString ); - } - } - - return NULL; - } - - /* This code is executed only once when HVM clears static variables - * inside hb_vmQuite() - so it's executed after all EXIT functions - * and allow to use OLE in object destructors - */ - static HB_GARBAGE_FUNC( hb_oleRelease ) + if( nConvertedLen ) { - HB_SYMBOL_UNUSED( Cargo ); + BSTR bstrString = SysAllocStringLen( NULL, nConvertedLen - 1 ); - if( s_bInit ) + if( MultiByteToWideChar( CP_ACP, 0, cString, -1, bstrString, nConvertedLen ) ) { - OleUninitialize(); - s_bInit = FALSE; - if( s_pOleAuto ) - { - hb_itemRelease( s_pOleAuto ); - s_pOleAuto = NULL; - } + return bstrString; + } + else + { + SysFreeString( bstrString ); } } - //---------------------------------------------------------------------------// + return NULL; +} - HB_FUNC( __HB_OLE_INIT ) - { - if( s_pSym_TOleAuto == NULL ) - { - s_pSym_TOleAuto = hb_dynsymFind( "TOLEAUTO" ); - s_pSym_New = hb_dynsymFind( "NEW" ); - s_pSym_hObj = hb_dynsymFind( "HOBJ" ); - s_pSym_cClassName = hb_dynsymFind( "CCLASSNAME" ); +//---------------------------------------------------------------------------// +HB_EXPORT LPWSTR hb_oleAnsiToWide( LPSTR cString ) +{ + int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); - s_pSym_VTWrapper = hb_dynsymFind( "VTWRAPPER" ); - s_pSym_VTArrayWrapper = hb_dynsymFind( "VTARRAYWRAPPER" ); - s_pSym_vt = hb_dynsymGetCase( "VT" ); - s_pSym_Value = hb_dynsymFind( "VALUE" ); + if( nConvertedLen ) + { + LPWSTR wString = (LPWSTR) hb_xgrab( nConvertedLen * 2 + 1 ); - s_EmptyDispParams.rgvarg = NULL; - s_EmptyDispParams.cArgs = 0; - s_EmptyDispParams.rgdispidNamedArgs = 0; - s_EmptyDispParams.cNamedArgs = 0; + if( MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, wString, nConvertedLen ) ) + { + return wString; + } + else + { + hb_xfree( wString ); + } + } - if( ! s_bInit ) - { - OleInitialize( NULL ); - hb_retptrGC( hb_gcAlloc( 1, hb_oleRelease ) ); - s_bInit = TRUE; - } + return NULL; +} - VariantInit( &s_RetVal ); - VariantInit( &s_OleVal ); - } - } +/* This code is executed only once when HVM clears static variables + * inside hb_vmQuit() - so it's executed after all EXIT functions + * and allow to use OLE in object destructors + */ +static HB_GARBAGE_FUNC( hb_oleRelease ) +{ + HB_SYMBOL_UNUSED( Cargo ); + + if( s_bInit ) + { + OleUninitialize(); + s_bInit = FALSE; + if( s_pOleAuto ) + { + hb_itemRelease( s_pOleAuto ); + s_pOleAuto = NULL; + } + } +} //---------------------------------------------------------------------------// - HB_FUNC( ANSITOWIDE ) // ( cAnsiStr ) -> cWideStr - { - char *cString = hb_parc( 1 ); +HB_FUNC( __HB_OLE_INIT ) +{ + if( s_pSym_TOleAuto == NULL ) + { + s_pSym_TOleAuto = hb_dynsymFind( "TOLEAUTO" ); + s_pSym_New = hb_dynsymFind( "NEW" ); + s_pSym_hObj = hb_dynsymFind( "HOBJ" ); + s_pSym_cClassName = hb_dynsymFind( "CCLASSNAME" ); - if( cString ) - { - BSTR wString = hb_oleAnsiToWide( cString ); + s_pSym_VTWrapper = hb_dynsymFind( "VTWRAPPER" ); + s_pSym_VTArrayWrapper = hb_dynsymFind( "VTARRAYWRAPPER" ); + s_pSym_vt = hb_dynsymGetCase( "VT" ); + s_pSym_Value = hb_dynsymFind( "VALUE" ); - if( wString ) + s_EmptyDispParams.rgvarg = NULL; + s_EmptyDispParams.cArgs = 0; + s_EmptyDispParams.rgdispidNamedArgs = 0; + s_EmptyDispParams.cNamedArgs = 0; + + if( ! s_bInit ) + { + OleInitialize( NULL ); + hb_retptrGC( hb_gcAlloc( 1, hb_oleRelease ) ); + s_bInit = TRUE; + } + + VariantInit( &s_RetVal ); + VariantInit( &s_OleVal ); + } +} + +//---------------------------------------------------------------------------// + +HB_FUNC( ANSITOWIDE ) // ( cAnsiStr ) -> cWideStr +{ + char *cString = hb_parc( 1 ); + + if( cString ) + { + BSTR wString = hb_oleAnsiToWide( cString ); + + if( wString ) + { + hb_retclen_buffer( (char *) wString, SysStringLen( wString ) ); + return; + } + } + + hb_ret(); + return; +} + +//---------------------------------------------------------------------------// +HB_EXPORT LPSTR hb_oleWideToAnsi( BSTR wString ) +{ + int nConvertedLen = WideCharToMultiByte( CP_ACP, 0, wString, -1, NULL, 0, NULL, NULL ); + + if( nConvertedLen ) + { + char *cString = (char *) hb_xgrab( nConvertedLen + 1 ); + + if( WideCharToMultiByte( CP_ACP, 0, wString, -1, cString, nConvertedLen + 1, NULL, NULL ) ) + { + return cString; + } + else + { + hb_xfree( cString ); + } + } + + //wprintf( L"\nWide: '%s'\n", wString ); + //printf( "\nAnsi: '%s'\n", cString ); + + return NULL; +} + +//---------------------------------------------------------------------------// +HB_FUNC( WIDETOANSI ) // ( cWideStr, nLen ) -> cAnsiStr +{ + BSTR wString = ( BSTR ) hb_parc( 1 ); + + if( wString ) + { + char *cString = hb_oleWideToAnsi( wString ); + + if( cString ) + { + hb_retclen_buffer( cString, strlen( cString ) ); + return; + } + } + + hb_ret(); + return; +} + +//---------------------------------------------------------------------------// +HB_EXPORT void hb_oleItemToVariant( VARIANT *pVariant, PHB_ITEM pItem ) +{ + BOOL bByRef; + VARIANT mVariant; + VARTYPE vt; + SAFEARRAYBOUND rgsabound; + void *pSource;// = NULL; + unsigned long i; + char *sString; + + if( HB_IS_BYREF( pItem ) ) + { + pItem = hb_itemUnRef( pItem ); + bByRef = TRUE; + } + else + { + bByRef = FALSE; + } + + VariantClear( pVariant ); + + switch( hb_itemType( pItem ) ) + { + case HB_IT_NIL: + //pVariant->n1.n2.vt = VT_EMPTY; + break; + + case HB_IT_STRING: + case HB_IT_MEMO: + { + ULONG ulLen = hb_itemGetCLen( pItem ); + + sString = hb_itemGetCPtr( pItem ); + + // Check for hidden signature of SafeArrayToArray(). + if( (int) (pItem->item.asString.allocated - ulLen) >= 5 && // TOFIX + sString[ ulLen ] == 0x7A && sString[ ulLen + 1 ] == 0x7B && sString[ ulLen + 2 ] == 0x7C && sString[ ulLen + 3 ] == 0x7D ) { - hb_retclen_buffer( (char *) wString, SysStringLen( wString ) ); - return; + vt = (VARTYPE) sString[ ulLen + 4 ]; + goto ItemToVariant_StringArray; } - } - hb_ret(); - return; - } - - //---------------------------------------------------------------------------// - HB_EXPORT LPSTR hb_oleWideToAnsi( BSTR wString ) - { - int nConvertedLen = WideCharToMultiByte( CP_ACP, 0, wString, -1, NULL, 0, NULL, NULL ); - - if( nConvertedLen ) - { - char *cString = (char *) hb_xgrab( nConvertedLen + 1 ); - - if( WideCharToMultiByte( CP_ACP, 0, wString, -1, cString, nConvertedLen + 1, NULL, NULL ) ) + if( bByRef ) { - return cString; + hb_itemPutCLConst( pItem, (char *) hb_oleAnsiToSysString( sString ), ulLen * 2 + 1 ); + + pVariant->n1.n2.vt = VT_BYREF | VT_BSTR; + pVariant->n1.n2.n3.pbstrVal = (BSTR *) &( pItem->item.asString.value ); // TOFIX + //wprintf( L"*** BYREF >%s<\n", *pVariant->n1.n2.n3.bstrVal ); } else { - hb_xfree( cString ); + pVariant->n1.n2.vt = VT_BSTR; + pVariant->n1.n2.n3.bstrVal = hb_oleAnsiToSysString( sString ); + //wprintf( L"*** >%s<\n", pVariant->n1.n2.n3.bstrVal ); } - } + break; + } - //wprintf( L"\nWide: '%s'\n", wString ); - //printf( "\nAnsi: '%s'\n", cString ); - - return NULL; - } - - //---------------------------------------------------------------------------// - HB_FUNC( WIDETOANSI ) // ( cWideStr, nLen ) -> cAnsiStr - { - BSTR wString = ( BSTR ) hb_parc( 1 ); - - if( wString ) - { - char *cString = hb_oleWideToAnsi( wString ); - - if( cString ) + case HB_IT_LOGICAL: + if( bByRef ) { - hb_retclen_buffer( cString, strlen( cString ) ); - return; + pVariant->n1.n2.vt = VT_BYREF | VT_BOOL; + pVariant->n1.n2.n3.pboolVal = (short *) &( pItem->item.asLogical.value ) ; // TOFIX + *pVariant->n1.n2.n3.pboolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; + //pItem->type = HB_IT_LONG; } - } - - hb_ret(); - return; - } - - //---------------------------------------------------------------------------// - HB_EXPORT void hb_oleItemToVariant( VARIANT *pVariant, PHB_ITEM pItem ) - { - BOOL bByRef; - VARIANT mVariant; - VARTYPE vt; - SAFEARRAYBOUND rgsabound; - void *pSource;// = NULL; - unsigned long i; - char *sString; - - if( HB_IS_BYREF( pItem ) ) - { - pItem = hb_itemUnRef( pItem ); - bByRef = TRUE; - } - else - { - bByRef = FALSE; - } - - VariantClear( pVariant ); - - switch( hb_itemType( pItem ) ) - { - case HB_IT_NIL: - //pVariant->n1.n2.vt = VT_EMPTY; - break; - - case HB_IT_STRING: - case HB_IT_MEMO: + else { - ULONG ulLen = hb_itemGetCLen( pItem ); - - sString = hb_itemGetCPtr( pItem ); - - // Check for hidden signature of SafeArrayToArray(). - if( (int) (pItem->item.asString.allocated - ulLen) >= 5 && // TOFIX - sString[ ulLen ] == 0x7A && sString[ ulLen + 1 ] == 0x7B && sString[ ulLen + 2 ] == 0x7C && sString[ ulLen + 3 ] == 0x7D ) - { - vt = (VARTYPE) sString[ ulLen + 4 ]; - goto ItemToVariant_StringArray; - } - - if( bByRef ) - { - hb_itemPutCLConst( pItem, (char *) hb_oleAnsiToSysString( sString ), ulLen * 2 + 1 ); - - pVariant->n1.n2.vt = VT_BYREF | VT_BSTR; - pVariant->n1.n2.n3.pbstrVal = (BSTR *) &( pItem->item.asString.value ); // TOFIX - //wprintf( L"*** BYREF >%s<\n", *pVariant->n1.n2.n3.bstrVal ); - } - else - { - pVariant->n1.n2.vt = VT_BSTR; - pVariant->n1.n2.n3.bstrVal = hb_oleAnsiToSysString( sString ); - //wprintf( L"*** >%s<\n", pVariant->n1.n2.n3.bstrVal ); - } - break; + pVariant->n1.n2.vt = VT_BOOL; + pVariant->n1.n2.n3.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; } + break; - case HB_IT_LOGICAL: - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_BOOL; - pVariant->n1.n2.n3.pboolVal = (short *) &( pItem->item.asLogical.value ) ; // TOFIX - *pVariant->n1.n2.n3.pboolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; - //pItem->type = HB_IT_LONG; - } - else - { - pVariant->n1.n2.vt = VT_BOOL; - pVariant->n1.n2.n3.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; - } - break; - - case HB_IT_INTEGER: + case HB_IT_INTEGER: #if HB_INT_MAX == INT16_MAX - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I2; - pVariant->n1.n2.n3.piVal = &( pItem->item.asInteger.value ) ; // TOFIX - } - else - { - pVariant->n1.n2.vt = VT_I2; - pVariant->n1.n2.n3.iVal = hb_itemGetNI( pItem ); - } - break; + if( bByRef ) + { + pVariant->n1.n2.vt = VT_BYREF | VT_I2; + pVariant->n1.n2.n3.piVal = &( pItem->item.asInteger.value ) ; // TOFIX + } + else + { + pVariant->n1.n2.vt = VT_I2; + pVariant->n1.n2.n3.iVal = hb_itemGetNI( pItem ); + } + break; #else - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I4; - pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asInteger.value ) ; // TOFIX - } - else - { - pVariant->n1.n2.vt = VT_I4; - pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); - } - break; + if( bByRef ) + { + pVariant->n1.n2.vt = VT_BYREF | VT_I4; + pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asInteger.value ) ; // TOFIX + } + else + { + pVariant->n1.n2.vt = VT_I4; + pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); + } + break; #endif - case HB_IT_LONG: + case HB_IT_LONG: #if HB_LONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF ) - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I4; - pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asLong.value ) ; // TOFIX - } - else - { - pVariant->n1.n2.vt = VT_I4; - pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); - } + if( bByRef ) + { + pVariant->n1.n2.vt = VT_BYREF | VT_I4; + pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asLong.value ) ; // TOFIX + } + else + { + pVariant->n1.n2.vt = VT_I4; + pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); + } #else - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I8; - pVariant->n1.n2.n3.pllVal = &( pItem->item.asLong.value ) ; // TOFIX - } - else - { - pVariant->n1.n2.vt = VT_I8; - pVariant->n1.n2.n3.llVal = hb_itemGetNLL( pItem ); - } + if( bByRef ) + { + pVariant->n1.n2.vt = VT_BYREF | VT_I8; + pVariant->n1.n2.n3.pllVal = &( pItem->item.asLong.value ) ; // TOFIX + } + else + { + pVariant->n1.n2.vt = VT_I8; + pVariant->n1.n2.n3.llVal = hb_itemGetNLL( pItem ); + } #endif - break; + break; - case HB_IT_DOUBLE: - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_R8; - pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ) ; // TOFIX - pItem->type = HB_IT_DOUBLE; - } - else - { - pVariant->n1.n2.vt = VT_R8; - pVariant->n1.n2.n3.dblVal = hb_itemGetND( pItem ); - } - break; + case HB_IT_DOUBLE: + if( bByRef ) + { + pVariant->n1.n2.vt = VT_BYREF | VT_R8; + pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ) ; // TOFIX + pItem->type = HB_IT_DOUBLE; + } + else + { + pVariant->n1.n2.vt = VT_R8; + pVariant->n1.n2.n3.dblVal = hb_itemGetND( pItem ); + } + break; - case HB_IT_DATE: - { - long lDate = hb_itemGetDL( pItem ); - - if( lDate == 0 ) - { - pVariant->n1.n2.vt = VT_NULL; - } - else if( bByRef ) - { - hb_itemPutND( pItem, (double) ( lDate - 2415019 ) ); - - pVariant->n1.n2.vt = VT_BYREF | VT_DATE; - pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ); - } - else - { - pVariant->n1.n2.vt = VT_DATE; - pVariant->n1.n2.n3.dblVal = (double) ( lDate - 2415019 ); - } - } - break; - - case HB_IT_POINTER: - pVariant->n1.n2.vt = VT_PTR; - pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem ); - break; - - case HB_IT_ARRAY: + case HB_IT_DATE: { - if( HB_IS_OBJECT( pItem ) ) + long lDate = hb_itemGetDL( pItem ); + + if( lDate == 0 ) { - if( hb_clsIsParent( hb_objGetClass( pItem ), "TOLEAUTO" ) ) - { - IDispatch *pDisp;// = NULL; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - pDisp = (IDispatch *) hb_parnl( -1 ); - pDisp->lpVtbl->AddRef( pDisp ); - - //HB_TRACE(HB_TR_INFO, ("Dispatch: in: %s(%i)%ld\n", pDisp, __FILE__, __LINE__)); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_DISPATCH | VT_BYREF ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (IDispatch **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = pDisp; - pVariant->n1.n2.n3.ppdispVal = (IDispatch **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = VT_DISPATCH; - pVariant->n1.n2.n3.pdispVal = pDisp; - } - } - // MUST be before "VTWRAPPER" - else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTARRAYWRAPPER" ) ) - { - // vt := oVTArray:vt - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_vt ) ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - vt = (VARTYPE) hb_parnl(-1); - - // aArray := oVTArray:Value - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_Value ) ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - // Intentionally not using hb_itemCopy() or hb_itemForwardValue() - pItem = hb_stackReturnItem(); - - if( ( vt == VT_I1 || vt == VT_UI1 ) && HB_IS_STRING( pItem ) ) - { - SAFEARRAY *parray; - - sString = hb_itemGetCPtr( pItem ); - - ItemToVariant_StringArray: - - rgsabound.cElements = hb_itemGetCLen( pItem ); - rgsabound.lLbound = 0; - - parray = SafeArrayCreate( vt, 1, &rgsabound ); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; - pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = ( VT_ARRAY | vt ); - pVariant->n1.n2.n3.parray = parray; - } - - for( i = 0; i < rgsabound.cElements; i++ ) - { - SafeArrayPutElement( parray, (LONG *) &i, &( sString[i]) ); - } - - break; - } - - VariantInit( &mVariant ); - pSource = &mVariant.n1.n2.n3.cVal; - - goto ItemToVariant_ProcessArray; - } - else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTWRAPPER" ) ) - { - // vt := oVT:vt - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_vt ) ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - pVariant->n1.n2.vt = (VARTYPE) hb_parnl(-1); - - //value := oVT:value - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_Value ) ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - switch( pVariant->n1.n2.vt ) - { - case VT_UNKNOWN: - pVariant->n1.n2.n3.punkVal = (IUnknown *) hb_parptr( -1 ); - break; - - case ( VT_UNKNOWN | VT_BYREF ): - // Hack!!! Using high 4 bytes of the union (llVal) - *( (IUnknown **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = (IUnknown *) hb_parptr( -1 ); - pVariant->n1.n2.n3.ppunkVal = (IUnknown **) (&pVariant->n1.n2.n3.lVal ) + 1; - break; - - default: - HB_TRACE(HB_TR_INFO, ("Unexpected VT type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); - } - - break; - } - else - { - HB_TRACE(HB_TR_INFO, ("Class: '%s' not suported!\n", hb_objGetClsName( pItem ))); - } + pVariant->n1.n2.vt = VT_NULL; + } + else if( bByRef ) + { + hb_itemPutND( pItem, (double) ( lDate - 2415019 ) ); + + pVariant->n1.n2.vt = VT_BYREF | VT_DATE; + pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ); } else { - unsigned long i; - SAFEARRAY *parray; - - vt = VT_VARIANT; - VariantInit( &mVariant ); - pSource = &mVariant; - - ItemToVariant_ProcessArray: - - rgsabound.cElements = hb_arrayLen( pItem ); - rgsabound.lLbound = 0; - - //HB_TRACE(HB_TR_INFO, ("ItemToVariant() Array len: %i type: %i ByRef: %i in: %s(%i) \n", rgsabound.cElements, vt, bByRef, __FILE__, __LINE__)); - - parray = SafeArrayCreate( vt, 1, &rgsabound ); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; - pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = ( VT_ARRAY | vt ); - pVariant->n1.n2.n3.parray = parray; - } - - for( i = 0; i < rgsabound.cElements; i++ ) - { - hb_oleItemToVariant( &mVariant, hb_arrayGetItemPtr( pItem, i + 1 ) ); - SafeArrayPutElement( parray, (LONG *) &i, pSource ); - VariantClear( &mVariant ); - } + pVariant->n1.n2.vt = VT_DATE; + pVariant->n1.n2.n3.dblVal = (double) ( lDate - 2415019 ); } } break; - default: - { - //HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", hb_itemType( pItem ), __FILE__, __LINE__)); - } - } - } - - //---------------------------------------------------------------------------// - static PHB_ITEM * GetParams( DISPPARAMS *pDispParams, int nOffset ) - { - VARIANTARG * pArgs = NULL; - int n, nArgs, nArg; - //BOOL bByRef; - PHB_ITEM *aPrgParams = NULL; - - nArgs = hb_pcount() - nOffset; - - if( nArgs > 0 ) - { - pArgs = ( VARIANTARG * ) hb_xgrab( sizeof( VARIANTARG ) * nArgs ); - aPrgParams = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * nArgs ); - - //printf( "Args: %i\n", nArgs ); - - for( n = 0; n < nArgs; n++ ) - { - // Parameters are processed in reversed order. - nArg = nArgs - n; - VariantInit( &( pArgs[ n ] ) ); - - aPrgParams[ n ] = hb_stackItemFromBase( nArg + nOffset ); - - //HB_TRACE(HB_TR_INFO, ("N: %i Arg: %i Type: %i %i ByRef: %i\n", n, nArg, hb_itemType( pParam ), hb_itemType( aPrgParams[ n ] ), bByRef)); - - hb_oleItemToVariant( &( pArgs[ n ] ), aPrgParams[ n ] ); - } - } - - pDispParams->rgvarg = pArgs; - pDispParams->cArgs = nArgs; - pDispParams->rgdispidNamedArgs = 0; - pDispParams->cNamedArgs = 0; - - return aPrgParams; - } - - //---------------------------------------------------------------------------// - static void FreeParams( DISPPARAMS *pDispParams, PHB_ITEM *aPrgParams ) - { - if( pDispParams->cArgs > 0 ) - { - IDispatch *pDisp = NULL; - int n; //, nParam; - char *sString; - VARIANT *pVariant; - PHB_ITEM pItem; - BOOL bByRef; - - for( n = 0; n < ( int ) pDispParams->cArgs; n++ ) - { - pVariant = &( pDispParams->rgvarg[ n ] ); - pItem = aPrgParams[ n ]; - - if( HB_IS_BYREF( pItem ) ) - { - bByRef = TRUE; - pItem = hb_itemUnRef( pItem ); - } - else - { - bByRef = FALSE; - } - - //nParam = pDispParams->cArgs - n; - - //HB_TRACE(HB_TR_INFO, ("*** N: %i, Param: %i Type: %i\n", n, nParam, pVariant->n1.n2.vt)); - - if( bByRef ) - { - switch( pVariant->n1.n2.vt ) - { - case VT_BYREF | VT_BSTR: - SysFreeString( *pVariant->n1.n2.n3.pbstrVal ); - sString = hb_oleWideToAnsi( *( pVariant->n1.n2.n3.pbstrVal ) ); - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - break; - - case VT_BSTR: - sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - break; - - case VT_BYREF | VT_BOOL: - //( pItem )->type = HB_IT_LOGICAL; - hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case VT_BOOL: - hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case ( VT_BYREF | VT_DISPATCH ): - if( *pVariant->n1.n2.n3.ppdispVal == NULL ) - { - hb_itemClear( pItem ); - break; - } - else - { - pDisp = *pVariant->n1.n2.n3.ppdispVal; - } - // Intentionally fall through. - - case VT_DISPATCH: - if( pVariant->n1.n2.vt == VT_DISPATCH ) - { - if( pVariant->n1.n2.n3.pdispVal == NULL ) - { - hb_itemClear( pItem ); - break; - } - else - { - pDisp = pVariant->n1.n2.n3.pdispVal; - } - } - - if( s_pOleAuto == NULL ) - s_pOleAuto = hb_itemNew( NULL ); - else - hb_itemClear( s_pOleAuto ); - - if( s_pSym_TOleAuto ) - { - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_TOleAuto ) ); - hb_vmPushNil(); - hb_vmDo( 0 ); - - hb_itemForwardValue( s_pOleAuto, hb_stackReturnItem() ); - } - - if( s_pSym_New && hb_itemType( s_pOleAuto ) ) - { - // Implemented in :New() - //pDisp->lpVtbl->AddRef( pDisp ); - - //TOleAuto():New( nDispatch ) - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_New ) ); - hb_itemPushForward( s_pOleAuto ); - hb_vmPushLong( ( LONG ) pDisp ); - hb_vmSend( 1 ); - - hb_itemForwardValue( pItem, hb_stackReturnItem() ); - } - break; - - case VT_BYREF | VT_I2: - hb_itemPutNI( pItem, ( int ) *pVariant->n1.n2.n3.piVal ); - break; - - case VT_I2: - hb_itemPutNI( pItem, ( int ) pVariant->n1.n2.n3.iVal ); - break; - - case VT_BYREF | VT_I4: - hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); - break; - - case VT_I4: - hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); - break; - - #ifndef HB_LONG_LONG_OFF - case VT_BYREF | VT_I8: - hb_itemPutNLL( pItem, ( LONGLONG ) *pVariant->n1.n2.n3.pllVal ); - break; - #endif - - #ifndef HB_LONG_LONG_OFF - case VT_I8: - hb_itemPutNLL( pItem, ( LONGLONG ) pVariant->n1.n2.n3.llVal ); - break; - #endif - - case VT_BYREF | VT_R8: - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); - break; - - case VT_R8: - hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); - break; - - case VT_BYREF | VT_DATE: - hb_itemPutDL( pItem, (long) ( *( pVariant->n1.n2.n3.pdblVal ) ) + 2415019 ); - break; - - case VT_DATE: - hb_itemPutDL( pItem, (long) (pVariant->n1.n2.n3.dblVal) + 2415019 ); - break; - - case VT_BYREF | VT_EMPTY: - case VT_EMPTY: - hb_itemClear( pItem ); - break; - - case VT_BYREF | VT_VARIANT: - hb_oleItemToVariant( pVariant->n1.n2.n3.pvarVal, pItem ); - break; - - default: - if( (VARTYPE) ( pVariant->n1.n2.vt & ( VT_BYREF | VT_ARRAY ) ) == (VARTYPE) ( VT_BYREF | VT_ARRAY ) ) - { - VARTYPE vt; - PHB_ITEM pArray; - UINT iDims = SafeArrayGetDim( *pVariant->n1.n2.n3.pparray ); - long *rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); - - vt = pVariant->n1.n2.vt; - vt &= ~VT_ARRAY; - vt &= ~VT_BYREF; - - pArray = SafeArrayToArray( *pVariant->n1.n2.n3.pparray, iDims, rgIndices, vt ); - - hb_xfree( (void *) rgIndices ); - - hb_itemForwardValue( pItem, pArray ); - hb_itemRelease( pArray ); - } - else - { - HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); - } - } - } - else - { - if( pVariant->n1.n2.vt & VT_BYREF ) - { - HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); - } - } - - VariantClear( &(pDispParams->rgvarg[ n ] ) ); - } - - hb_xfree( ( LPVOID ) pDispParams->rgvarg ); - hb_xfree( ( LPVOID ) aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ) - { - long iFrom, iTo, iLen, i; - PHB_ITEM pArray = hb_itemNew( NULL ); - - if( parray == NULL ) - { - hb_arrayNew( pArray, 0 ); - return pArray; - } - - SafeArrayGetLBound( parray, iDim, &iFrom ); - SafeArrayGetUBound( parray, iDim, &iTo ); - - iLen = iTo - iFrom + 1; - - if( iDim > 1 ) - { - PHB_ITEM pSubArray; - - hb_arrayNew( pArray, iLen ); - - for( i = iFrom; i <= iTo; i++ ) - { - rgIndices[ iDim - 1 ] = i; - - //printf( " Sub: %i\n", i ); - - pSubArray = SafeArrayToArray( parray, iDim - 1, rgIndices, vt ); - hb_arraySetForward( pArray, i - iFrom + 1, pSubArray ); - hb_itemRelease( pSubArray ); - } - } - else - { - VARIANT mElem; - void *pTarget; - char *sArray = NULL; - - VariantInit( &mElem ); - - if( vt == VT_VARIANT ) - { - hb_arrayNew( pArray, iLen ); - - pTarget = &mElem; - } - else - { - if( vt == VT_I1 || vt == VT_UI1 ) - { - // Ugly hack, but needed to allocate our signature as hidden bytes! - hb_itemPutCL( pArray, NULL, 0 ); - HB_STRING_ALLOC( pArray, (ULONG)(iLen + 5) ); - pArray->item.asString.length = iLen; // TOFIX - - sArray = hb_itemGetCPtr( pArray ); - - sArray[ iLen ] = 0x7A; - sArray[ iLen + 1 ] = 0x7B; - sArray[ iLen + 2 ] = 0x7C; - sArray[ iLen + 3 ] = 0x7D; - sArray[ iLen + 4 ] = (char)(vt); - - pTarget = NULL; - } - else - { - hb_arrayNew( pArray, iLen ); - - pTarget = &mElem.n1.n2.n3.cVal; - } - } - - for( i = iFrom; i <= iTo; i++ ) - { - rgIndices[ iDim - 1 ] = i; - - if( vt != VT_VARIANT ) - { - // Get cleared on VariantClear() - don't place out of loop! - mElem.n1.n2.vt = vt; - - if( vt == VT_I1 || vt == VT_UI1 ) - { - SafeArrayGetElement( parray, rgIndices, &( sArray[ i - iFrom ] ) ); - - continue; - } - } - - if( SUCCEEDED( SafeArrayGetElement( parray, rgIndices, pTarget ) ) ) - { - //HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", mElem.n1.n2.vt, __FILE__, __LINE__)); - - hb_oleVariantToItem( hb_arrayGetItemPtr( pArray, i - iFrom + 1 ), &mElem ); - - VariantClear( &mElem ); - } - } - } - - //HB_TRACE(HB_TR_INFO, ("Return len: %i\n", hb_arrayLen( pArray ))); - - // Wrap our array with VTArrayWrapper() class ( aArray := VTArrayWrapper( vt, aArray) ) - if( HB_IS_ARRAY( pArray ) && vt != VT_VARIANT ) - { - PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) vt ); - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_VTArrayWrapper ) ); - hb_vmPushNil(); - hb_itemPushForward( pVT ); - hb_itemPushForward( pArray ); - hb_vmDo( 2 ); - - hb_itemForwardValue( pArray, hb_stackReturnItem() ); - - hb_itemRelease( pVT ); - } - - return pArray; - } - - //---------------------------------------------------------------------------// - HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ) - { - PHB_ITEM pOleAuto; - IUnknown *pUnk = NULL; - IDispatch *pDisp = NULL; - SAFEARRAY *parray;// = NULL; - - hb_itemClear( pItem ); - - // Don't "optimize" (VT_ARRAY | VT_VARIANT) must not match! - while( pVariant->n1.n2.vt == ( VT_BYREF | VT_VARIANT ) || pVariant->n1.n2.vt == VT_VARIANT || pVariant->n1.n2.vt == VT_BYREF ) - { - pVariant = pVariant->n1.n2.n3.pvarVal; - } - - switch( pVariant->n1.n2.vt ) - { - case VT_BSTR | VT_BYREF: - case VT_BSTR: - { - char *sString; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - sString = hb_oleWideToAnsi( *pVariant->n1.n2.n3.pbstrVal ); - } - else - { - sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); - } - - if( sString ) - { - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - } - else - { - hb_itemPutC( pItem, NULL ); - } - - break; - } - - case VT_BOOL | VT_BYREF: - hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case VT_BOOL: - hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case ( VT_UNKNOWN | VT_BYREF ): - pUnk = *pVariant->n1.n2.n3.ppunkVal; - // Intentionally fall through - - case VT_UNKNOWN: - if( pVariant->n1.n2.vt == VT_UNKNOWN ) - { - pUnk = pVariant->n1.n2.n3.punkVal; - } - - if( pUnk ) - { - IDispatch ** pDispPtr = &pDisp; - pUnk->lpVtbl->QueryInterface( pUnk, HB_ID_REF( REFIID, IID_IDispatch ), (void **) pDispPtr ); - } - // Intentionally fall through - - case ( VT_DISPATCH | VT_BYREF ): - if( pVariant->n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) - { - pDisp = *pVariant->n1.n2.n3.ppdispVal; - } - // Intentionally fall through - - case VT_DISPATCH: - if( pVariant->n1.n2.vt == VT_DISPATCH ) - { - pDisp = pVariant->n1.n2.n3.pdispVal; - } - - if( pDisp == NULL ) - { - if( pUnk ) - { - PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) pVariant->n1.n2.vt ); - PHB_ITEM pUnknown = hb_itemPutPtr( hb_itemNew( NULL ), (void *) pUnk ); - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_VTWrapper ) ); - hb_vmPushNil(); - hb_itemPushForward( pVT ); - hb_itemPushForward( pUnknown ); - hb_vmDo( 2 ); - - if( pItem != hb_stackReturnItem() ) + case HB_IT_POINTER: + pVariant->n1.n2.vt = VT_PTR; + pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem ); + break; + + case HB_IT_ARRAY: + { + if( HB_IS_OBJECT( pItem ) ) + { + if( hb_clsIsParent( hb_objGetClass( pItem ), "TOLEAUTO" ) ) + { + IDispatch *pDisp;// = NULL; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + + pDisp = (IDispatch *) hb_parnl( -1 ); + pDisp->lpVtbl->AddRef( pDisp ); + + //HB_TRACE(HB_TR_INFO, ("Dispatch: in: %s(%i)%ld\n", pDisp, __FILE__, __LINE__)); + + if( bByRef ) + { + pVariant->n1.n2.vt = ( VT_DISPATCH | VT_BYREF ); + // Hack!!! Using high 4 bytes of the union (llVal) + *( (IDispatch **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = pDisp; + pVariant->n1.n2.n3.ppdispVal = (IDispatch **) (&pVariant->n1.n2.n3.lVal ) + 1; + } + else + { + pVariant->n1.n2.vt = VT_DISPATCH; + pVariant->n1.n2.n3.pdispVal = pDisp; + } + } + // MUST be before "VTWRAPPER" + else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTARRAYWRAPPER" ) ) + { + // vt := oVTArray:vt + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_vt ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + + vt = (VARTYPE) hb_parnl(-1); + + // aArray := oVTArray:Value + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_Value ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + + // Intentionally not using hb_itemCopy() or hb_itemForwardValue() + pItem = hb_stackReturnItem(); + + if( ( vt == VT_I1 || vt == VT_UI1 ) && HB_IS_STRING( pItem ) ) + { + SAFEARRAY *parray; + + sString = hb_itemGetCPtr( pItem ); + + ItemToVariant_StringArray: + + rgsabound.cElements = hb_itemGetCLen( pItem ); + rgsabound.lLbound = 0; + + parray = SafeArrayCreate( vt, 1, &rgsabound ); + + if( bByRef ) + { + pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); + // Hack!!! Using high 4 bytes of the union (llVal) + *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; + pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; + } + else + { + pVariant->n1.n2.vt = ( VT_ARRAY | vt ); + pVariant->n1.n2.n3.parray = parray; + } + + for( i = 0; i < rgsabound.cElements; i++ ) + { + SafeArrayPutElement( parray, (LONG *) &i, &( sString[i]) ); + } + + break; + } + + VariantInit( &mVariant ); + pSource = &mVariant.n1.n2.n3.cVal; + + goto ItemToVariant_ProcessArray; + } + else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTWRAPPER" ) ) + { + // vt := oVT:vt + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_vt ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + + pVariant->n1.n2.vt = (VARTYPE) hb_parnl(-1); + + //value := oVT:value + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_Value ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + + switch( pVariant->n1.n2.vt ) + { + case VT_UNKNOWN: + pVariant->n1.n2.n3.punkVal = (IUnknown *) hb_parptr( -1 ); + break; + + case ( VT_UNKNOWN | VT_BYREF ): + // Hack!!! Using high 4 bytes of the union (llVal) + *( (IUnknown **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = (IUnknown *) hb_parptr( -1 ); + pVariant->n1.n2.n3.ppunkVal = (IUnknown **) (&pVariant->n1.n2.n3.lVal ) + 1; + break; + + default: + HB_TRACE(HB_TR_INFO, ("Unexpected VT type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); + } + + break; + } + else + { + HB_TRACE(HB_TR_INFO, ("Class: '%s' not suported!\n", hb_objGetClsName( pItem ))); + } + } + else + { + unsigned long i; + SAFEARRAY *parray; + + vt = VT_VARIANT; + VariantInit( &mVariant ); + pSource = &mVariant; + + ItemToVariant_ProcessArray: + + rgsabound.cElements = hb_arrayLen( pItem ); + rgsabound.lLbound = 0; + + //HB_TRACE(HB_TR_INFO, ("ItemToVariant() Array len: %i type: %i ByRef: %i in: %s(%i) \n", rgsabound.cElements, vt, bByRef, __FILE__, __LINE__)); + + parray = SafeArrayCreate( vt, 1, &rgsabound ); + + if( bByRef ) + { + pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); + // Hack!!! Using high 4 bytes of the union (llVal) + *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; + pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; + } + else + { + pVariant->n1.n2.vt = ( VT_ARRAY | vt ); + pVariant->n1.n2.n3.parray = parray; + } + + for( i = 0; i < rgsabound.cElements; i++ ) + { + hb_oleItemToVariant( &mVariant, hb_arrayGetItemPtr( pItem, i + 1 ) ); + SafeArrayPutElement( parray, (LONG *) &i, pSource ); + VariantClear( &mVariant ); + } + } + } + break; + + default: + { + //HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", hb_itemType( pItem ), __FILE__, __LINE__)); + } + } +} + +//---------------------------------------------------------------------------// +static PHB_ITEM * GetParams( DISPPARAMS *pDispParams, int nOffset ) +{ + VARIANTARG * pArgs = NULL; + int n, nArgs, nArg; + //BOOL bByRef; + PHB_ITEM *aPrgParams = NULL; + + nArgs = hb_pcount() - nOffset; + + if( nArgs > 0 ) + { + pArgs = ( VARIANTARG * ) hb_xgrab( sizeof( VARIANTARG ) * nArgs ); + aPrgParams = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * nArgs ); + + //printf( "Args: %i\n", nArgs ); + + for( n = 0; n < nArgs; n++ ) + { + // Parameters are processed in reversed order. + nArg = nArgs - n; + VariantInit( &( pArgs[ n ] ) ); + + aPrgParams[ n ] = hb_stackItemFromBase( nArg + nOffset ); + + //HB_TRACE(HB_TR_INFO, ("N: %i Arg: %i Type: %i %i ByRef: %i\n", n, nArg, hb_itemType( pParam ), hb_itemType( aPrgParams[ n ] ), bByRef)); + + hb_oleItemToVariant( &( pArgs[ n ] ), aPrgParams[ n ] ); + } + } + + pDispParams->rgvarg = pArgs; + pDispParams->cArgs = nArgs; + pDispParams->rgdispidNamedArgs = 0; + pDispParams->cNamedArgs = 0; + + return aPrgParams; +} + +//---------------------------------------------------------------------------// +static void FreeParams( DISPPARAMS *pDispParams, PHB_ITEM *aPrgParams ) +{ + if( pDispParams->cArgs > 0 ) + { + IDispatch *pDisp = NULL; + int n; //, nParam; + char *sString; + VARIANT *pVariant; + PHB_ITEM pItem; + BOOL bByRef; + + for( n = 0; n < ( int ) pDispParams->cArgs; n++ ) + { + pVariant = &( pDispParams->rgvarg[ n ] ); + pItem = aPrgParams[ n ]; + + if( HB_IS_BYREF( pItem ) ) + { + bByRef = TRUE; + pItem = hb_itemUnRef( pItem ); + } + else + { + bByRef = FALSE; + } + + //nParam = pDispParams->cArgs - n; + + //HB_TRACE(HB_TR_INFO, ("*** N: %i, Param: %i Type: %i\n", n, nParam, pVariant->n1.n2.vt)); + + if( bByRef ) + { + switch( pVariant->n1.n2.vt ) + { + case VT_BYREF | VT_BSTR: + SysFreeString( *pVariant->n1.n2.n3.pbstrVal ); + sString = hb_oleWideToAnsi( *( pVariant->n1.n2.n3.pbstrVal ) ); + hb_itemPutCPtr( pItem, sString, strlen( sString ) ); + break; + + case VT_BSTR: + sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); + hb_itemPutCPtr( pItem, sString, strlen( sString ) ); + break; + + case VT_BYREF | VT_BOOL: + //( pItem )->type = HB_IT_LOGICAL; + hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); + break; + + case VT_BOOL: + hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); + break; + + case ( VT_BYREF | VT_DISPATCH ): + if( *pVariant->n1.n2.n3.ppdispVal == NULL ) { - hb_itemForwardValue( pItem, hb_stackReturnItem() ); + hb_itemClear( pItem ); + break; + } + else + { + pDisp = *pVariant->n1.n2.n3.ppdispVal; + } + // Intentionally fall through. + + case VT_DISPATCH: + if( pVariant->n1.n2.vt == VT_DISPATCH ) + { + if( pVariant->n1.n2.n3.pdispVal == NULL ) + { + hb_itemClear( pItem ); + break; + } + else + { + pDisp = pVariant->n1.n2.n3.pdispVal; + } } - hb_itemRelease( pVT ); - hb_itemRelease( pUnknown ); - } + if( s_pOleAuto == NULL ) + s_pOleAuto = hb_itemNew( NULL ); + else + hb_itemClear( s_pOleAuto ); - break; - } + if( s_pSym_TOleAuto ) + { + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_TOleAuto ) ); + hb_vmPushNil(); + hb_vmDo( 0 ); - pOleAuto = hb_itemNew( NULL ); + hb_itemForwardValue( s_pOleAuto, hb_stackReturnItem() ); + } - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_TOleAuto ) ); - hb_vmPushNil(); - hb_vmDo( 0 ); + if( s_pSym_New && hb_itemType( s_pOleAuto ) ) + { + // Implemented in :New() + //pDisp->lpVtbl->AddRef( pDisp ); - // Safety! - hb_vmRequestReset(); + //TOleAuto():New( nDispatch ) + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_New ) ); + hb_itemPushForward( s_pOleAuto ); + hb_vmPushLong( ( LONG ) pDisp ); + hb_vmSend( 1 ); - hb_itemForwardValue( pOleAuto, hb_stackReturnItem() ); + hb_itemForwardValue( pItem, hb_stackReturnItem() ); + } + break; - if( hb_itemType( pOleAuto ) ) - { - //TOleAuto():New( nDispatch ) - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_New ) ); - hb_itemPushForward( pOleAuto ); - hb_vmPushLong( ( LONG ) pDisp ); - hb_vmSend( 1 ); + case VT_BYREF | VT_I2: + hb_itemPutNI( pItem, ( int ) *pVariant->n1.n2.n3.piVal ); + break; - // If retrieved from IUnknown than doubly added! - if( pVariant->n1.n2.vt == VT_UNKNOWN || pVariant->n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) - { - pDisp->lpVtbl->Release( pDisp ); - } + case VT_I2: + hb_itemPutNI( pItem, ( int ) pVariant->n1.n2.n3.iVal ); + break; - hb_itemRelease( pOleAuto ); + case VT_BYREF | VT_I4: + hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); + break; - // Safety! - hb_vmRequestReset(); + case VT_I4: + hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); + break; - if( pItem != hb_stackReturnItem() ) - { - hb_itemForwardValue( pItem, hb_stackReturnItem() ); - } - } - break; + #ifndef HB_LONG_LONG_OFF + case VT_BYREF | VT_I8: + hb_itemPutNLL( pItem, ( LONGLONG ) *pVariant->n1.n2.n3.pllVal ); + break; + #endif - case VT_I1 | VT_BYREF: // Byte - case VT_UI1 | VT_BYREF: - hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.pbVal ); - break; + #ifndef HB_LONG_LONG_OFF + case VT_I8: + hb_itemPutNLL( pItem, ( LONGLONG ) pVariant->n1.n2.n3.llVal ); + break; + #endif - case VT_I1: // Byte - case VT_UI1: - hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.bVal ); - break; + case VT_BYREF | VT_R8: + hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); + break; - case VT_I2 | VT_BYREF: // Short (2 bytes) - case VT_UI2 | VT_BYREF: - hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.piVal ); - break; + case VT_R8: + hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); + break; - case VT_I2: // Short (2 bytes) - case VT_UI2: - hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.iVal ); - break; + case VT_BYREF | VT_DATE: + hb_itemPutDL( pItem, (long) ( *( pVariant->n1.n2.n3.pdblVal ) ) + 2415019 ); + break; - case VT_I4 | VT_BYREF: // Long (4 bytes) - case VT_UI4 | VT_BYREF: - case VT_INT | VT_BYREF: - case VT_UINT | VT_BYREF: - hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); - break; + case VT_DATE: + hb_itemPutDL( pItem, (long) (pVariant->n1.n2.n3.dblVal) + 2415019 ); + break; - case VT_I4: // Long (4 bytes) - case VT_UI4: - case VT_INT: - case VT_UINT: - hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); - break; + case VT_BYREF | VT_EMPTY: + case VT_EMPTY: + hb_itemClear( pItem ); + break; - case VT_R4 | VT_BYREF: // Single - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pfltVal ); - break; + case VT_BYREF | VT_VARIANT: + hb_oleItemToVariant( pVariant->n1.n2.n3.pvarVal, pItem ); + break; - case VT_R4: // Single - hb_itemPutND( pItem, pVariant->n1.n2.n3.fltVal ); - break; + default: + if( (VARTYPE) ( pVariant->n1.n2.vt & ( VT_BYREF | VT_ARRAY ) ) == (VARTYPE) ( VT_BYREF | VT_ARRAY ) ) + { + VARTYPE vt; + PHB_ITEM pArray; + UINT iDims = SafeArrayGetDim( *pVariant->n1.n2.n3.pparray ); + long *rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); - case VT_R8 | VT_BYREF: // Double - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); - break; + vt = pVariant->n1.n2.vt; + vt &= ~VT_ARRAY; + vt &= ~VT_BYREF; - case VT_R8: // Double - hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); - break; + pArray = SafeArrayToArray( *pVariant->n1.n2.n3.pparray, iDims, rgIndices, vt ); - case VT_CY | VT_BYREF: // Currency - case VT_CY: // Currency - { - double tmp = 0; + hb_xfree( (void *) rgIndices ); - if( pVariant->n1.n2.vt & VT_BYREF ) - { - VarR8FromCy( *pVariant->n1.n2.n3.pcyVal, &tmp ); - } - else - { - VarR8FromCy( pVariant->n1.n2.n3.cyVal, &tmp ); - } + hb_itemForwardValue( pItem, pArray ); + hb_itemRelease( pArray ); + } + else + { + HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); + } + } + } + else + { + if( pVariant->n1.n2.vt & VT_BYREF ) + { + HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); + } + } - hb_itemPutND( pItem, tmp ); - break; - } + VariantClear( &(pDispParams->rgvarg[ n ] ) ); + } - case VT_DECIMAL | VT_BYREF: // Decimal - case VT_DECIMAL: // Decimal - { - double tmp = 0; + hb_xfree( ( LPVOID ) pDispParams->rgvarg ); + hb_xfree( ( LPVOID ) aPrgParams ); + } +} - if( pVariant->n1.n2.vt & VT_BYREF ) - { - VarR8FromDec( pVariant->n1.n2.n3.pdecVal, &tmp ); - } - else - { - VarR8FromDec( &pVariant->n1.decVal, &tmp ); - } +//---------------------------------------------------------------------------// +static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ) +{ + long iFrom, iTo, iLen, i; + PHB_ITEM pArray = hb_itemNew( NULL ); - hb_itemPutND( pItem, tmp ); - break; - } + if( parray == NULL ) + { + hb_arrayNew( pArray, 0 ); + return pArray; + } - case VT_DATE | VT_BYREF: - hb_itemPutDL( pItem, (long) ( *pVariant->n1.n2.n3.pdblVal ) + 2415019 ); - break; + SafeArrayGetLBound( parray, iDim, &iFrom ); + SafeArrayGetUBound( parray, iDim, &iTo ); - case VT_DATE: - hb_itemPutDL( pItem, (long) ( pVariant->n1.n2.n3.dblVal ) + 2415019 ); - break; + iLen = iTo - iFrom + 1; - case VT_EMPTY | VT_BYREF: - case VT_NULL | VT_BYREF: - case VT_EMPTY: - case VT_NULL: - break; + if( iDim > 1 ) + { + PHB_ITEM pSubArray; - /* - case VT_VARIANT: - hb_oleVariantToItem( pItem, pVariant->n1.n2.n3.pvarVal ); - break; - */ + hb_arrayNew( pArray, iLen ); - case VT_PTR: - hb_itemPutPtr( pItem, pVariant->n1.n2.n3.byref ); - break; - - default: - if( pVariant->n1.n2.vt & VT_ARRAY ) - { - UINT iDims; - long * rgIndices; - PHB_ITEM pArray; - VARTYPE vt; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - parray = *pVariant->n1.n2.n3.pparray; - } - else - { - parray = pVariant->n1.n2.n3.parray; - } - - if( parray ) - { - iDims = SafeArrayGetDim( parray ); - rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); - - vt = pVariant->n1.n2.vt; - vt &= ~VT_ARRAY; - vt &= ~VT_BYREF; - - //HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", vt, __FILE__, __LINE__)); - - pArray = SafeArrayToArray( parray, iDims, rgIndices, vt ); - - hb_xfree( (void *) rgIndices ); - - hb_itemForwardValue( pItem, pArray ); - hb_itemRelease( pArray ); - } - else - { - hb_arrayNew( pItem, 0 ); - } - } - else - { - HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); - return E_FAIL; - } - } - - //VariantClear( pVariant ); - - return S_OK; - } - - //---------------------------------------------------------------------------// - static void RetValue( void ) - { - hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal ); - - VariantClear( &s_RetVal ); - - return; - } - - HB_FUNC( __OLEENUMNEXT ) - { - IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); - ULONG *pcElementFetched = NULL; - - if( pEnumVariant->lpVtbl->Next( pEnumVariant, 1, &s_RetVal, pcElementFetched ) == S_OK ) + for( i = iFrom; i <= iTo; i++ ) { - hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal ); - VariantClear( &s_RetVal ); - hb_storl( TRUE, 2 ); + rgIndices[ iDim - 1 ] = i; + + //printf( " Sub: %i\n", i ); + + pSubArray = SafeArrayToArray( parray, iDim - 1, rgIndices, vt ); + hb_arraySetForward( pArray, i - iFrom + 1, pSubArray ); + hb_itemRelease( pSubArray ); + } + } + else + { + VARIANT mElem; + void *pTarget; + char *sArray = NULL; + + VariantInit( &mElem ); + + if( vt == VT_VARIANT ) + { + hb_arrayNew( pArray, iLen ); + + pTarget = &mElem; } else - hb_storl( FALSE, 2 ); - } + { + if( vt == VT_I1 || vt == VT_UI1 ) + { + // Ugly hack, but needed to allocate our signature as hidden bytes! + hb_itemPutCL( pArray, NULL, 0 ); + HB_STRING_ALLOC( pArray, (ULONG)(iLen + 5) ); + pArray->item.asString.length = iLen; // TOFIX - HB_FUNC( __OLEENUMSTOP ) - { - IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); - pEnumVariant->lpVtbl->Release( pEnumVariant ); - } + sArray = hb_itemGetCPtr( pArray ); - //---------------------------------------------------------------------------// - HB_FUNC( OLESHOWEXCEPTION ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { + sArray[ iLen ] = 0x7A; + sArray[ iLen + 1 ] = 0x7B; + sArray[ iLen + 2 ] = 0x7C; + sArray[ iLen + 3 ] = 0x7D; + sArray[ iLen + 4 ] = (char)(vt); + + pTarget = NULL; + } + else + { + hb_arrayNew( pArray, iLen ); + + pTarget = &mElem.n1.n2.n3.cVal; + } + } + + for( i = iFrom; i <= iTo; i++ ) + { + rgIndices[ iDim - 1 ] = i; + + if( vt != VT_VARIANT ) + { + // Get cleared on VariantClear() - don't place out of loop! + mElem.n1.n2.vt = vt; + + if( vt == VT_I1 || vt == VT_UI1 ) + { + SafeArrayGetElement( parray, rgIndices, &( sArray[ i - iFrom ] ) ); + + continue; + } + } + + if( SUCCEEDED( SafeArrayGetElement( parray, rgIndices, pTarget ) ) ) + { + //HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", mElem.n1.n2.vt, __FILE__, __LINE__)); + + hb_oleVariantToItem( hb_arrayGetItemPtr( pArray, i - iFrom + 1 ), &mElem ); + + VariantClear( &mElem ); + } + } + } + + //HB_TRACE(HB_TR_INFO, ("Return len: %i\n", hb_arrayLen( pArray ))); + + // Wrap our array with VTArrayWrapper() class ( aArray := VTArrayWrapper( vt, aArray) ) + if( HB_IS_ARRAY( pArray ) && vt != VT_VARIANT ) + { + PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) vt ); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_VTArrayWrapper ) ); + hb_vmPushNil(); + hb_itemPushForward( pVT ); + hb_itemPushForward( pArray ); + hb_vmDo( 2 ); + + hb_itemForwardValue( pArray, hb_stackReturnItem() ); + + hb_itemRelease( pVT ); + } + + return pArray; +} + +//---------------------------------------------------------------------------// +HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ) +{ + PHB_ITEM pOleAuto; + IUnknown *pUnk = NULL; + IDispatch *pDisp = NULL; + SAFEARRAY *parray;// = NULL; + + hb_itemClear( pItem ); + + // Don't "optimize" (VT_ARRAY | VT_VARIANT) must not match! + while( pVariant->n1.n2.vt == ( VT_BYREF | VT_VARIANT ) || pVariant->n1.n2.vt == VT_VARIANT || pVariant->n1.n2.vt == VT_BYREF ) + { + pVariant = pVariant->n1.n2.n3.pvarVal; + } + + switch( pVariant->n1.n2.vt ) + { + case VT_BSTR | VT_BYREF: + case VT_BSTR: + { + char *sString; + + if( pVariant->n1.n2.vt & VT_BYREF ) + { + sString = hb_oleWideToAnsi( *pVariant->n1.n2.n3.pbstrVal ); + } + else + { + sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); + } + + if( sString ) + { + hb_itemPutCPtr( pItem, sString, strlen( sString ) ); + } + else + { + hb_itemPutC( pItem, NULL ); + } + + break; + } + + case VT_BOOL | VT_BYREF: + hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); + break; + + case VT_BOOL: + hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); + break; + + case ( VT_UNKNOWN | VT_BYREF ): + pUnk = *pVariant->n1.n2.n3.ppunkVal; + // Intentionally fall through + + case VT_UNKNOWN: + if( pVariant->n1.n2.vt == VT_UNKNOWN ) + { + pUnk = pVariant->n1.n2.n3.punkVal; + } + + if( pUnk ) + { + IDispatch ** pDispPtr = &pDisp; + pUnk->lpVtbl->QueryInterface( pUnk, HB_ID_REF( REFIID, IID_IDispatch ), (void **) pDispPtr ); + } + // Intentionally fall through + + case ( VT_DISPATCH | VT_BYREF ): + if( pVariant->n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) + { + pDisp = *pVariant->n1.n2.n3.ppdispVal; + } + // Intentionally fall through + + case VT_DISPATCH: + if( pVariant->n1.n2.vt == VT_DISPATCH ) + { + pDisp = pVariant->n1.n2.n3.pdispVal; + } + + if( pDisp == NULL ) + { + if( pUnk ) + { + PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) pVariant->n1.n2.vt ); + PHB_ITEM pUnknown = hb_itemPutPtr( hb_itemNew( NULL ), (void *) pUnk ); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_VTWrapper ) ); + hb_vmPushNil(); + hb_itemPushForward( pVT ); + hb_itemPushForward( pUnknown ); + hb_vmDo( 2 ); + + if( pItem != hb_stackReturnItem() ) + { + hb_itemForwardValue( pItem, hb_stackReturnItem() ); + } + + hb_itemRelease( pVT ); + hb_itemRelease( pUnknown ); + } + + break; + } + + pOleAuto = hb_itemNew( NULL ); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_TOleAuto ) ); + hb_vmPushNil(); + hb_vmDo( 0 ); + + // Safety! + hb_vmRequestReset(); + + hb_itemForwardValue( pOleAuto, hb_stackReturnItem() ); + + if( hb_itemType( pOleAuto ) ) + { + //TOleAuto():New( nDispatch ) + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_New ) ); + hb_itemPushForward( pOleAuto ); + hb_vmPushLong( ( LONG ) pDisp ); + hb_vmSend( 1 ); + + // If retrieved from IUnknown than doubly added! + if( pVariant->n1.n2.vt == VT_UNKNOWN || pVariant->n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) + { + pDisp->lpVtbl->Release( pDisp ); + } + + hb_itemRelease( pOleAuto ); + + // Safety! + hb_vmRequestReset(); + + if( pItem != hb_stackReturnItem() ) + { + hb_itemForwardValue( pItem, hb_stackReturnItem() ); + } + } + break; + + case VT_I1 | VT_BYREF: // Byte + case VT_UI1 | VT_BYREF: + hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.pbVal ); + break; + + case VT_I1: // Byte + case VT_UI1: + hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.bVal ); + break; + + case VT_I2 | VT_BYREF: // Short (2 bytes) + case VT_UI2 | VT_BYREF: + hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.piVal ); + break; + + case VT_I2: // Short (2 bytes) + case VT_UI2: + hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.iVal ); + break; + + case VT_I4 | VT_BYREF: // Long (4 bytes) + case VT_UI4 | VT_BYREF: + case VT_INT | VT_BYREF: + case VT_UINT | VT_BYREF: + hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); + break; + + case VT_I4: // Long (4 bytes) + case VT_UI4: + case VT_INT: + case VT_UINT: + hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); + break; + + case VT_R4 | VT_BYREF: // Single + hb_itemPutND( pItem, *pVariant->n1.n2.n3.pfltVal ); + break; + + case VT_R4: // Single + hb_itemPutND( pItem, pVariant->n1.n2.n3.fltVal ); + break; + + case VT_R8 | VT_BYREF: // Double + hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); + break; + + case VT_R8: // Double + hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); + break; + + case VT_CY | VT_BYREF: // Currency + case VT_CY: // Currency + { + double tmp = 0; + + if( pVariant->n1.n2.vt & VT_BYREF ) + { + VarR8FromCy( *pVariant->n1.n2.n3.pcyVal, &tmp ); + } + else + { + VarR8FromCy( pVariant->n1.n2.n3.cyVal, &tmp ); + } + + hb_itemPutND( pItem, tmp ); + break; + } + + case VT_DECIMAL | VT_BYREF: // Decimal + case VT_DECIMAL: // Decimal + { + double tmp = 0; + + if( pVariant->n1.n2.vt & VT_BYREF ) + { + VarR8FromDec( pVariant->n1.n2.n3.pdecVal, &tmp ); + } + else + { + VarR8FromDec( &pVariant->n1.decVal, &tmp ); + } + + hb_itemPutND( pItem, tmp ); + break; + } + + case VT_DATE | VT_BYREF: + hb_itemPutDL( pItem, (long) ( *pVariant->n1.n2.n3.pdblVal ) + 2415019 ); + break; + + case VT_DATE: + hb_itemPutDL( pItem, (long) ( pVariant->n1.n2.n3.dblVal ) + 2415019 ); + break; + + case VT_EMPTY | VT_BYREF: + case VT_NULL | VT_BYREF: + case VT_EMPTY: + case VT_NULL: + break; + + /* + case VT_VARIANT: + hb_oleVariantToItem( pItem, pVariant->n1.n2.n3.pvarVal ); + break; + */ + + case VT_PTR: + hb_itemPutPtr( pItem, pVariant->n1.n2.n3.byref ); + break; + + default: + if( pVariant->n1.n2.vt & VT_ARRAY ) + { + UINT iDims; + long * rgIndices; + PHB_ITEM pArray; + VARTYPE vt; + + if( pVariant->n1.n2.vt & VT_BYREF ) + { + parray = *pVariant->n1.n2.n3.pparray; + } + else + { + parray = pVariant->n1.n2.n3.parray; + } + + if( parray ) + { + iDims = SafeArrayGetDim( parray ); + rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); + + vt = pVariant->n1.n2.vt; + vt &= ~VT_ARRAY; + vt &= ~VT_BYREF; + + //HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", vt, __FILE__, __LINE__)); + + pArray = SafeArrayToArray( parray, iDims, rgIndices, vt ); + + hb_xfree( (void *) rgIndices ); + + hb_itemForwardValue( pItem, pArray ); + hb_itemRelease( pArray ); + } + else + { + hb_arrayNew( pItem, 0 ); + } + } + else + { + HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__)); + return E_FAIL; + } + } + + //VariantClear( pVariant ); + + return S_OK; +} + +//---------------------------------------------------------------------------// +static void RetValue( void ) +{ + hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal ); + + VariantClear( &s_RetVal ); + + return; +} + +HB_FUNC( __OLEENUMNEXT ) +{ + IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); + ULONG *pcElementFetched = NULL; + + if( pEnumVariant->lpVtbl->Next( pEnumVariant, 1, &s_RetVal, pcElementFetched ) == S_OK ) + { + hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal ); + VariantClear( &s_RetVal ); + hb_storl( TRUE, 2 ); + } + else + hb_storl( FALSE, 2 ); +} + +HB_FUNC( __OLEENUMSTOP ) +{ + IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); + pEnumVariant->lpVtbl->Release( pEnumVariant ); +} + +//---------------------------------------------------------------------------// +HB_FUNC( OLESHOWEXCEPTION ) +{ + if( (LONG) s_nOleError == DISP_E_EXCEPTION ) + { #if defined( UNICODE ) - MessageBox( NULL, excep.bstrDescription, excep.bstrSource, MB_ICONHAND ); + MessageBox( NULL, excep.bstrDescription, excep.bstrSource, MB_ICONHAND ); #else - LPSTR source, description; + LPSTR source, description; - source = hb_oleWideToAnsi( excep.bstrSource ); - description = hb_oleWideToAnsi( excep.bstrDescription ); + source = hb_oleWideToAnsi( excep.bstrSource ); + description = hb_oleWideToAnsi( excep.bstrDescription ); - MessageBox( NULL, description, source, MB_ICONHAND ); + MessageBox( NULL, description, source, MB_ICONHAND ); - hb_xfree( source ); - hb_xfree( description ); + hb_xfree( source ); + hb_xfree( description ); #endif - } - } + } +} - //---------------------------------------------------------------------------// - HB_FUNC( OLEEXCEPTIONSOURCE ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { - LPSTR source; +//---------------------------------------------------------------------------// +HB_FUNC( OLEEXCEPTIONSOURCE ) +{ + if( (LONG) s_nOleError == DISP_E_EXCEPTION ) + { + LPSTR source; - source = hb_oleWideToAnsi( excep.bstrSource ); - hb_retc_buffer( source ); - } - } + source = hb_oleWideToAnsi( excep.bstrSource ); + hb_retc_buffer( source ); + } +} - //---------------------------------------------------------------------------// - HB_FUNC( OLEEXCEPTIONDESCRIPTION ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { - LPSTR description; +//---------------------------------------------------------------------------// +HB_FUNC( OLEEXCEPTIONDESCRIPTION ) +{ + if( (LONG) s_nOleError == DISP_E_EXCEPTION ) + { + LPSTR description; - description = hb_oleWideToAnsi( excep.bstrDescription ); - hb_retc_buffer( description ); - } - } + description = hb_oleWideToAnsi( excep.bstrDescription ); + hb_retc_buffer( description ); + } +} - //---------------------------------------------------------------------------// - HB_FUNC( OLEERROR ) - { - hb_retnl( (LONG) s_nOleError ); - } +//---------------------------------------------------------------------------// +HB_FUNC( OLEERROR ) +{ + hb_retnl( (LONG) s_nOleError ); +} - //---------------------------------------------------------------------------// - static char * Ole2TxtError( void ) - { - switch( (LONG) s_nOleError ) - { - case S_OK: - return "S_OK"; - - case CO_E_CLASSSTRING: - return "CO_E_CLASSSTRING"; - - case OLE_E_WRONGCOMPOBJ: - return "OLE_E_WRONGCOMPOBJ"; - - case REGDB_E_CLASSNOTREG: - return "REGDB_E_CLASSNOTREG"; - - case REGDB_E_WRITEREGDB: - return "REGDB_E_WRITEREGDB"; - - case E_FAIL: - return "E_FAIL"; - - case E_OUTOFMEMORY: - return "E_OUTOFMEMORY"; - - case E_NOTIMPL: - return "E_NOTIMPL"; - - case E_INVALIDARG: - return "E_INVALIDARG"; - - case E_UNEXPECTED: - return "E_UNEXPECTED"; - - case DISP_E_UNKNOWNNAME: - return "DISP_E_UNKNOWNNAME"; - - case DISP_E_UNKNOWNLCID: - return "DISP_E_UNKNOWNLCID"; - - case DISP_E_BADPARAMCOUNT: - return "DISP_E_BADPARAMCOUNT"; - - case DISP_E_BADVARTYPE: - return "DISP_E_BADVARTYPE"; - - case DISP_E_EXCEPTION: - return "DISP_E_EXCEPTION"; - - case DISP_E_MEMBERNOTFOUND: - return "DISP_E_MEMBERNOTFOUND"; - - case DISP_E_NONAMEDARGS: - return "DISP_E_NONAMEDARGS"; - - case DISP_E_OVERFLOW: - return "DISP_E_OVERFLOW"; - - case DISP_E_PARAMNOTFOUND: - return "DISP_E_PARAMNOTFOUND"; - - case DISP_E_TYPEMISMATCH: - return "DISP_E_TYPEMISMATCH"; - - case DISP_E_UNKNOWNINTERFACE: - return "DISP_E_UNKNOWNINTERFACE"; - - case DISP_E_PARAMNOTOPTIONAL: - return "DISP_E_PARAMNOTOPTIONAL"; - - case CO_E_SERVER_EXEC_FAILURE: - return "CO_E_SERVER_EXEC_FAILURE"; - - case MK_E_UNAVAILABLE: - return "MK_E_UNAVAILABLE"; - - default: - HB_TRACE(HB_TR_INFO, ("TOleAuto Error %p\n", s_nOleError)); - return "Unknown error"; - }; - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLE2TXTERROR ) - { - hb_retc( Ole2TxtError() ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( MESSAGEBOX ) - { - LPTSTR lpStr1 = HB_TCHAR_CONVTO( hb_parcx( 2 ) ), - lpStr2 = HB_TCHAR_CONVTO( hb_parcx( 3 ) ); - hb_retni( MessageBox( ( HWND ) hb_parnl( 1 ), lpStr1, lpStr2, hb_parni( 4 ) ) ); - HB_TCHAR_FREE( lpStr1 ); - HB_TCHAR_FREE( lpStr2 ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( CREATEOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) - { - BSTR bstrClassID; - IID ClassID, iid; - LPIID riid = (LPIID) &IID_IDispatch; - void *pDisp = NULL; // IDispatch - /* void * - * used intentionally to inform compiler that there is no - * strict-aliasing - */ - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); - - if( hb_parcx( 1 )[ 0 ] == '{' ) - { - s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); - } - else - { - s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); - } - - SysFreeString( bstrClassID ); - - //HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError)); - - if( hb_pcount() == 2 ) - { - if( hb_parcx( 2 )[ 0 ] == '{' ) - { - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); - s_nOleError = CLSIDFromString( bstrClassID, &iid ); - SysFreeString( bstrClassID ); - } - else - { - memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); - } - - riid = &iid; - } - - if( SUCCEEDED( s_nOleError ) ) - { - //HB_TRACE(HB_TR_INFO, ("Class: %i\n", ClassID)); - s_nOleError = CoCreateInstance( HB_ID_REF( REFCLSID, ClassID ), NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp ); - //HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError)); - } - - hb_retnl( ( LONG ) pDisp ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( GETOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) - { - BSTR bstrClassID; - IID ClassID, iid; - LPIID riid = (LPIID) &IID_IDispatch; - IUnknown *pUnk = NULL; - void *pDisp = NULL; // IDispatch - /* void * - * used intentionally to inform compiler that there is no - * strict-aliasing - */ - - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); - - if( hb_parcx( 1 )[ 0 ] == '{' ) - { - s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); - } - else - { - s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); - } - - //s_nOleError = ProgIDFromCLSID( &ClassID, &pOleStr ); - //wprintf( L"Result %i ProgID: '%s'\n", s_nOleError, pOleStr ); - - SysFreeString( bstrClassID ); - - if( hb_pcount() == 2 ) - { - if( hb_parcx( 2 )[ 0 ] == '{' ) - { - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); - s_nOleError = CLSIDFromString( bstrClassID, &iid ); - SysFreeString( bstrClassID ); - } - else - { - memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); - } - - riid = &iid; - } - - if( SUCCEEDED( s_nOleError ) ) - { - s_nOleError = GetActiveObject( HB_ID_REF( REFCLSID, ClassID ), NULL, &pUnk ); - - if( SUCCEEDED( s_nOleError ) ) - { - s_nOleError = pUnk->lpVtbl->QueryInterface( pUnk, (REFIID) riid, &pDisp ); - - pUnk->lpVtbl->Release( pUnk ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_retnl( ( LONG ) pDisp ); - } - } - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLEADDREF ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); - - //HB_TRACE(HB_TR_INFO, ("OleAddRef( %p )\n", pDisp)); - - s_nOleError = pDisp->lpVtbl->AddRef( pDisp ); - - hb_retnl( s_nOleError ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLERELEASEOBJECT ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); - - //HB_TRACE(HB_TR_INFO, ("OleReleaseObject( %p )\n", pDisp)); - - s_nOleError = pDisp->lpVtbl->Release( pDisp ); - - hb_retnl( s_nOleError ); - } - - //---------------------------------------------------------------------------// - static HRESULT OleSetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - pDispParams->rgdispidNamedArgs = &lPropPut; - pDispParams->cNamedArgs = 1; - - // 1 Based!!! - if( ( ISBYREF( 1 ) ) || ISARRAY( 1 ) ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - HB_ID_REF( REFIID, IID_NULL ), - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYPUTREF, - pDispParams, - NULL, // No return value - &excep, - &uArgErr ); - - if( SUCCEEDED( s_nOleError ) ) - { - return s_nOleError; - } - } - - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - HB_ID_REF( REFIID, IID_NULL ), - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYPUT, - pDispParams, - NULL, // No return value - &excep, - &uArgErr ); - - pDispParams->rgdispidNamedArgs = NULL; - pDispParams->cNamedArgs = 0; - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleInvoke( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - HB_ID_REF( REFIID, IID_NULL ), - LOCALE_SYSTEM_DEFAULT, - DISPATCH_METHOD, - pDispParams, - &s_RetVal, - &excep, - &uArgErr ); - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - HB_ID_REF( REFIID, IID_NULL ), - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYGET, - pDispParams, - &s_RetVal, - &excep, - &uArgErr ); - - //HB_TRACE(HB_TR_INFO, ("OleGetValue: %p\n", s_nOleError)); - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetValue( IDispatch *pDisp ) - { - VariantClear( &s_RetVal ); - - // Try to apply the requested message to the DEFAULT Property of the object if any. - if( SUCCEEDED( OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ) ) && ( s_RetVal.n1.n2.vt == VT_DISPATCH || s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) ) - { - VariantCopy( &s_OleVal, &s_RetVal ); - VariantClear( &s_RetVal ); - - return s_nOleError; - } - - return E_FAIL; - } - - //---------------------------------------------------------------------------// - static void OleThrowError( void ) - { - PHB_ITEM pReturn; - char *sDescription; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - if( s_nOleError == DISP_E_EXCEPTION ) - { - // Intentional to avoid report of memory leak if fatal error. - char *sTemp = hb_oleWideToAnsi( excep.bstrDescription ); - sDescription = (char *) malloc( strlen( sTemp ) + 1 ); - strcpy( sDescription, sTemp ); - hb_xfree( sTemp ); - } - else - { - sDescription = Ole2TxtError(); - } - - //HB_TRACE(HB_TR_INFO, ("Desc: '%s'\n", sDescription)); - - pReturn = hb_errRT_SubstParams( hb_parcx( -1 ), EG_OLEEXECPTION, (ULONG) s_nOleError, sDescription, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - if( s_nOleError == DISP_E_EXCEPTION ) - { - free( (void *) sDescription ); - } - - if( pReturn ) - { - hb_itemRelease( hb_itemReturn( pReturn ) ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_OLEVALUE ) - { - if( hb_pcount() == 0 ) - { - IDispatch *pDisp; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &s_RetVal ); - - OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ); - //HB_TRACE(HB_TR_INFO, ("GetDefault: %p\n", s_nOleError)); - - if( SUCCEEDED( s_nOleError ) ) - { - RetValue(); - } - else - { - OleThrowError(); - } - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO__OLEVALUE ) - { - if( hb_pcount() >= 1 ) - { - IDispatch *pDisp; - DISPPARAMS DispParams; - PHB_ITEM *aPrgParams; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &s_RetVal ); - - aPrgParams = GetParams( &DispParams, 0 ); - - OleSetProperty( pDisp, DISPID_VALUE, &DispParams ); - //HB_TRACE(HB_TR_INFO, ("SetDefault: %p\n", s_nOleError)); - - FreeParams( &DispParams, aPrgParams ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - else - { - OleThrowError(); - } - } - } - - //---------------------------------------------------------------------------// - - HB_FUNC( TOLEAUTO_OLENEWENUMERATOR ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &s_RetVal ); - - if( SUCCEEDED( OleGetProperty( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) || - SUCCEEDED( OleInvoke( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) ) - { - LPVOID pEnumVariant = NULL; /* IEnumVARIANT */ - - if( s_RetVal.n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) - { - s_nOleError = (*s_RetVal.n1.n2.n3.ppunkVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppunkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); - } - else if( s_RetVal.n1.n2.vt == VT_UNKNOWN ) - { - s_nOleError = s_RetVal.n1.n2.n3.punkVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.punkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); - } - else if( s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) - { - s_nOleError = (*s_RetVal.n1.n2.n3.ppdispVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); - } - else if( s_RetVal.n1.n2.vt == VT_DISPATCH ) - { - s_nOleError = s_RetVal.n1.n2.n3.pdispVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.pdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); - } - else - { - s_nOleError = E_FAIL; - } - - VariantClear( &s_RetVal ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_retptr( pEnumVariant ); - } - else - { - hb_ret(); - } - } - else - { - OleThrowError(); - } - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetID( IDispatch *pDisp, const char *szName, DISPID *pDispID, BOOL *pbSetFirst ) - { - BSTR bstrMessage; - - if( pbSetFirst ) - { - *pbSetFirst = FALSE; - } - - /* - if( strcmp( szName, "OLEVALUE" ) == 0 || strcmp( szName, "_OLEVALUE" ) == 0 ) - { - DispID = DISPID_VALUE; - s_nOleError = S_OK; - } - else*/ if( szName[0] == '_' && szName[1] && hb_pcount() >= 1 ) - { - bstrMessage = hb_oleAnsiToSysString( szName + 1 ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), (wchar_t **) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, pDispID ); - SysFreeString( bstrMessage ); - //HB_TRACE(HB_TR_INFO, ("1. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1, DispID, s_nOleError)); - - if( SUCCEEDED( s_nOleError ) ) - { - if( pbSetFirst ) - { - *pbSetFirst = TRUE; - } - } - } - else - { - s_nOleError = E_PENDING; - } - - if( FAILED( s_nOleError ) ) - { - // Try again without removing the assign prefix (_). - bstrMessage = hb_oleAnsiToSysString( szName ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), (wchar_t **) &bstrMessage, 1, 0, pDispID ); - SysFreeString( bstrMessage ); - //HB_TRACE(HB_TR_INFO, ("2. ID of: '%s' -> %i Result: %p\n", szName, *pDispID, s_nOleError)); - } - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_INVOKE ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_SET ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_GET ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_ONERROR ) - { - IDispatch *pDisp; - DISPID DispID; - DISPPARAMS DispParams; - BOOL bSetFirst = FALSE, bTryDefault = TRUE; - PHB_ITEM *aPrgParams = GetParams( &DispParams, 0 ); - - //HB_TRACE(HB_TR_INFO, ("Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1))); - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - OleGetID : - - if( SUCCEEDED( OleGetID( pDisp, hb_itemGetSymbol( hb_stackBaseItem() )->szName, &DispID, &bSetFirst ) ) ) - { - VariantClear( &s_RetVal ); - - if( bSetFirst ) - { - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - - //HB_TRACE(HB_TR_INFO, ("FIRST OleSetProperty %i\n", s_nOleError)); - } - else - { - s_nOleError = E_PENDING; - } - - if( FAILED( s_nOleError ) ) - { - if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - //HB_TRACE(HB_TR_INFO, ("OleInvoke %i\n", s_nOleError)); - } - - if( FAILED( s_nOleError ) ) - { - if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - //HB_TRACE(HB_TR_INFO, ("OleGetProperty(%i) %i\n", DispParams.cArgs, s_nOleError)); - } - - if( FAILED( s_nOleError ) && bSetFirst == FALSE && hb_pcount() >= 1 ) - { - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - - //HB_TRACE(HB_TR_INFO, ("OleSetProperty %i\n", s_nOleError)); - } - } - - if( SUCCEEDED( s_nOleError ) ) - { - //HB_TRACE(HB_TR_INFO, ("Invoke Succeeded!\n")); - if( HB_IS_OBJECT( hb_stackReturnItem() ) && hb_clsIsParent( hb_objGetClass( hb_stackReturnItem() ), "TOLEAUTO" ) ) - { - PHB_ITEM pReturn = hb_itemNew( NULL ); - PHB_ITEM pOleClassName = hb_itemNew( NULL ); - char *sOleClassName; - int iClassNameLen, iMsgNameLen; - - hb_itemForwardValue( pReturn, hb_stackReturnItem() ); - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - iClassNameLen = hb_parclen( -1 ); - iMsgNameLen = strlen( hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - sOleClassName = (char *) hb_xgrab( iClassNameLen + 1 + iMsgNameLen + 1 ); - - strncpy( sOleClassName, hb_parc( - 1 ), iClassNameLen ); - sOleClassName[ iClassNameLen ] = ':'; - strcpy( sOleClassName + iClassNameLen + 1, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - //HB_TRACE(HB_TR_INFO, ("Class: '%s'\n", sOleClassName)); - - hb_itemPutCPtr( pOleClassName, sOleClassName, iClassNameLen + 1 + iMsgNameLen ); - - hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); - hb_vmPush( pReturn ); - hb_itemPushForward( pOleClassName ); - hb_vmSend( 1 ); - - hb_itemReturnForward( pReturn ); - - hb_itemRelease( pReturn ); - hb_itemRelease( pOleClassName ); - } - } - else - { - // Try to apply the requested message to the DEFAULT Method of the object if any. - if( bTryDefault ) - { - if( SUCCEEDED( ( /* s_nOleError = */ OleGetValue( pDisp ) ) ) ) - { - bTryDefault = FALSE; - - //HB_TRACE(HB_TR_INFO, ("Try using DISPID_VALUE\n")); - pDisp = s_OleVal.n1.n2.n3.pdispVal; - goto OleGetID; - } - } - - //HB_TRACE(HB_TR_INFO, ("Invoke Failed!\n")); - OleThrowError(); - } - - FreeParams( &DispParams, aPrgParams ); - - // We are responsible to release the Default Interface which we retrieved - if( bTryDefault == FALSE && pDisp ) - { - pDisp->lpVtbl->Release( pDisp ); - } - } +//---------------------------------------------------------------------------// +static char * Ole2TxtError( void ) +{ + switch( (LONG) s_nOleError ) + { + case S_OK: + return "S_OK"; + + case CO_E_CLASSSTRING: + return "CO_E_CLASSSTRING"; + + case OLE_E_WRONGCOMPOBJ: + return "OLE_E_WRONGCOMPOBJ"; + + case REGDB_E_CLASSNOTREG: + return "REGDB_E_CLASSNOTREG"; + + case REGDB_E_WRITEREGDB: + return "REGDB_E_WRITEREGDB"; + + case E_FAIL: + return "E_FAIL"; + + case E_OUTOFMEMORY: + return "E_OUTOFMEMORY"; + + case E_NOTIMPL: + return "E_NOTIMPL"; + + case E_INVALIDARG: + return "E_INVALIDARG"; + + case E_UNEXPECTED: + return "E_UNEXPECTED"; + + case DISP_E_UNKNOWNNAME: + return "DISP_E_UNKNOWNNAME"; + + case DISP_E_UNKNOWNLCID: + return "DISP_E_UNKNOWNLCID"; + + case DISP_E_BADPARAMCOUNT: + return "DISP_E_BADPARAMCOUNT"; + + case DISP_E_BADVARTYPE: + return "DISP_E_BADVARTYPE"; + + case DISP_E_EXCEPTION: + return "DISP_E_EXCEPTION"; + + case DISP_E_MEMBERNOTFOUND: + return "DISP_E_MEMBERNOTFOUND"; + + case DISP_E_NONAMEDARGS: + return "DISP_E_NONAMEDARGS"; + + case DISP_E_OVERFLOW: + return "DISP_E_OVERFLOW"; + + case DISP_E_PARAMNOTFOUND: + return "DISP_E_PARAMNOTFOUND"; + + case DISP_E_TYPEMISMATCH: + return "DISP_E_TYPEMISMATCH"; + + case DISP_E_UNKNOWNINTERFACE: + return "DISP_E_UNKNOWNINTERFACE"; + + case DISP_E_PARAMNOTOPTIONAL: + return "DISP_E_PARAMNOTOPTIONAL"; + + case CO_E_SERVER_EXEC_FAILURE: + return "CO_E_SERVER_EXEC_FAILURE"; + + case MK_E_UNAVAILABLE: + return "MK_E_UNAVAILABLE"; + + default: + HB_TRACE(HB_TR_INFO, ("TOleAuto Error %p\n", s_nOleError)); + return "Unknown error"; + }; +} + +//---------------------------------------------------------------------------// +HB_FUNC( OLE2TXTERROR ) +{ + hb_retc( Ole2TxtError() ); +} + +//---------------------------------------------------------------------------// +HB_FUNC( MESSAGEBOX ) +{ + LPTSTR lpStr1 = HB_TCHAR_CONVTO( hb_parcx( 2 ) ), + lpStr2 = HB_TCHAR_CONVTO( hb_parcx( 3 ) ); + hb_retni( MessageBox( ( HWND ) hb_parnl( 1 ), lpStr1, lpStr2, hb_parni( 4 ) ) ); + HB_TCHAR_FREE( lpStr1 ); + HB_TCHAR_FREE( lpStr2 ); +} + +//---------------------------------------------------------------------------// +HB_FUNC( CREATEOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) +{ + BSTR bstrClassID; + IID ClassID, iid; + LPIID riid = (LPIID) &IID_IDispatch; + void *pDisp = NULL; // IDispatch + /* void * + * used intentionally to inform compiler that there is no + * strict-aliasing + */ + bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); + + if( hb_parcx( 1 )[ 0 ] == '{' ) + { + s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); + } + else + { + s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); + } + + SysFreeString( bstrClassID ); + + //HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError)); + + if( hb_pcount() == 2 ) + { + if( hb_parcx( 2 )[ 0 ] == '{' ) + { + bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); + s_nOleError = CLSIDFromString( bstrClassID, &iid ); + SysFreeString( bstrClassID ); + } + else + { + memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); + } + + riid = &iid; + } + + if( SUCCEEDED( s_nOleError ) ) + { + //HB_TRACE(HB_TR_INFO, ("Class: %i\n", ClassID)); + s_nOleError = CoCreateInstance( HB_ID_REF( REFCLSID, ClassID ), NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp ); + //HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError)); + } + + hb_retnl( ( LONG ) pDisp ); +} + +//---------------------------------------------------------------------------// +HB_FUNC( GETOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) +{ + BSTR bstrClassID; + IID ClassID, iid; + LPIID riid = (LPIID) &IID_IDispatch; + IUnknown *pUnk = NULL; + void *pDisp = NULL; // IDispatch + /* void * + * used intentionally to inform compiler that there is no + * strict-aliasing + */ + + bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); + + if( hb_parcx( 1 )[ 0 ] == '{' ) + { + s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); + } + else + { + s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); + } + + //s_nOleError = ProgIDFromCLSID( &ClassID, &pOleStr ); + //wprintf( L"Result %i ProgID: '%s'\n", s_nOleError, pOleStr ); + + SysFreeString( bstrClassID ); + + if( hb_pcount() == 2 ) + { + if( hb_parcx( 2 )[ 0 ] == '{' ) + { + bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); + s_nOleError = CLSIDFromString( bstrClassID, &iid ); + SysFreeString( bstrClassID ); + } + else + { + memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); + } + + riid = &iid; + } + + if( SUCCEEDED( s_nOleError ) ) + { + s_nOleError = GetActiveObject( HB_ID_REF( REFCLSID, ClassID ), NULL, &pUnk ); + + if( SUCCEEDED( s_nOleError ) ) + { + s_nOleError = pUnk->lpVtbl->QueryInterface( pUnk, (REFIID) riid, &pDisp ); + + pUnk->lpVtbl->Release( pUnk ); + + if( SUCCEEDED( s_nOleError ) ) + { + hb_retnl( ( LONG ) pDisp ); + } + } + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( OLEADDREF ) // (hOleObject, szMethodName, uParams...) +{ + IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); + + //HB_TRACE(HB_TR_INFO, ("OleAddRef( %p )\n", pDisp)); + + s_nOleError = pDisp->lpVtbl->AddRef( pDisp ); + + hb_retnl( s_nOleError ); +} + +//---------------------------------------------------------------------------// +HB_FUNC( OLERELEASEOBJECT ) // (hOleObject, szMethodName, uParams...) +{ + IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); + + //HB_TRACE(HB_TR_INFO, ("OleReleaseObject( %p )\n", pDisp)); + + s_nOleError = pDisp->lpVtbl->Release( pDisp ); + + hb_retnl( s_nOleError ); +} + +//---------------------------------------------------------------------------// +static HRESULT OleSetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) +{ + pDispParams->rgdispidNamedArgs = &lPropPut; + pDispParams->cNamedArgs = 1; + + // 1 Based!!! + if( ( ISBYREF( 1 ) ) || ISARRAY( 1 ) ) + { + memset( (LPBYTE) &excep, 0, sizeof( excep ) ); + + s_nOleError = pDisp->lpVtbl->Invoke( pDisp, + DispID, + HB_ID_REF( REFIID, IID_NULL ), + LOCALE_SYSTEM_DEFAULT, + DISPATCH_PROPERTYPUTREF, + pDispParams, + NULL, // No return value + &excep, + &uArgErr ); + + if( SUCCEEDED( s_nOleError ) ) + { + return s_nOleError; + } + } + + memset( (LPBYTE) &excep, 0, sizeof( excep ) ); + + s_nOleError = pDisp->lpVtbl->Invoke( pDisp, + DispID, + HB_ID_REF( REFIID, IID_NULL ), + LOCALE_SYSTEM_DEFAULT, + DISPATCH_PROPERTYPUT, + pDispParams, + NULL, // No return value + &excep, + &uArgErr ); + + pDispParams->rgdispidNamedArgs = NULL; + pDispParams->cNamedArgs = 0; + + return s_nOleError; +} + +//---------------------------------------------------------------------------// +static HRESULT OleInvoke( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) +{ + memset( (LPBYTE) &excep, 0, sizeof( excep ) ); + + s_nOleError = pDisp->lpVtbl->Invoke( pDisp, + DispID, + HB_ID_REF( REFIID, IID_NULL ), + LOCALE_SYSTEM_DEFAULT, + DISPATCH_METHOD, + pDispParams, + &s_RetVal, + &excep, + &uArgErr ); + + return s_nOleError; +} + +//---------------------------------------------------------------------------// +static HRESULT OleGetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) +{ + memset( (LPBYTE) &excep, 0, sizeof( excep ) ); + + s_nOleError = pDisp->lpVtbl->Invoke( pDisp, + DispID, + HB_ID_REF( REFIID, IID_NULL ), + LOCALE_SYSTEM_DEFAULT, + DISPATCH_PROPERTYGET, + pDispParams, + &s_RetVal, + &excep, + &uArgErr ); + + //HB_TRACE(HB_TR_INFO, ("OleGetValue: %p\n", s_nOleError)); + + return s_nOleError; +} + +//---------------------------------------------------------------------------// +static HRESULT OleGetValue( IDispatch *pDisp ) +{ + VariantClear( &s_RetVal ); + + // Try to apply the requested message to the DEFAULT Property of the object if any. + if( SUCCEEDED( OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ) ) && ( s_RetVal.n1.n2.vt == VT_DISPATCH || s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) ) + { + VariantCopy( &s_OleVal, &s_RetVal ); + VariantClear( &s_RetVal ); + + return s_nOleError; + } + + return E_FAIL; +} + +//---------------------------------------------------------------------------// +static void OleThrowError( void ) +{ + PHB_ITEM pReturn; + char *sDescription; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + if( s_nOleError == DISP_E_EXCEPTION ) + { + // Intentional to avoid report of memory leak if fatal error. + char *sTemp = hb_oleWideToAnsi( excep.bstrDescription ); + sDescription = (char *) malloc( strlen( sTemp ) + 1 ); + strcpy( sDescription, sTemp ); + hb_xfree( sTemp ); + } + else + { + sDescription = Ole2TxtError(); + } + + //HB_TRACE(HB_TR_INFO, ("Desc: '%s'\n", sDescription)); + + pReturn = hb_errRT_SubstParams( hb_parcx( -1 ), EG_OLEEXECPTION, (ULONG) s_nOleError, sDescription, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); + + if( s_nOleError == DISP_E_EXCEPTION ) + { + free( (void *) sDescription ); + } + + if( pReturn ) + { + hb_itemRelease( hb_itemReturn( pReturn ) ); + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO_OLEVALUE ) +{ + if( hb_pcount() == 0 ) + { + IDispatch *pDisp; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + VariantClear( &s_RetVal ); + + OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ); + //HB_TRACE(HB_TR_INFO, ("GetDefault: %p\n", s_nOleError)); + + if( SUCCEEDED( s_nOleError ) ) + { + RetValue(); + } + else + { + OleThrowError(); + } + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO__OLEVALUE ) +{ + if( hb_pcount() >= 1 ) + { + IDispatch *pDisp; + DISPPARAMS DispParams; + PHB_ITEM *aPrgParams; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + VariantClear( &s_RetVal ); + + aPrgParams = GetParams( &DispParams, 0 ); + + OleSetProperty( pDisp, DISPID_VALUE, &DispParams ); + //HB_TRACE(HB_TR_INFO, ("SetDefault: %p\n", s_nOleError)); + + FreeParams( &DispParams, aPrgParams ); + + if( SUCCEEDED( s_nOleError ) ) + { + hb_itemReturn( hb_stackItemFromBase( 1 ) ); + } + else + { + OleThrowError(); + } + } +} + +//---------------------------------------------------------------------------// + +HB_FUNC( TOLEAUTO_OLENEWENUMERATOR ) // (hOleObject, szMethodName, uParams...) +{ + IDispatch *pDisp; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + VariantClear( &s_RetVal ); + + if( SUCCEEDED( OleGetProperty( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) || + SUCCEEDED( OleInvoke( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) ) + { + LPVOID pEnumVariant = NULL; /* IEnumVARIANT */ + + if( s_RetVal.n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) + { + s_nOleError = (*s_RetVal.n1.n2.n3.ppunkVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppunkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); + } + else if( s_RetVal.n1.n2.vt == VT_UNKNOWN ) + { + s_nOleError = s_RetVal.n1.n2.n3.punkVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.punkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); + } + else if( s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) + { + s_nOleError = (*s_RetVal.n1.n2.n3.ppdispVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); + } + else if( s_RetVal.n1.n2.vt == VT_DISPATCH ) + { + s_nOleError = s_RetVal.n1.n2.n3.pdispVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.pdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant ); + } + else + { + s_nOleError = E_FAIL; + } + + VariantClear( &s_RetVal ); + + if( SUCCEEDED( s_nOleError ) ) + { + hb_retptr( pEnumVariant ); + } + else + { + hb_ret(); + } + } + else + { + OleThrowError(); + } +} + +//---------------------------------------------------------------------------// +static HRESULT OleGetID( IDispatch *pDisp, const char *szName, DISPID *pDispID, BOOL *pbSetFirst ) +{ + BSTR bstrMessage; + + if( pbSetFirst ) + { + *pbSetFirst = FALSE; + } + + /* + if( strcmp( szName, "OLEVALUE" ) == 0 || strcmp( szName, "_OLEVALUE" ) == 0 ) + { + DispID = DISPID_VALUE; + s_nOleError = S_OK; + } + else*/ if( szName[0] == '_' && szName[1] && hb_pcount() >= 1 ) + { + bstrMessage = hb_oleAnsiToSysString( szName + 1 ); + s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), (wchar_t **) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, pDispID ); + SysFreeString( bstrMessage ); + //HB_TRACE(HB_TR_INFO, ("1. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1, DispID, s_nOleError)); + + if( SUCCEEDED( s_nOleError ) ) + { + if( pbSetFirst ) + { + *pbSetFirst = TRUE; + } + } + } + else + { + s_nOleError = E_PENDING; + } + + if( FAILED( s_nOleError ) ) + { + // Try again without removing the assign prefix (_). + bstrMessage = hb_oleAnsiToSysString( szName ); + s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), (wchar_t **) &bstrMessage, 1, 0, pDispID ); + SysFreeString( bstrMessage ); + //HB_TRACE(HB_TR_INFO, ("2. ID of: '%s' -> %i Result: %p\n", szName, *pDispID, s_nOleError)); + } + + return s_nOleError; +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO_INVOKE ) +{ + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO_SET ) +{ + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO_GET ) +{ + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } +} + +//---------------------------------------------------------------------------// +HB_FUNC( TOLEAUTO_ONERROR ) +{ + IDispatch *pDisp; + DISPID DispID; + DISPPARAMS DispParams; + BOOL bSetFirst = FALSE, bTryDefault = TRUE; + PHB_ITEM *aPrgParams = GetParams( &DispParams, 0 ); + + //HB_TRACE(HB_TR_INFO, ("Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1))); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_hObj ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + OleGetID : + + if( SUCCEEDED( OleGetID( pDisp, hb_itemGetSymbol( hb_stackBaseItem() )->szName, &DispID, &bSetFirst ) ) ) + { + VariantClear( &s_RetVal ); + + if( bSetFirst ) + { + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) + { + hb_itemReturn( hb_stackItemFromBase( 1 ) ); + } + + //HB_TRACE(HB_TR_INFO, ("FIRST OleSetProperty %i\n", s_nOleError)); + } + else + { + s_nOleError = E_PENDING; + } + + if( FAILED( s_nOleError ) ) + { + if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + //HB_TRACE(HB_TR_INFO, ("OleInvoke %i\n", s_nOleError)); + } + + if( FAILED( s_nOleError ) ) + { + if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + //HB_TRACE(HB_TR_INFO, ("OleGetProperty(%i) %i\n", DispParams.cArgs, s_nOleError)); + } + + if( FAILED( s_nOleError ) && bSetFirst == FALSE && hb_pcount() >= 1 ) + { + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) + { + hb_itemReturn( hb_stackItemFromBase( 1 ) ); + } + + //HB_TRACE(HB_TR_INFO, ("OleSetProperty %i\n", s_nOleError)); + } + } + + if( SUCCEEDED( s_nOleError ) ) + { + //HB_TRACE(HB_TR_INFO, ("Invoke Succeeded!\n")); + if( HB_IS_OBJECT( hb_stackReturnItem() ) && hb_clsIsParent( hb_objGetClass( hb_stackReturnItem() ), "TOLEAUTO" ) ) + { + PHB_ITEM pReturn = hb_itemNew( NULL ); + PHB_ITEM pOleClassName = hb_itemNew( NULL ); + char *sOleClassName; + int iClassNameLen, iMsgNameLen; + + hb_itemForwardValue( pReturn, hb_stackReturnItem() ); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + iClassNameLen = hb_parclen( -1 ); + iMsgNameLen = strlen( hb_itemGetSymbol( hb_stackBaseItem() )->szName ); + + sOleClassName = (char *) hb_xgrab( iClassNameLen + 1 + iMsgNameLen + 1 ); + + strncpy( sOleClassName, hb_parc( - 1 ), iClassNameLen ); + sOleClassName[ iClassNameLen ] = ':'; + strcpy( sOleClassName + iClassNameLen + 1, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); + + //HB_TRACE(HB_TR_INFO, ("Class: '%s'\n", sOleClassName)); + + hb_itemPutCPtr( pOleClassName, sOleClassName, iClassNameLen + 1 + iMsgNameLen ); + + hb_vmPushSymbol( hb_dynsymSymbol( s_pSym_cClassName ) ); + hb_vmPush( pReturn ); + hb_itemPushForward( pOleClassName ); + hb_vmSend( 1 ); + + hb_itemReturnForward( pReturn ); + + hb_itemRelease( pReturn ); + hb_itemRelease( pOleClassName ); + } + } + else + { + // Try to apply the requested message to the DEFAULT Method of the object if any. + if( bTryDefault ) + { + if( SUCCEEDED( ( /* s_nOleError = */ OleGetValue( pDisp ) ) ) ) + { + bTryDefault = FALSE; + + //HB_TRACE(HB_TR_INFO, ("Try using DISPID_VALUE\n")); + pDisp = s_OleVal.n1.n2.n3.pdispVal; + goto OleGetID; + } + } + + //HB_TRACE(HB_TR_INFO, ("Invoke Failed!\n")); + OleThrowError(); + } + + FreeParams( &DispParams, aPrgParams ); + + // We are responsible to release the Default Interface which we retrieved + if( bTryDefault == FALSE && pDisp ) + { + pDisp->lpVtbl->Release( pDisp ); + } +} diff --git a/harbour/contrib/hbw32/w32_regc.c b/harbour/contrib/hbw32/w32_regc.c index 59d2dd7eb8..280d8d79f1 100644 --- a/harbour/contrib/hbw32/w32_regc.c +++ b/harbour/contrib/hbw32/w32_regc.c @@ -93,7 +93,7 @@ HB_FUNC( WIN32_REGCREATEKEYEX ) if( RegCreateKeyEx( hb_regkeyconv( hb_parnl( 1 ) ), ( const char * ) hb_parc( 2 ), - hb_parnl( 3 ), + 0, NULL, hb_parnl( 5 ), hb_parnl( 6 ), @@ -101,10 +101,8 @@ HB_FUNC( WIN32_REGCREATEKEYEX ) &hWnd, &nResult ) == ERROR_SUCCESS ) { - if( ISBYREF( 8 ) ) - hb_stornl( ( ULONG ) hWnd, 8 ); - if( ISBYREF( 9 ) ) - hb_stornl( nResult, 9 ); + hb_stornl( ( ULONG ) hWnd, 8 ); + hb_stornl( nResult, 9 ); hb_retnl( ERROR_SUCCESS ); } @@ -116,11 +114,13 @@ HB_FUNC( WIN32_REGOPENKEYEX ) { HKEY hWnd; - if( RegOpenKeyEx( hb_regkeyconv( hb_parnl( 1 ) ), hb_parc( 2 ), 0, hb_parnl( 4 ), &hWnd ) == ERROR_SUCCESS ) + if( RegOpenKeyEx( hb_regkeyconv( hb_parnl( 1 ) ), + hb_parc( 2 ), + 0, + hb_parnl( 4 ), + &hWnd ) == ERROR_SUCCESS ) { - if( ISBYREF( 5 ) ) - hb_stornl( ( ULONG ) hWnd, 5 ); - + hb_stornl( ( ULONG ) hWnd, 5 ); hb_retnl( ERROR_SUCCESS ); } else @@ -133,20 +133,26 @@ HB_FUNC( WIN32_REGQUERYVALUEEX ) DWORD nType = 0; DWORD nSize = 0; - if( RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, &nType, 0, &nSize ) == ERROR_SUCCESS ) + if( RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), + cKey, + NULL, + &nType, + NULL, + &nSize ) == ERROR_SUCCESS ) { if( nSize > 0 ) { - BYTE * cValue = ( BYTE * ) hb_xgrab( nSize ); + BYTE * cValue = ( BYTE * ) hb_xgrab( nSize + 1 ); - RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, &nType, ( BYTE * ) cValue, &nSize ); + RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), + cKey, + NULL, + &nType, + ( BYTE * ) cValue, + &nSize ); - if( ISBYREF( 4 ) ) - hb_stornl( nType, 4 ); - if( ISBYREF( 5 ) ) - hb_storclen( ( char * ) cValue, nSize, 5 ); - - hb_xfree( cValue ); + hb_stornl( nType, 4 ); + hb_storclen_buffer( ( char * ) cValue, nSize, 5 ); } } @@ -160,13 +166,23 @@ HB_FUNC( WIN32_REGSETVALUEEX ) if( nType != REG_DWORD ) { - BYTE * cValue = ( BYTE *) hb_parc( 5 ); - hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, nType, ( BYTE * ) cValue, hb_parclen( 5 ) + 1 ) ); + BYTE * cValue = ( BYTE * ) hb_parc( 5 ); + hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), + cKey, + 0, + nType, + ( BYTE * ) cValue, + hb_parclen( 5 ) + 1 ) ); } else { DWORD nSpace = hb_parnl( 5 ); - hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, nType, ( BYTE * ) &nSpace, sizeof( REG_DWORD ) ) ); + hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), + cKey, + 0, + nType, + ( BYTE * ) &nSpace, + sizeof( REG_DWORD ) ) ); } } diff --git a/harbour/include/rdd.api b/harbour/include/rdd.api index fddbac76dc..514f3c2e44 100644 --- a/harbour/include/rdd.api +++ b/harbour/include/rdd.api @@ -59,4 +59,11 @@ #include "hbapirdd.h" #include "item.api" +#define _rddInherit hb_rddInherit +#if 0 +#define _rddDisinherit( x ) hb_rddDisinherit( ( const char * ) x ) +#define _rddExtendType hb_rddExtendType +#define _rddFieldType hb_rddFieldType +#endif + #endif /* _RDD_API */