fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2009-04-24 23:15 UTC+0300 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt)

Browse Source 
* harbour/contrib/hbole/olecore.c
  * harbour/contrib/hbole/oleauto.prg
    + implemented FOR EACH enumeration. The code was proposed by 
      Przemyslaw on mailing list. Some fixes applied.
This commit is contained in:
Mindaugas Kavaliauskas
2009-04-24 20:15:07 +00:00
parent 5e9629763e
commit 62dc5dd14f
3 changed files with 182 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
harbour/ChangeLog
View File

@@ -8,6 +8,12 @@
2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-04-24 23:15 UTC+0300 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt)
* harbour/contrib/hbole/olecore.c
* harbour/contrib/hbole/oleauto.prg
+ implemented FOR EACH enumeration. The code was proposed by
Przemyslaw on mailing list. Some fixes applied.
2009-04-24 16:24 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbapi.h
* harbour/source/common/hbprintf.c

50
harbour/contrib/hbole/oleauto.prg
View File

@@ -58,13 +58,57 @@ REQUEST __GETMESSAGE
CLASS HB_OleAuto
DATA __hObj
DATA __hObjEnum
METHOD __enumStart( enum, lDescend )
METHOD __enumSkip( enum, lDescend )
METHOD __enumStop()
ERROR HANDLER __OnError()
ENDCLASS
METHOD __enumStart( enum, lDescend ) CLASS HB_OLEAUTO
LOCAL hObjEnum
IF lDescend
/* OLE does not support backward iteration. Runtime error could be a good choice also */
RETURN .F.
ENDIF
hObjEnum := __OLEENUMCREATE( ::__hObj )
IF !EMPTY( hObjEnum )
IF !EMPTY( ::__hObjEnum )
/* small hack - clone the object array for nested FOR EACH calls */
self := __objClone( self )
ENDIF
::__hObjEnum := hObjEnum
/* set base value for enumerator */
(@enum):__enumBase( self )
RETURN ::__enumSkip( @enum, lDescend )
ENDIF
RETURN .F.
METHOD __enumSkip( enum, lDescend ) CLASS HB_OLEAUTO
LOCAL lContinue, xValue
HB_SYMBOL_UNUSED( lDescend )
xValue := __OLEENUMNEXT( ::__hObjEnum, @lContinue )
/* set enumerator value */
(@enum):__enumValue( xValue )
RETURN lContinue
METHOD PROCEDURE __enumStop() CLASS HB_OLEAUTO
::__hObjEnum := NIL /* activate autodestructor */
RETURN
/* OLE functions */
FUNC GetActiveObject( ... )
LOCAL oOle, hOle
LOCAL oOle, hOle
hOle := OleGetActiveObject( ... )
IF ! EMPTY( hOle )
oOle := HB_OleAuto()
@@ -74,10 +118,12 @@ RETURN oOle
FUNC CreateObject( ... )
LOCAL oOle, hOle
LOCAL oOle, hOle
hOle := OleCreateObject( ... )
IF ! EMPTY( hOle )
oOle := HB_OleAuto()
oOle:__hObj := hOle
ENDIF
RETURN oOle

135
harbour/contrib/hbole/olecore.c
View File

@@ -72,6 +72,7 @@ static HB_TSD_NEW( s_oleData, sizeof( HB_OLEDATA ), NULL, NULL );
HB_FUNC_EXTERN( HB_OLEAUTO );
static void hb_olecore_init( void* cargo )
{
HB_SYMBOL_UNUSED( cargo );
@@ -106,6 +107,22 @@ static HB_GARBAGE_FUNC( hb_ole_destructor )
}
static HB_GARBAGE_FUNC( hb_oleenum_destructor )
{
IEnumVARIANT** ppEnum = ( IEnumVARIANT** ) Cargo;
if( *ppEnum )
{
#if HB_OLE_C_API
( *ppEnum )->lpVtbl->Release( *ppEnum );
#else
( *ppEnum )->Release();
#endif
*ppEnum = NULL;
}
}
static IDispatch* hb_oleParam( int iParam )
{
IDispatch** ppDisp = ( IDispatch** ) hb_parptrGC( hb_ole_destructor, iParam );
@@ -118,6 +135,18 @@ static IDispatch* hb_oleParam( int iParam )
}
static IEnumVARIANT* hb_oleenumParam( int iParam )
{
IEnumVARIANT** ppEnum = ( IEnumVARIANT** ) hb_parptrGC( hb_oleenum_destructor, iParam );
if( ppEnum && *ppEnum )
return *ppEnum;
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
return NULL;
}
/* Unicode string management */
static wchar_t* AnsiToWide( const char* szString )
@@ -228,6 +257,7 @@ void hb_oleVariantToItem( PHB_ITEM pItem, VARIANT* pVariant )
case VT_DISPATCH:
{
hb_itemClear( pItem );
if( pVariant->n1.n2.n3.pdispVal )
{
PHB_ITEM pObject, pPtrGC;
@@ -512,6 +542,97 @@ HB_FUNC( OLERELEASE )
}
HB_FUNC( __OLEENUMCREATE ) /* ( __hObj ) */
{
IDispatch * pDisp = hb_oleParam( 1 );
IEnumVARIANT * pEnum;
VARIANTARG variant;
DISPPARAMS dispparam;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
memset( &excep, 0, sizeof( excep ) );
memset( &dispparam, 0, sizeof( dispparam ) ); /* empty parameters */
VariantInit( &variant );
#if HB_OLE_C_API
lOleError = pDisp->lpVtbl->Invoke( pDisp, DISPID_NEWENUM, &IID_NULL,
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET,
&dispparam, &variant, &excep, &uiArgErr );
#else
lOleError = pDisp->Invoke( DISPID_NEWENUM, IID_NULL,
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET,
&dispparam, &variant, &excep, &uiArgErr );
#endif
if( lOleError == S_OK )
{
if( variant.n1.n2.vt == VT_UNKNOWN )
#if HB_OLE_C_API
lOleError = ( variant.n1.n2.n3.punkVal )->lpVtbl->QueryInterface( variant.n1.n2.n3.punkVal,
&IID_IEnumVARIANT, ( void** ) &pEnum );
#else
lOleError = ( variant.n1.n2.n3.punkVal )->QueryInterface( variant.n1.n2.n3.punkVal,
IID_IEnumVARIANT, ( void** ) &pEnum );
#endif
else if( variant.n1.n2.vt == VT_DISPATCH )
#if HB_OLE_C_API
lOleError = ( variant.n1.n2.n3.pdispVal )->lpVtbl->QueryInterface( variant.n1.n2.n3.pdispVal,
&IID_IEnumVARIANT, ( void** ) &pEnum );
#else
lOleError = ( variant.n1.n2.pdispVal )->QueryInterface( variant.n1.n2.n3.pdispVal,
IID_IEnumVARIANT, ( void** ) &pEnum );
#endif
else
{
lOleError = -1; /* Invalid return value */
}
VariantClear( &variant );
if( lOleError == S_OK )
{
IEnumVARIANT** ppEnum;
hb_setOleError( S_OK );
ppEnum = ( IEnumVARIANT** ) hb_gcAlloc( sizeof( IEnumVARIANT* ), hb_oleenum_destructor );
*ppEnum = pEnum;
hb_retptrGC( ppEnum );
return;
}
}
hb_setOleError( lOleError );
hb_ret();
}
HB_FUNC( __OLEENUMNEXT )
{
IEnumVARIANT * pEnum = hb_oleenumParam( 1 );
VARIANTARG variant;
VariantInit( &variant );
#if HB_OLE_C_API
if( pEnum->lpVtbl->Next( pEnum, 1, &variant, NULL ) == S_OK )
#else
if( pEnum->Next( pEnum, 1, &variant, NULL ) == S_OK )
#endif
{
hb_oleVariantToItem( hb_stackReturnItem(), &variant );
if( variant.n1.n2.vt != VT_DISPATCH )
VariantClear( &variant );
hb_storl( TRUE, 2 );
}
else
hb_storl( FALSE, 2 );
}
HB_FUNC( OLEERROR )
{
hb_retnl( hb_getOleError() );
@@ -555,7 +676,7 @@ HB_FUNC( HB_OLEAUTO___ONERROR )
OLECHAR* pMemberArray;
DISPID dispid;
DISPPARAMS dispparam;
VARIANTARG RetVal;
VARIANTARG variant;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
@@ -628,25 +749,25 @@ HB_FUNC( HB_OLEAUTO___ONERROR )
if( lOleError == S_OK )
{
memset( &excep, 0, sizeof( excep ) );
VariantInit( &RetVal );
VariantInit( &variant );
GetParams( &dispparam );
#if HB_OLE_C_API
lOleError = pDisp->lpVtbl->Invoke( pDisp, dispid, &IID_NULL,
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET | DISPATCH_METHOD,
&dispparam, &RetVal, &excep, &uiArgErr );
&dispparam, &variant, &excep, &uiArgErr );
#else
lOleError = pDisp->Invoke( dispid, IID_NULL,
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET | DISPATCH_METHOD,
&dispparam, &RetVal, &excep, &uiArgErr );
&dispparam, &variant, &excep, &uiArgErr );
#endif
FreeParams( &dispparam );
hb_oleVariantToItem( hb_stackReturnItem(), &RetVal );
if( RetVal.n1.n2.vt != VT_DISPATCH )
VariantClear( &RetVal );
hb_oleVariantToItem( hb_stackReturnItem(), &variant );
if( variant.n1.n2.vt != VT_DISPATCH )
VariantClear( &variant );
hb_setOleError( lOleError );
return;