Files
harbour-core/harbour/contrib/hbwin/olecore.c
Przemyslaw Czerpak 73a06f6c8f 2010-06-15 12:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbdefs.h
  * harbour/include/hbvmpub.h
  * harbour/src/common/expropt1.c
  * harbour/src/common/expropt2.c
  * harbour/src/common/hbstr.c
  * harbour/src/compiler/gencc.c
  * harbour/src/vm/hvm.c
  * harbour/src/vm/itemapi.c
  * harbour/src/vm/task.c
  * harbour/src/rtl/abs.c
  * harbour/src/rtl/hbdyn.c
  * harbour/src/rdd/dbsql.c
  * harbour/contrib/hbwin/olecore.c
  * harbour/contrib/sddoci/sddoci.c
  * harbour/contrib/sddsqlt3/sddsqlt3.c
    * renamed HB_LONG_{MIN,MAX} to HB_VMLONG_{MIN,MAX} and
      HB_INT_{MIN,MAX} to HB_VMINT_{MIN,MAX} to not confuse users
      after renaming HB_LONG to HB_MAXINT and LONG to HB_LONG.
      They could expect that HB_LONG_{MIN,MAX} are for HB_LONG type.
2010-06-15 10:00:45 +00:00

1579 lines
46 KiB
C

/*
* $Id$
*/
/*
* Harbour Project source code:
* OLE library
*
* Copyright 2000, 2003 Jose F. Gimenez (JFG) <jfgimenez@wanadoo.es>
* Copyright 2008, 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbwinole.h"
#include "hbinit.h"
/* enable workaround for wrong OLE variant structure definition */
#if ( defined( __POCC__ ) && defined( HB_OS_WIN_CE ) ) || \
defined( __DMC__ ) || \
( defined( _MSC_VER ) && ( _MSC_VER <= 1500 ) )
# define HB_OLE_NO_LL
#endif
#if ( defined( __POCC__ ) && defined( HB_OS_WIN_CE ) ) || \
( defined( __WATCOMC__ ) && ( __WATCOMC__ < 1280 ) ) || \
defined( __MINGW32__ ) || \
defined( __DMC__ ) || \
( defined( _MSC_VER ) && ( _MSC_VER <= 1500 ) )
# define HB_OLE_NO_LLREF
#endif
/* base date value in OLE (1899-12-30) as julian day */
#define HB_OLE_DATE_BASE 0x0024D9AB
static PHB_DYNS s_pDyns_hb_oleauto;
static PHB_DYNS s_pDyns_hObjAccess;
static PHB_DYNS s_pDyns_hObjAssign;
typedef struct
{
IDispatch* pDisp;
PHB_ITEM* pCallBack;
} HB_OLE;
typedef struct
{
HRESULT lOleError;
} HB_OLEDATA, * PHB_OLEDATA;
static HB_TSD_NEW( s_oleData, sizeof( HB_OLEDATA ), NULL, NULL );
#define hb_getOleData() ( ( PHB_OLEDATA ) hb_stackGetTSD( &s_oleData ) )
HB_FUNC_EXTERN( WIN_OLEAUTO );
void hb_oleSetError( HRESULT lOleError )
{
hb_getOleData()->lOleError = lOleError;
}
HRESULT hb_oleGetError( void )
{
return hb_getOleData()->lOleError;
}
static void hb_olecore_init( void* cargo )
{
HB_SYMBOL_UNUSED( cargo );
s_pDyns_hb_oleauto = hb_dynsymGetCase( "WIN_OLEAUTO" );
s_pDyns_hObjAccess = hb_dynsymGetCase( "__HOBJ" );
s_pDyns_hObjAssign = hb_dynsymGetCase( "___HOBJ" );
if( s_pDyns_hObjAccess == s_pDyns_hObjAssign )
{
/* Never executed. Just force linkage */
HB_FUNC_EXEC( WIN_OLEAUTO );
}
hb_oleInit();
}
static HB_GARBAGE_FUNC( hb_ole_destructor )
{
HB_OLE * pOle = ( HB_OLE * ) Cargo;
IDispatch * pDisp = pOle->pDisp;
if( pDisp )
{
pOle->pDisp = NULL;
if( pOle->pCallBack && *pOle->pCallBack )
{
PHB_ITEM pCallBack = *pOle->pCallBack;
*pOle->pCallBack = NULL;
pOle->pCallBack = NULL;
hb_itemRelease( pCallBack );
}
HB_VTBL( pDisp )->Release( HB_THIS( pDisp ) );
}
}
static HB_GARBAGE_FUNC( hb_ole_mark )
{
HB_OLE * pOle = ( HB_OLE * ) Cargo;
if( pOle->pCallBack && *pOle->pCallBack )
hb_gcMark( *pOle->pCallBack );
}
static const HB_GC_FUNCS s_gcOleFuncs =
{
hb_ole_destructor,
hb_ole_mark
};
static HB_GARBAGE_FUNC( hb_oleenum_destructor )
{
IEnumVARIANT** ppEnum = ( IEnumVARIANT** ) Cargo;
IEnumVARIANT* pEnum = *ppEnum;
if( pEnum )
{
*ppEnum = NULL;
HB_VTBL( pEnum )->Release( HB_THIS( pEnum ) );
}
}
static const HB_GC_FUNCS s_gcOleenumFuncs =
{
hb_oleenum_destructor,
hb_gcDummyMark
};
static void hb_errRT_OLE( HB_ERRCODE errGenCode, HB_ERRCODE errSubCode, HB_ERRCODE errOsCode, const char * szDescription, const char * szOperation )
{
PHB_ITEM pError;
pError = hb_errRT_New( ES_ERROR, "WINOLE", errGenCode, errSubCode, szDescription, szOperation, errOsCode, EF_NONE );
if( hb_pcount() != 0 )
{
/* HB_ERR_ARGS_BASEPARAMS */
PHB_ITEM pArray = hb_arrayBaseParams();
hb_errPutArgsArray( pError, pArray );
hb_itemRelease( pArray );
}
hb_errLaunch( pError );
hb_errRelease( pError );
}
IDispatch* hb_oleParam( int iParam )
{
HB_OLE * pOle = ( HB_OLE * ) hb_parptrGC( &s_gcOleFuncs, iParam );
if( pOle && pOle->pDisp )
return pOle->pDisp;
hb_errRT_OLE( EG_ARG, 1001, 0, NULL, HB_ERR_FUNCNAME );
return NULL;
}
IDispatch* hb_oleItemGet( PHB_ITEM pItem )
{
HB_OLE * pOle = ( HB_OLE * ) hb_itemGetPtrGC( pItem, &s_gcOleFuncs );
return pOle ? pOle->pDisp : NULL;
}
PHB_ITEM hb_oleItemPut( PHB_ITEM pItem, IDispatch* pDisp )
{
HB_OLE * pOle = ( HB_OLE * ) hb_gcAllocate( sizeof( HB_OLE ), &s_gcOleFuncs );
pOle->pDisp = pDisp;
pOle->pCallBack = NULL;
return hb_itemPutPtrGC( pItem, pOle );
}
PHB_ITEM hb_oleItemGetCallBack( PHB_ITEM pItem )
{
HB_OLE * pOle = ( HB_OLE * ) hb_itemGetPtrGC( pItem, &s_gcOleFuncs );
return pOle && pOle->pCallBack ? *pOle->pCallBack : NULL;
}
void hb_oleItemSetCallBack( PHB_ITEM pItem, PHB_ITEM* pCallBack )
{
HB_OLE * pOle = ( HB_OLE * ) hb_itemGetPtrGC( pItem, &s_gcOleFuncs );
if( pOle )
{
if( pOle->pCallBack && *pOle->pCallBack )
{
PHB_ITEM pCallBack = *pOle->pCallBack;
*pOle->pCallBack = NULL;
pOle->pCallBack = NULL;
hb_itemRelease( pCallBack );
}
if( pCallBack )
{
pOle->pCallBack = pCallBack;
hb_gcUnlock( *pCallBack );
}
}
}
static IEnumVARIANT* hb_oleenumParam( int iParam )
{
IEnumVARIANT** ppEnum = ( IEnumVARIANT** ) hb_parptrGC( &s_gcOleenumFuncs, iParam );
if( ppEnum && *ppEnum )
return *ppEnum;
hb_errRT_OLE( EG_ARG, 1002, 0, NULL, HB_ERR_FUNCNAME );
return NULL;
}
/* Unicode string management */
static wchar_t* AnsiToWide( const char* szString )
{
int iLen;
wchar_t* szWide;
iLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, szString, -1, NULL, 0 );
szWide = ( wchar_t* ) hb_xgrab( iLen * sizeof( wchar_t ) );
MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, szString, -1, szWide, iLen );
return szWide;
}
static void AnsiToWideBuffer( const char* szString, wchar_t* szWide, int iLen )
{
MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, szString, -1, szWide, iLen );
szWide[ iLen - 1 ] = '0';
}
static BSTR hb_oleItemToString( PHB_ITEM pItem )
{
const char* szString;
BSTR strVal;
int iLen, iStrLen;
szString = hb_itemGetCPtr( pItem );
iLen = ( int ) hb_itemGetCLen( pItem );
iStrLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, szString, iLen, NULL, 0 );
strVal = SysAllocStringLen( NULL, iStrLen );
MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, szString, iLen, strVal, iStrLen + 1 );
return strVal;
}
static void hb_oleStringToItem( BSTR strVal, PHB_ITEM pItem )
{
char* szString;
int iLen, iStrLen;
iStrLen = ( int ) SysStringLen( strVal );
iLen = WideCharToMultiByte( CP_ACP, 0, strVal, iStrLen, NULL, 0, NULL, NULL );
szString = ( char* ) hb_xgrab( ( iLen + 1 ) * sizeof( char ) );
WideCharToMultiByte( CP_ACP, 0, strVal, iStrLen, szString, iLen + 1, NULL, NULL );
hb_itemPutCLPtr( pItem, szString, iLen );
}
static IDispatch * hb_oleItemGetDispatch( PHB_ITEM pItem )
{
if( HB_IS_OBJECT( pItem ) )
{
if( hb_clsIsParent( hb_objGetClass( pItem ), "WIN_OLEAUTO" ) )
{
hb_vmPushDynSym( s_pDyns_hObjAccess );
hb_vmPush( pItem );
hb_vmSend( 0 );
return hb_oleParam( -1 );
}
}
return hb_oleItemGet( pItem );
}
static void hb_oleDispatchToVariant( VARIANT* pVariant, IDispatch* pDisp,
VARIANT* pVarRef )
{
/* pVariant will be freed using VariantClear().
We increment reference count to keep OLE object alive */
HB_VTBL( pDisp )->AddRef( HB_THIS( pDisp ) );
pVariant->n1.n2.vt = VT_DISPATCH;
pVariant->n1.n2.n3.pdispVal = pDisp;
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_DISPATCH | VT_BYREF;
pVarRef->n1.n2.n3.ppdispVal = &pVariant->n1.n2.n3.pdispVal;
}
}
/* Item <-> Variant conversion */
static void hb_oleItemToVariantRef( VARIANT* pVariant, PHB_ITEM pItem,
VARIANT* pVarRef, HB_OLEOBJ_FUNC pObjFunc )
{
VariantClear( pVariant ); /* pVariant->n1.n2.vt = VT_EMPTY; */
switch( hb_itemType( pItem ) )
{
case HB_IT_STRING:
case HB_IT_MEMO:
pVariant->n1.n2.vt = VT_BSTR;
pVariant->n1.n2.n3.bstrVal = hb_oleItemToString( pItem );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_BSTR | VT_BYREF;
pVarRef->n1.n2.n3.pbstrVal = &pVariant->n1.n2.n3.bstrVal;
}
break;
case HB_IT_LOGICAL:
pVariant->n1.n2.vt = VT_BOOL;
pVariant->n1.n2.n3.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE;
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_BOOL | VT_BYREF;
pVarRef->n1.n2.n3.pboolVal = &pVariant->n1.n2.n3.boolVal;
}
break;
case HB_IT_INTEGER:
pVariant->n1.n2.vt = VT_I4;
pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_I4 | VT_BYREF;
pVarRef->n1.n2.n3.plVal = &pVariant->n1.n2.n3.lVal;
}
break;
case HB_IT_LONG:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
pVariant->n1.n2.vt = VT_I4;
pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_I4 | VT_BYREF;
pVarRef->n1.n2.n3.plVal = &pVariant->n1.n2.n3.lVal;
}
#else
pVariant->n1.n2.vt = VT_I8;
# if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
* ( ( HB_LONGLONG * ) &pVariant->n1.n2.n3.lVal ) = hb_itemGetNInt( pItem );
# else
pVariant->n1.n2.n3.llVal = hb_itemGetNInt( pItem );
# endif
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_I8 | VT_BYREF;
# if defined( HB_OLE_NO_LLREF ) || defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
pVarRef->n1.n2.n3.pdblVal = &pVariant->n1.n2.n3.dblVal;
# else
pVarRef->n1.n2.n3.pllVal = &pVariant->n1.n2.n3.llVal;
# endif
}
#endif
break;
case HB_IT_DOUBLE:
pVariant->n1.n2.vt = VT_R8;
pVariant->n1.n2.n3.dblVal = hb_itemGetND( pItem );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_R8 | VT_BYREF;
pVarRef->n1.n2.n3.pdblVal = &pVariant->n1.n2.n3.dblVal;
}
break;
case HB_IT_DATE:
pVariant->n1.n2.vt = VT_DATE;
pVariant->n1.n2.n3.dblVal = ( double ) ( hb_itemGetDL( pItem ) - HB_OLE_DATE_BASE );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_DATE | VT_BYREF;
pVarRef->n1.n2.n3.pdblVal = &pVariant->n1.n2.n3.dblVal;
}
break;
case HB_IT_TIMESTAMP:
pVariant->n1.n2.vt = VT_DATE;
pVariant->n1.n2.n3.dblVal = hb_itemGetTD( pItem ) - HB_OLE_DATE_BASE;
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_DATE | VT_BYREF;
pVarRef->n1.n2.n3.pdblVal = &pVariant->n1.n2.n3.dblVal;
}
break;
case HB_IT_POINTER:
{
IDispatch * pDisp = hb_oleItemGet( pItem );
if( pDisp )
hb_oleDispatchToVariant( pVariant, pDisp, pVarRef );
#ifdef HB_OLE_PASS_POINTERS
else
{
pVariant->n1.n2.vt = VT_PTR;
pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem );
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_PTR | VT_BYREF;
pVarRef->n1.n2.n3.byref = &pVariant->n1.n2.n3.byref;
}
}
#endif
break;
}
case HB_IT_ARRAY: /* or OBJECT */
if( HB_IS_OBJECT( pItem ) )
{
IDispatch * pDisp = hb_oleItemGetDispatch( pItem );
if( pDisp )
hb_oleDispatchToVariant( pVariant, pDisp, pVarRef );
else if( pObjFunc )
pObjFunc( pVariant, pItem );
}
else
{
SAFEARRAY* pSafeArray;
SAFEARRAYBOUND sabound[ 1 ];
HB_SIZE ul, ulLen;
ulLen = hb_arrayLen( pItem );
sabound[ 0 ].lLbound = 0;
sabound[ 0 ].cElements = ( long ) ulLen;
pSafeArray = SafeArrayCreate( VT_VARIANT, 1, sabound );
pVariant->n1.n2.vt = VT_VARIANT | VT_ARRAY;
pVariant->n1.n2.n3.parray = pSafeArray;
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_VARIANT | VT_ARRAY | VT_BYREF;
pVarRef->n1.n2.n3.pparray = &pVariant->n1.n2.n3.parray;
}
for( ul = 0; ul < ulLen; ul++ )
{
VARIANT vItem;
long lIndex[ 1 ];
VariantInit( &vItem );
hb_oleItemToVariantRef( &vItem, hb_arrayGetItemPtr( pItem, ul + 1 ), NULL, pObjFunc );
lIndex[ 0 ] = ( long ) ul;
SafeArrayPutElement( pSafeArray, lIndex, &vItem );
VariantClear( &vItem );
}
}
break;
default:
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_VARIANT | VT_BYREF;
pVarRef->n1.n2.n3.pvarVal = pVariant;
}
}
/* enabling this code may allow to exchange parameters by reference
* without strong typing restrictions but I do not know if such method
* is honored by other OLE code
*/
#if 0
if( pVarRef )
{
pVarRef->n1.n2.vt = VT_VARIANT | VT_BYREF;
pVarRef->n1.n2.n3.pvarVal = pVariant;
}
#endif
}
void hb_oleItemToVariant( VARIANT* pVariant, PHB_ITEM pItem )
{
hb_oleItemToVariantRef( pVariant, pItem, NULL, NULL );
}
void hb_oleItemToVariantEx( VARIANT* pVariant, PHB_ITEM pItem,
HB_OLEOBJ_FUNC pObjFunc )
{
hb_oleItemToVariantRef( pVariant, pItem, NULL, pObjFunc );
}
static void hb_oleSafeArrayToItem( PHB_ITEM pItem, SAFEARRAY * pSafeArray,
int iDim, long * plIndex, VARTYPE vt )
{
long lFrom, lTo;
SafeArrayGetLBound( pSafeArray, iDim, &lFrom );
SafeArrayGetUBound( pSafeArray, iDim, &lTo );
if( lFrom <= lTo )
{
HB_SIZE ul = 0;
hb_arrayNew( pItem, lTo - lFrom + 1 );
if( --iDim == 0 )
{
VARIANT vItem;
VariantInit( &vItem );
do
{
plIndex[ iDim ] = lFrom;
/* hack: for non VT_VARIANT arrays create VARIANT dynamically
* using pointer to union in variant structure which
* holds all variant values except VT_DECIMAL which is
* stored in different place.
*/
if( SafeArrayGetElement( pSafeArray, plIndex,
vt == VT_VARIANT ? ( void * ) &vItem :
( vt == VT_DECIMAL ? ( void * ) &vItem.n1.decVal :
( void * ) &vItem.n1.n2.n3 ) ) == S_OK )
{
if( vt != VT_VARIANT )
vItem.n1.n2.vt = vt; /* it's reserved in VT_DECIMAL structure */
hb_oleVariantToItem( hb_arrayGetItemPtr( pItem, ++ul ), &vItem );
VariantClear( &vItem );
}
}
while( ++lFrom <= lTo );
}
else
{
do
{
plIndex[ iDim ] = lFrom;
hb_oleSafeArrayToItem( hb_arrayGetItemPtr( pItem, ++ul ),
pSafeArray, iDim, plIndex, vt );
}
while( ++lFrom <= lTo );
}
}
else
hb_arrayNew( pItem, 0 );
}
static void hb_oleDispatchToItem( PHB_ITEM pItem, IDispatch* pdispVal )
{
if( pdispVal )
{
if( hb_vmRequestReenter() )
{
PHB_ITEM pObject, pPtrGC;
hb_vmPushDynSym( s_pDyns_hb_oleauto );
hb_vmPushNil();
hb_vmDo( 0 );
pObject = hb_itemNew( hb_stackReturnItem() );
pPtrGC = hb_oleItemPut( NULL, pdispVal );
/* Item is one more copy of the object */
HB_VTBL( pdispVal )->AddRef( HB_THIS( pdispVal ) );
hb_vmPushDynSym( s_pDyns_hObjAssign );
hb_vmPush( pObject );
hb_vmPush( pPtrGC );
hb_vmSend( 1 );
hb_itemRelease( pPtrGC );
hb_vmRequestRestore();
/* We should store object to pItem after hb_vmRequestRestore(),
* because pItem actualy can be stack's return item!
*/
hb_itemMove( pItem, pObject );
hb_itemRelease( pObject );
}
}
}
void hb_oleVariantToItem( PHB_ITEM pItem, VARIANT* pVariant )
{
if( pVariant->n1.n2.vt == ( VT_VARIANT | VT_BYREF ) )
pVariant = pVariant->n1.n2.n3.pvarVal;
switch( pVariant->n1.n2.vt )
{
case VT_UNKNOWN:
case VT_UNKNOWN | VT_BYREF:
{
IDispatch* pdispVal = NULL;
IUnknown* punkVal = pVariant->n1.n2.vt == VT_UNKNOWN ?
pVariant->n1.n2.n3.punkVal :
*pVariant->n1.n2.n3.ppunkVal;
hb_itemClear( pItem );
if( punkVal && HB_VTBL( punkVal )->QueryInterface(
HB_THIS_( punkVal ) HB_ID_REF( IID_IDispatch ),
( void** ) ( void * ) &pdispVal ) == S_OK )
{
hb_oleDispatchToItem( pItem, pdispVal );
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
break;
}
case VT_DISPATCH:
case VT_DISPATCH | VT_BYREF:
hb_itemClear( pItem );
hb_oleDispatchToItem( pItem, pVariant->n1.n2.vt == VT_DISPATCH ?
pVariant->n1.n2.n3.pdispVal :
*pVariant->n1.n2.n3.ppdispVal );
break;
case VT_BSTR:
hb_oleStringToItem( pVariant->n1.n2.n3.bstrVal, pItem );
break;
case VT_BSTR | VT_BYREF:
hb_oleStringToItem( *pVariant->n1.n2.n3.pbstrVal, pItem );
break;
case VT_BOOL:
hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal ? HB_TRUE : HB_FALSE );
break;
case VT_BOOL | VT_BYREF:
hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal ? HB_TRUE : HB_FALSE );
break;
case VT_I1:
hb_itemPutNI( pItem, ( signed char ) pVariant->n1.n2.n3.cVal );
break;
case VT_I1 | VT_BYREF:
hb_itemPutNI( pItem, ( signed char ) *pVariant->n1.n2.n3.pcVal );
break;
case VT_I2:
hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.iVal );
break;
case VT_I2 | VT_BYREF:
hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.piVal );
break;
case VT_I4:
hb_itemPutNL( pItem, pVariant->n1.n2.n3.lVal );
break;
case VT_I4 | VT_BYREF:
hb_itemPutNL( pItem, *pVariant->n1.n2.n3.plVal );
break;
case VT_I8:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) pVariant->n1.n2.n3.lVal );
#elif defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, * ( ( HB_LONGLONG * ) &pVariant->n1.n2.n3.lVal ) );
#else
hb_itemPutNInt( pItem, pVariant->n1.n2.n3.llVal );
#endif
break;
case VT_I8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) *pVariant->n1.n2.n3.plVal );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, * ( HB_LONGLONG * ) pVariant->n1.n2.n3.pdblVal );
#else
hb_itemPutNInt( pItem, *pVariant->n1.n2.n3.pllVal );
#endif
break;
case VT_UI1:
hb_itemPutNI( pItem, ( unsigned char ) pVariant->n1.n2.n3.bVal );
break;
case VT_UI1 | VT_BYREF:
hb_itemPutNI( pItem, ( unsigned char ) *pVariant->n1.n2.n3.pbVal );
break;
case VT_UI2:
hb_itemPutNI( pItem, ( unsigned short ) pVariant->n1.n2.n3.uiVal );
break;
case VT_UI2 | VT_BYREF:
hb_itemPutNI( pItem, ( unsigned short ) *pVariant->n1.n2.n3.puiVal );
break;
case VT_UI4:
hb_itemPutNInt( pItem, pVariant->n1.n2.n3.ulVal );
break;
case VT_UI4 | VT_BYREF:
hb_itemPutNInt( pItem, *pVariant->n1.n2.n3.pulVal );
break;
case VT_UI8:
/* TODO: sign is lost. Convertion to double will lose significant digits. */
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) pVariant->n1.n2.n3.ulVal );
#elif defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, * ( ( HB_LONGLONG * ) &pVariant->n1.n2.n3.ulVal ) );
#else
hb_itemPutNInt( pItem, ( HB_MAXINT ) pVariant->n1.n2.n3.ullVal );
#endif
break;
case VT_UI8 | VT_BYREF:
/* TODO: sign is lost. Convertion to double will lose significant digits. */
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) *pVariant->n1.n2.n3.pulVal );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, * ( HB_LONGLONG * ) pVariant->n1.n2.n3.pdblVal );
#else
hb_itemPutNInt( pItem, ( HB_MAXINT ) *pVariant->n1.n2.n3.pullVal );
#endif
break;
case VT_INT:
hb_itemPutNI( pItem, pVariant->n1.n2.n3.intVal );
break;
case VT_INT | VT_BYREF:
hb_itemPutNI( pItem, *pVariant->n1.n2.n3.pintVal );
break;
case VT_UINT:
hb_itemPutNInt( pItem, pVariant->n1.n2.n3.uintVal );
break;
case VT_UINT | VT_BYREF:
hb_itemPutNInt( pItem, *pVariant->n1.n2.n3.puintVal );
break;
case VT_ERROR:
hb_itemPutNInt( pItem, pVariant->n1.n2.n3.scode );
break;
case VT_ERROR | VT_BYREF:
hb_itemPutNInt( pItem, *pVariant->n1.n2.n3.pscode );
break;
case VT_R4:
hb_itemPutND( pItem, ( double ) pVariant->n1.n2.n3.fltVal );
break;
case VT_R4 | VT_BYREF:
hb_itemPutND( pItem, ( double ) *pVariant->n1.n2.n3.pfltVal );
break;
case VT_R8:
hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal );
break;
case VT_R8 | VT_BYREF:
hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal );
break;
case VT_CY:
case VT_CY | VT_BYREF:
{
double dblVal;
VarR8FromCy( pVariant->n1.n2.vt == VT_CY ?
pVariant->n1.n2.n3.cyVal :
*pVariant->n1.n2.n3.pcyVal, &dblVal );
hb_itemPutND( pItem, dblVal );
/* hb_itemPutNDLen( pItem, dblVal, 0, 4 ); */
break;
}
case VT_DECIMAL:
case VT_DECIMAL | VT_BYREF:
{
double dblVal;
VarR8FromDec( pVariant->n1.n2.vt == VT_DECIMAL ?
&pVariant->n1.decVal :
pVariant->n1.n2.n3.pdecVal, &dblVal );
hb_itemPutND( pItem, dblVal );
break;
}
case VT_DATE:
case VT_DATE | VT_BYREF:
{
long lJulian, lMilliSec;
double dblVal = pVariant->n1.n2.vt == VT_DATE ?
pVariant->n1.n2.n3.dblVal :
*pVariant->n1.n2.n3.pdblVal;
hb_timeStampUnpackDT( dblVal + HB_OLE_DATE_BASE, &lJulian, &lMilliSec );
if( lMilliSec )
hb_itemPutTDT( pItem, lJulian, lMilliSec );
else
hb_itemPutDL( pItem, lJulian );
break;
}
#ifdef HB_OLE_PASS_POINTERS
case VT_PTR:
case VT_PTR | VT_BYREF:
case VT_BYREF:
hb_itemPutPtr( pItem, pVariant->n1.n2.n3.byref );
break;
#endif
case VT_EMPTY:
case VT_EMPTY | VT_BYREF:
case VT_NULL:
case VT_NULL | VT_BYREF:
hb_itemClear( pItem );
break;
default:
if( pVariant->n1.n2.vt & VT_ARRAY )
{
SAFEARRAY * pSafeArray = pVariant->n1.n2.vt & VT_BYREF ?
*pVariant->n1.n2.n3.pparray :
pVariant->n1.n2.n3.parray;
if( pSafeArray )
{
int iDim;
if( ( iDim = ( int ) SafeArrayGetDim( pSafeArray ) ) >= 1 )
{
long * plIndex = ( long * ) hb_xgrab( iDim * sizeof( long ) );
hb_oleSafeArrayToItem( pItem, pSafeArray, iDim, plIndex,
( pVariant->n1.n2.vt & ~( VT_ARRAY | VT_BYREF ) ) );
hb_xfree( plIndex );
}
else
hb_arrayNew( pItem, 0 );
break;
}
}
/* possible RT error - unsupported variant */
hb_itemClear( pItem );
}
}
void hb_oleVariantUpdate( VARIANT* pVariant, PHB_ITEM pItem,
HB_OLEOBJ_FUNC pObjFunc )
{
switch( pVariant->n1.n2.vt )
{
case VT_DISPATCH | VT_BYREF:
{
IDispatch * pDisp = hb_oleItemGetDispatch( pItem );
if( pDisp )
{
IDispatch* pdispVal = *pVariant->n1.n2.n3.ppdispVal;
if( pdispVal != pDisp )
{
HB_VTBL( pDisp )->AddRef( HB_THIS( pDisp ) );
*pVariant->n1.n2.n3.ppdispVal = pDisp;
if( pdispVal )
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
}
else if( pObjFunc && HB_IS_OBJECT( pItem ) )
{
VARIANTARG variant;
VariantInit( &variant );
if( pObjFunc( &variant, pItem ) )
{
IDispatch* pdispVal = *pVariant->n1.n2.n3.ppdispVal;
*pVariant->n1.n2.n3.ppdispVal = variant.n1.n2.n3.pdispVal;
if( pdispVal )
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
}
break;
}
case VT_UNKNOWN | VT_BYREF:
{
IDispatch* pDisp = hb_oleItemGetDispatch( pItem );
if( pDisp )
{
IUnknown* pUnk = NULL;
if( HB_VTBL( pDisp )->QueryInterface( HB_THIS_( pDisp )
HB_ID_REF( IID_IEnumVARIANT ),
( void** ) ( void * ) &pUnk ) == S_OK )
{
IUnknown* punkVal = *pVariant->n1.n2.n3.ppunkVal;
if( punkVal != pUnk )
{
HB_VTBL( pUnk )->AddRef( HB_THIS( pUnk ) );
*pVariant->n1.n2.n3.ppunkVal = pUnk;
if( punkVal )
HB_VTBL( punkVal )->Release( HB_THIS( punkVal ) );
}
}
}
else if( pObjFunc && HB_IS_OBJECT( pItem ) )
{
VARIANTARG variant;
VariantInit( &variant );
if( pObjFunc( &variant, pItem ) )
{
IDispatch* pdispVal = *pVariant->n1.n2.n3.ppdispVal;
*pVariant->n1.n2.n3.ppdispVal = variant.n1.n2.n3.pdispVal;
if( pdispVal )
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
}
break;
}
case VT_BSTR | VT_BYREF:
SysFreeString( *pVariant->n1.n2.n3.pbstrVal );
*pVariant->n1.n2.n3.pbstrVal = hb_oleItemToString( pItem );
break;
case VT_BOOL | VT_BYREF:
*pVariant->n1.n2.n3.pboolVal = ( VARIANT_BOOL ) hb_itemGetL( pItem );
break;
case VT_I1 | VT_BYREF:
*pVariant->n1.n2.n3.pcVal = ( signed char ) hb_itemGetNI( pItem );
break;
case VT_I2 | VT_BYREF:
*pVariant->n1.n2.n3.piVal = ( short ) hb_itemGetNI( pItem );
break;
case VT_I4 | VT_BYREF:
*pVariant->n1.n2.n3.plVal = hb_itemGetNL( pItem );
break;
case VT_I8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
*pVariant->n1.n2.n3.plVal = ( long ) hb_itemGetNInt( pItem );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
* ( HB_LONGLONG * ) pVariant->n1.n2.n3.pdblVal = ( HB_LONGLONG ) hb_itemGetNInt( pItem );
#else
*pVariant->n1.n2.n3.pllVal = ( HB_LONGLONG ) hb_itemGetNInt( pItem );
#endif
break;
case VT_UI1 | VT_BYREF:
*pVariant->n1.n2.n3.pbVal = ( unsigned char ) hb_itemGetNI( pItem );
break;
case VT_UI2 | VT_BYREF:
*pVariant->n1.n2.n3.puiVal = ( unsigned short ) hb_itemGetNI( pItem );
break;
case VT_UI4 | VT_BYREF:
*pVariant->n1.n2.n3.pulVal = ( unsigned long ) hb_itemGetNL( pItem );
break;
case VT_UI8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
*pVariant->n1.n2.n3.pulVal = ( unsigned long ) hb_itemGetNInt( pItem );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
* ( HB_ULONGLONG * ) pVariant->n1.n2.n3.pdblVal = ( HB_ULONGLONG ) hb_itemGetNInt( pItem );
#else
*pVariant->n1.n2.n3.pullVal = ( HB_ULONGLONG ) hb_itemGetNInt( pItem );
#endif
break;
case VT_INT | VT_BYREF:
*pVariant->n1.n2.n3.pintVal = hb_itemGetNI( pItem );
break;
case VT_UINT | VT_BYREF:
*pVariant->n1.n2.n3.puintVal = ( unsigned int ) hb_itemGetNI( pItem );
break;
case VT_ERROR | VT_BYREF:
*pVariant->n1.n2.n3.pscode = ( SCODE ) hb_itemGetNL( pItem );
break;
case VT_R4 | VT_BYREF:
*pVariant->n1.n2.n3.pfltVal = ( float ) hb_itemGetND( pItem );
break;
case VT_R8 | VT_BYREF:
*pVariant->n1.n2.n3.pdblVal = hb_itemGetND( pItem );
break;
case VT_CY | VT_BYREF:
VarCyFromR8( hb_itemGetND( pItem ), pVariant->n1.n2.n3.pcyVal );
break;
case VT_DECIMAL | VT_BYREF:
VarDecFromR8( hb_itemGetND( pItem ), pVariant->n1.n2.n3.pdecVal );
break;
case VT_DATE | VT_BYREF:
*pVariant->n1.n2.n3.pdblVal = hb_itemGetTD( pItem ) - HB_OLE_DATE_BASE;
break;
#ifdef HB_OLE_PASS_POINTERS
case VT_PTR | VT_BYREF:
pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem );
break;
#endif
case VT_BYREF | VT_VARIANT:
hb_oleItemToVariantRef( pVariant->n1.n2.n3.pvarVal, pItem, NULL, pObjFunc );
break;
case VT_VARIANT | VT_ARRAY | VT_BYREF:
/* TODO: */
break;
}
}
/* Invoke IDispatch method */
typedef struct
{
PHB_ITEM item;
VARIANT* variant;
}
HB_OLE_PARAM_REF;
HB_BOOL hb_oleDispInvoke( PHB_SYMB pSym, PHB_ITEM pObject, PHB_ITEM pParam,
DISPPARAMS* pParams, VARIANT* pVarResult,
HB_OLEOBJ_FUNC pObjFunc )
{
if( !pSym && HB_IS_SYMBOL( pObject ) )
{
pSym = hb_itemGetSymbol( pObject );
pObject = NULL;
}
if( ( pSym || pObject ) &&
hb_vmRequestReenter() )
{
HB_OLE_PARAM_REF refArray[ 32 ];
int i, ii, iParams, iCount, iRefs;
iParams = iCount = pParams->cArgs;
for( i = iRefs = 0; i < iCount && iRefs < ( int ) HB_SIZEOFARRAY( refArray ); i++ )
{
if( pParams->rgvarg[ i ].n1.n2.vt & VT_BYREF )
refArray[ iRefs++ ].item = hb_stackAllocItem();
}
if( pSym )
hb_vmPushSymbol( pSym );
else
hb_vmPushEvalSym();
if( pObject )
hb_vmPush( pObject );
else
hb_vmPushNil();
if( pParam )
{
hb_vmPush( pParam );
iParams++;
}
for( i = 1, ii = 0; i <= iCount; i++ )
{
if( ( pParams->rgvarg[ iCount - i ].n1.n2.vt & VT_BYREF ) &&
( ii < iRefs ) )
{
refArray[ ii ].variant = &pParams->rgvarg[ iCount - i ];
hb_oleVariantToItem( refArray[ ii ].item, refArray[ ii ].variant );
hb_vmPushItemRef( refArray[ ii++ ].item );
}
else
hb_oleVariantToItem( hb_stackAllocItem(),
&pParams->rgvarg[ iCount - i ] );
}
if( pObject && !HB_IS_HASH( pObject ) )
hb_vmSend( ( HB_USHORT ) iParams );
else
hb_vmProc( ( HB_USHORT ) iParams );
if( pVarResult )
hb_oleItemToVariantRef( pVarResult, hb_stackReturnItem(), NULL, pObjFunc );
for( i = 0; i < iRefs; i++ )
hb_oleVariantUpdate( refArray[ i ].variant, refArray[ i ].item, pObjFunc );
for( i = 0; i < iRefs; i++ )
hb_stackPop();
hb_vmRequestRestore();
return HB_TRUE;
}
return HB_FALSE;
}
/* IDispatch parameters, return value handling */
static void GetParams( DISPPARAMS * dispparam )
{
VARIANTARG *pArgs = NULL, *pRefs;
UINT uiArgCount, uiArg, uiRefs;
uiArgCount = ( UINT ) hb_pcount();
if( uiArgCount > 0 )
{
uiRefs = 0;
for( uiArg = 1; uiArg <= uiArgCount; uiArg++ )
{
if( HB_ISBYREF( uiArg ) )
uiRefs++;
}
pArgs = ( VARIANTARG* ) hb_xgrab( sizeof( VARIANTARG ) * ( uiArgCount + uiRefs ) );
pRefs = &pArgs[ uiArgCount ];
for( uiArg = 0; uiArg < uiArgCount; uiArg++ )
{
VariantInit( &pArgs[ uiArg ] );
if( HB_ISBYREF( uiArgCount - uiArg ) )
{
VariantInit( pRefs );
hb_oleItemToVariantRef( pRefs, hb_param( uiArgCount - uiArg, HB_IT_ANY ),
&pArgs[ uiArg ], NULL );
++pRefs;
}
else
hb_oleItemToVariantRef( &pArgs[ uiArg ], hb_param( uiArgCount - uiArg, HB_IT_ANY ), NULL, NULL );
}
}
dispparam->rgvarg = pArgs;
dispparam->cArgs = uiArgCount;
dispparam->rgdispidNamedArgs = 0;
dispparam->cNamedArgs = 0;
}
static void PutParams( DISPPARAMS * dispparam )
{
VARIANTARG* pRefs = &dispparam->rgvarg[ dispparam->cArgs ];
PHB_ITEM pItem = NULL;
UINT uiArg;
for( uiArg = 0; uiArg < dispparam->cArgs; uiArg++ )
{
if( HB_ISBYREF( dispparam->cArgs - uiArg ) )
{
if( !pItem )
pItem = hb_itemNew( NULL );
hb_oleVariantToItem( pItem, &dispparam->rgvarg[ uiArg ] );
hb_itemParamStoreForward( ( HB_USHORT ) ( dispparam->cArgs - uiArg ), pItem );
VariantClear( pRefs );
pRefs++;
}
}
if( pItem )
hb_itemRelease( pItem );
}
static void FreeParams( DISPPARAMS * dispparam )
{
UINT ui;
if( dispparam->cArgs > 0 )
{
for( ui = 0; ui < dispparam->cArgs; ui++ )
VariantClear( &dispparam->rgvarg[ ui ] );
hb_xfree( dispparam->rgvarg );
}
}
/* PRG level functions and methods */
HB_FUNC( __OLECREATEOBJECT ) /* ( cOleName | cCLSID [, cIID ] ) */
{
wchar_t* cCLSID;
GUID ClassID, iid = IID_IDispatch;
IDispatch* pDisp = NULL;
const char* cOleName = hb_parc( 1 );
const char* cID = hb_parc( 2 );
HRESULT lOleError;
if( cOleName )
{
cCLSID = AnsiToWide( cOleName );
if( cOleName[ 0 ] == '{' )
lOleError = CLSIDFromString( (LPOLESTR) cCLSID, &ClassID );
else
lOleError = CLSIDFromProgID( (LPCOLESTR) cCLSID, &ClassID );
hb_xfree( cCLSID );
if( cID )
{
if( cID[ 0 ] == '{' )
{
cCLSID = AnsiToWide( cID );
lOleError = CLSIDFromString( ( LPOLESTR ) cCLSID, &iid );
hb_xfree( cCLSID );
}
else if( hb_parclen( 2 ) == ( HB_SIZE ) sizeof( iid ) )
{
memcpy( ( LPVOID ) &iid, cID, sizeof( iid ) );
}
}
if( lOleError == S_OK )
lOleError = CoCreateInstance( HB_ID_REF( ClassID ), NULL, CLSCTX_SERVER, HB_ID_REF( iid ), ( void** ) ( void * ) &pDisp );
}
else
lOleError = CO_E_CLASSSTRING;
hb_oleSetError( lOleError );
if( lOleError == S_OK )
hb_oleItemPut( hb_stackReturnItem(), pDisp );
else
hb_ret();
}
HB_FUNC( __OLEGETACTIVEOBJECT ) /* ( cOleName | cCLSID [, cIID ] ) */
{
#if defined( HB_OS_WIN_CE )
hb_oleSetError( E_NOTIMPL );
#else
BSTR wCLSID;
IID ClassID, iid = IID_IDispatch;
IDispatch* pDisp = NULL;
IUnknown* pUnk = NULL;
const char* cOleName = hb_parc( 1 );
const char* cID = hb_parc( 2 );
HRESULT lOleError;
if( cOleName )
{
wCLSID = ( BSTR ) AnsiToWide( ( LPSTR ) cOleName );
if( cOleName[ 0 ] == '{' )
lOleError = CLSIDFromString( wCLSID, ( LPCLSID ) &ClassID );
else
lOleError = CLSIDFromProgID( wCLSID, ( LPCLSID ) &ClassID );
hb_xfree( wCLSID );
if( cID )
{
if( cID[ 0 ] == '{' )
{
wCLSID = ( BSTR ) AnsiToWide( ( LPSTR ) cID );
lOleError = CLSIDFromString( wCLSID, &iid );
hb_xfree( wCLSID );
}
else if( hb_parclen( 2 ) == ( HB_SIZE ) sizeof( iid ) )
{
memcpy( ( LPVOID ) &iid, cID, sizeof( iid ) );
}
}
if( lOleError == S_OK )
{
lOleError = GetActiveObject( HB_ID_REF( ClassID ), NULL, &pUnk );
if ( lOleError == S_OK )
lOleError = HB_VTBL( pUnk )->QueryInterface( HB_THIS_( pUnk ) HB_ID_REF( iid ), ( void** ) ( void * ) &pDisp );
}
}
else
lOleError = CO_E_CLASSSTRING;
hb_oleSetError( lOleError );
if( lOleError == S_OK )
hb_oleItemPut( hb_stackReturnItem(), pDisp );
else
hb_ret();
#endif
}
HB_FUNC( __OLEENUMCREATE ) /* ( __hObj ) */
{
IDispatch * pDisp = hb_oleParam( 1 );
IEnumVARIANT * pEnum;
VARIANTARG variant;
DISPPARAMS dispparam;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
if( hb_parl( 2 ) )
{
hb_oleSetError( S_OK );
hb_errRT_OLE( EG_UNSUPPORTED, 1003, 0, NULL, HB_ERR_FUNCNAME );
return;
}
memset( &excep, 0, sizeof( excep ) );
memset( &dispparam, 0, sizeof( dispparam ) ); /* empty parameters */
VariantInit( &variant );
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) DISPID_NEWENUM, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET,
&dispparam, &variant, &excep, &uiArgErr );
if( lOleError == S_OK )
{
if( variant.n1.n2.vt == VT_UNKNOWN )
lOleError = HB_VTBL( variant.n1.n2.n3.punkVal )->QueryInterface(
HB_THIS_( variant.n1.n2.n3.punkVal )
HB_ID_REF( IID_IEnumVARIANT ), ( void** ) ( void * ) &pEnum );
else if( variant.n1.n2.vt == VT_DISPATCH )
lOleError = HB_VTBL( variant.n1.n2.n3.pdispVal )->QueryInterface(
HB_THIS_( variant.n1.n2.n3.pdispVal )
HB_ID_REF( IID_IEnumVARIANT ), ( void** ) ( void * ) &pEnum );
else
{
hb_oleSetError( lOleError );
hb_errRT_OLE( EG_ARG, 1004, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME );
return;
}
VariantClear( &variant );
if( lOleError == S_OK )
{
IEnumVARIANT** ppEnum;
hb_oleSetError( S_OK );
ppEnum = ( IEnumVARIANT** ) hb_gcAllocate( sizeof( IEnumVARIANT* ), &s_gcOleenumFuncs );
*ppEnum = pEnum;
hb_retptrGC( ppEnum );
return;
}
}
hb_oleSetError( lOleError );
hb_errRT_OLE( EG_ARG, 1005, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME );
}
HB_FUNC( __OLEENUMNEXT )
{
IEnumVARIANT * pEnum = hb_oleenumParam( 1 );
VARIANTARG variant;
VariantInit( &variant );
if( HB_VTBL( pEnum )->Next( HB_THIS_( pEnum ) 1, &variant, NULL ) == S_OK )
{
hb_oleVariantToItem( hb_stackReturnItem(), &variant );
VariantClear( &variant );
hb_storl( HB_TRUE, 2 );
}
else
hb_storl( HB_FALSE, 2 );
}
HB_FUNC( WIN_OLEERROR )
{
hb_retnl( hb_oleGetError() );
}
HB_FUNC( WIN_OLEERRORTEXT )
{
HRESULT lOleError;
if( HB_ISNUM( 1 ) )
lOleError = hb_parnl( 1 );
else
lOleError = hb_oleGetError();
switch( lOleError )
{
case S_OK: hb_retc_null(); break;
case CO_E_CLASSSTRING: hb_retc_const( "CO_E_CLASSSTRING" ); break;
case OLE_E_WRONGCOMPOBJ: hb_retc_const( "OLE_E_WRONGCOMPOBJ" ); break;
case REGDB_E_CLASSNOTREG: hb_retc_const( "REGDB_E_CLASSNOTREG" ); break;
case REGDB_E_WRITEREGDB: hb_retc_const( "REGDB_E_WRITEREGDB" ); break;
case E_OUTOFMEMORY: hb_retc_const( "E_OUTOFMEMORY" ); break;
case E_INVALIDARG: hb_retc_const( "E_INVALIDARG" ); break;
case E_UNEXPECTED: hb_retc_const( "E_UNEXPECTED" ); break;
case E_NOTIMPL: hb_retc_const( "E_NOTIMPL" ); break;
case DISP_E_UNKNOWNNAME: hb_retc_const( "DISP_E_UNKNOWNNAME" ); break;
case DISP_E_UNKNOWNLCID: hb_retc_const( "DISP_E_UNKNOWNLCID" ); break;
case DISP_E_BADPARAMCOUNT: hb_retc_const( "DISP_E_BADPARAMCOUNT" ); break;
case DISP_E_BADVARTYPE: hb_retc_const( "DISP_E_BADVARTYPE" ); break;
case DISP_E_EXCEPTION: hb_retc_const( "DISP_E_EXCEPTION" ); break;
case DISP_E_MEMBERNOTFOUND: hb_retc_const( "DISP_E_MEMBERNOTFOUND" ); break;
case DISP_E_NONAMEDARGS: hb_retc_const( "DISP_E_NONAMEDARGS" ); break;
case DISP_E_OVERFLOW: hb_retc_const( "DISP_E_OVERFLOW" ); break;
case DISP_E_PARAMNOTFOUND: hb_retc_const( "DISP_E_PARAMNOTFOUND" ); break;
case DISP_E_TYPEMISMATCH: hb_retc_const( "DISP_E_TYPEMISMATCH" ); break;
case DISP_E_UNKNOWNINTERFACE: hb_retc_const( "DISP_E_UNKNOWNINTERFACE" ); break;
case DISP_E_PARAMNOTOPTIONAL: hb_retc_const( "DISP_E_PARAMNOTOPTIONAL" ); break;
default:
{
char buf[ 16 ];
hb_snprintf( buf, 16, "0x%08x", ( UINT ) ( HB_PTRUINT ) lOleError );
hb_retc( buf );
}
}
}
HB_FUNC( WIN_OLEAUTO___ONERROR )
{
IDispatch* pDisp;
const char* szMethod;
wchar_t szMethodWide[ HB_SYMBOL_NAME_LEN + 1 ];
OLECHAR* pMemberArray;
DISPID dispid;
DISPPARAMS dispparam;
VARIANTARG variant;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
/* Get object handle */
hb_vmPushDynSym( s_pDyns_hObjAccess );
hb_vmPush( hb_stackSelfItem() );
hb_vmSend( 0 );
pDisp = hb_oleParam( -1 );
if( !pDisp )
return;
szMethod = hb_itemGetSymbol( hb_stackBaseItem() )->szName;
AnsiToWideBuffer( szMethod, szMethodWide, ( int ) HB_SIZEOFARRAY( szMethodWide ) );
/* Try property put */
if( szMethod[ 0 ] == '_' && hb_pcount() == 1 )
{
pMemberArray = &szMethodWide[ 1 ];
lOleError = HB_VTBL( pDisp )->GetIDsOfNames( HB_THIS_( pDisp ) HB_ID_REF( IID_NULL ), &pMemberArray,
1, LOCALE_USER_DEFAULT, &dispid );
if( lOleError == S_OK )
{
DISPID lPropPut = DISPID_PROPERTYPUT;
memset( &excep, 0, sizeof( excep ) );
GetParams( &dispparam );
dispparam.rgdispidNamedArgs = &lPropPut;
dispparam.cNamedArgs = 1;
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) dispid, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYPUT, &dispparam,
NULL, &excep, &uiArgErr );
FreeParams( &dispparam );
/* assign method should return assigned value */
hb_itemReturn( hb_param( 1, HB_IT_ANY ) );
hb_oleSetError( lOleError );
if( lOleError != S_OK )
hb_errRT_OLE( EG_ARG, 1006, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME );
return;
}
}
/* Try property get and invoke */
pMemberArray = szMethodWide;
lOleError = HB_VTBL( pDisp )->GetIDsOfNames( HB_THIS_( pDisp ) HB_ID_REF( IID_NULL ),
&pMemberArray, 1, LOCALE_USER_DEFAULT, &dispid );
if( lOleError == S_OK )
{
memset( &excep, 0, sizeof( excep ) );
VariantInit( &variant );
GetParams( &dispparam );
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) dispid, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET | DISPATCH_METHOD,
&dispparam, &variant, &excep, &uiArgErr );
PutParams( &dispparam );
FreeParams( &dispparam );
hb_oleVariantToItem( hb_stackReturnItem(), &variant );
VariantClear( &variant );
hb_oleSetError( lOleError );
if( lOleError != S_OK )
hb_errRT_OLE( EG_ARG, 1007, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME );
return;
}
hb_oleSetError( lOleError );
/* TODO: add description containing TypeName of the object */
if( szMethod[ 0 ] == '_' )
hb_errRT_OLE( EG_NOVARMETHOD, 1008, ( HB_ERRCODE ) lOleError, NULL, szMethod + 1 );
else
hb_errRT_OLE( EG_NOMETHOD, 1009, ( HB_ERRCODE ) lOleError, NULL, szMethod );
}
HB_CALL_ON_STARTUP_BEGIN( _hb_olecore_init_ )
hb_vmAtInit( hb_olecore_init, NULL );
HB_CALL_ON_STARTUP_END( _hb_olecore_init_ )
#if defined( HB_PRAGMA_STARTUP )
#pragma startup _hb_olecore_init_
#elif defined( HB_DATASEG_STARTUP )
#define HB_DATASEG_BODY HB_DATASEG_FUNC( _hb_olecore_init_ )
#include "hbiniseg.h"
#endif