fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
efde19ca13be8a67cfe0d641205b95321fa3fdfd
harbour-core/contrib/hbwin/olecore.c
Przemysław Czerpak bf146ab5ee 2025-01-24 12:32 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) 
* contrib/hbwin/olecore.c
    * pacified false MSVC warning. It's very seldom situation that I'm adding
      code to pacify false compiler warnings anyhow in this case it cost in
      practice nothing so I decided to do that.

  * contrib/xhb/hboutdbg.c
  * src/rtl/gtcrs/gtcrs.c
    * NULL pointer casting to pacify warning

  * src/pp/hbpp.c
    % do not created new iLen variable but reuse the one previously declared

  * src/vm/classes.c
    % allocate puiMsgIdx as array of HB_USHORT items instead of HB_SYMCNT.
      This modification only reduces the memory usage and has no effect on
      number of accepted symbols.
    * changed 'HB_SYMCNT uiHashKey' to 'HB_SIZE nHashKey' to avoid explicit
      casting in the code
2025-01-24 12:32:32 +01:00

2893 lines
85 KiB
C
Raw Blame History

/*
* OLE library
*
* Copyright 2000, 2003 Jose F. Gimenez (JFG) <jfgimenez@wanadoo.es>
* Copyright 2008, 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
*
* 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 program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* 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 "hbapicdp.h"
#include "hbapilng.h"
#include "hbapistr.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
#if ! defined( HB_OLE_NO_SAFEARRAYGETVARTYPE ) && \
( defined( __DMC__ ) || \
defined( __MINGW32CE__ ) || \
( defined( __WATCOMC__ ) && ( __WATCOMC__ < 1270 ) ) )
#define HB_OLE_NO_SAFEARRAYGETVARTYPE
#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_DESTRUCTOR_FUNC pDestructorFunc;
void * cargo;
} HB_OLE;
typedef struct
{
HRESULT lOleError;
HB_BOOL fNullDate;
HB_BOOL fNil2Null;
int iInit;
} HB_OLEDATA, * PHB_OLEDATA;
static void hb_oleDataInit( void * cargo )
{
PHB_OLEDATA pOleData = ( PHB_OLEDATA ) cargo;
/* default settings: */
pOleData->fNullDate = HB_FALSE;
pOleData->fNil2Null = HB_FALSE;
#if defined( HB_OS_WIN_CE )
if( CoInitializeEx( NULL, COINIT_APARTMENTTHREADED ) == S_OK )
#else
if( OleInitialize( NULL ) == S_OK )
#endif
pOleData->iInit = 1;
}
static void hb_oleDataRelease( void * cargo )
{
PHB_OLEDATA pOleData = ( PHB_OLEDATA ) cargo;
if( pOleData->iInit )
{
#if defined( HB_OS_WIN_CE )
CoUninitialize();
#else
OleUninitialize();
#endif
}
}
static HB_TSD_NEW( s_oleData, sizeof( HB_OLEDATA ), hb_oleDataInit, hb_oleDataRelease );
#define hb_getOleData() ( ( PHB_OLEDATA ) hb_stackGetTSD( &s_oleData ) )
HB_FUNC_EXTERN( WIN_OLEAUTO );
HB_BOOL hb_oleInit( void )
{
return hb_getOleData()->iInit != 0;
}
void hb_oleSetError( HRESULT lOleError )
{
hb_getOleData()->lOleError = lOleError;
}
HRESULT hb_oleGetError( void )
{
return hb_getOleData()->lOleError;
}
static void hb_oleSetNullDateFlag( HB_BOOL fNullDate )
{
hb_getOleData()->fNullDate = fNullDate;
}
static HB_BOOL hb_oleGetNullDateFlag( void )
{
return hb_getOleData()->fNullDate;
}
static void hb_oleSetNil2NullFlag( HB_BOOL fNil2Null )
{
hb_getOleData()->fNil2Null = fNil2Null;
}
static HB_BOOL hb_oleGetNil2NullFlag( void )
{
return hb_getOleData()->fNil2Null;
}
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 );
}
}
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 );
}
if( pOle->pDestructorFunc )
{
pOle->pDestructorFunc( pOle->cargo );
pOle->pDestructorFunc = NULL;
}
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 HB_GARBAGE_FUNC( hb_olevariant_destructor )
{
VARIANT * pVariant = ( VARIANT * ) Cargo;
VariantClear( pVariant );
}
static const HB_GC_FUNCS s_gcVariantFuncs =
{
hb_olevariant_destructor,
hb_gcDummyMark
};
static void hb_errRT_OLE( HB_ERRCODE errGenCode, HB_ERRCODE errSubCode, HB_ERRCODE errOsCode, const char * szDescription, const char * szOperation, const char * szFileName )
{
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 );
}
if( szFileName )
hb_errPutFileName( pError, szFileName );
hb_errLaunch( pError );
hb_errRelease( pError );
}
static void hb_oleExcepDescription( EXCEPINFO * pExcep, char ** pszDescription, char ** pszSource )
{
if( pExcep->pfnDeferredFillIn )
( *pExcep->pfnDeferredFillIn )( pExcep );
if( pExcep->bstrSource )
{
int iLen, iStrLen;
iStrLen = ( int ) SysStringLen( pExcep->bstrSource );
iLen = WideCharToMultiByte( CP_ACP, 0, pExcep->bstrSource, iStrLen, NULL, 0, NULL, NULL );
* pszSource = ( char * ) hb_xgrab( ( iLen + 1 ) * sizeof( char ) );
WideCharToMultiByte( CP_ACP, 0, pExcep->bstrSource, iStrLen, * pszSource, iLen + 1, NULL, NULL );
( * pszSource )[ iLen ] = '\0';
SysFreeString( pExcep->bstrSource );
}
if( pExcep->bstrHelpFile )
SysFreeString( pExcep->bstrHelpFile );
if( pExcep->bstrDescription )
{
int iLen, iStrLen;
iStrLen = ( int ) SysStringLen( pExcep->bstrDescription );
iLen = WideCharToMultiByte( CP_ACP, 0, pExcep->bstrDescription, iStrLen, NULL, 0, NULL, NULL );
* pszDescription = ( char * ) hb_xgrab( ( iLen + 14 + 1 ) * sizeof( char ) );
WideCharToMultiByte( CP_ACP, 0, pExcep->bstrDescription, iStrLen, * pszDescription, iLen + 1, NULL, NULL );
( * pszDescription )[ iLen ] = '\0';
SysFreeString( pExcep->bstrDescription );
}
else
{
*pszDescription = ( char * ) hb_xgrab( ( 14 + 1 ) * sizeof( char ) );
( *pszDescription )[ 0 ] = '\0';
}
if( pExcep->wCode )
hb_snprintf( ( *pszDescription ) + strlen( *pszDescription ), 14, " (%d)", pExcep->wCode );
else
hb_snprintf( ( *pszDescription ) + strlen( *pszDescription ), 14, " (0x%08lX)", pExcep->scode );
}
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, NULL );
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;
pOle->pDestructorFunc = NULL;
pOle->cargo = 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 pCallBackPrev = *pOle->pCallBack;
*pOle->pCallBack = NULL;
pOle->pCallBack = NULL;
hb_itemRelease( pCallBackPrev );
}
if( pCallBack )
{
pOle->pCallBack = pCallBack;
hb_gcUnlock( *pCallBack );
}
}
}
void hb_oleItemSetDestructor( PHB_ITEM pItem, HB_OLE_DESTRUCTOR_FUNC pFunc, void * cargo )
{
HB_OLE * pOle = ( HB_OLE * ) hb_itemGetPtrGC( pItem, &s_gcOleFuncs );
if( pOle )
{
pOle->pDestructorFunc = pFunc;
pOle->cargo = cargo;
}
}
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, NULL );
return NULL;
}
static VARIANT * hb_oleVariantParam( int iParam )
{
VARIANT * pVariant = ( VARIANT * ) hb_parptrGC( &s_gcVariantFuncs, iParam );
if( ! pVariant )
hb_errRT_OLE( EG_ARG, 1017, 0, NULL, HB_ERR_FUNCNAME, NULL );
return pVariant;
}
VARIANT * hb_oleItemGetVariant( PHB_ITEM pItem )
{
return ( VARIANT * ) hb_itemGetPtrGC( pItem, &s_gcVariantFuncs );
}
PHB_ITEM hb_oleItemPutVariant( PHB_ITEM pItem, VARIANT * pVariant, HB_BOOL fMove )
{
VARIANT * pDestVariant = ( VARIANT * ) hb_gcAllocate( sizeof( VARIANT ), &s_gcVariantFuncs );
if( fMove )
{
*pDestVariant = *pVariant;
VariantInit( pVariant );
}
else
{
VariantInit( pDestVariant );
VariantCopy( pDestVariant, pVariant );
}
return hb_itemPutPtrGC( pItem, pDestVariant );
}
/* 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 ] = L'\0';
}
static BSTR hb_oleItemToString( PHB_ITEM pItem )
{
UINT uiStrLen = ( UINT ) hb_itemCopyStrU16( pItem, HB_CDP_ENDIAN_NATIVE,
NULL, UINT_MAX );
BSTR strVal = SysAllocStringLen( NULL, uiStrLen );
hb_itemCopyStrU16( pItem, HB_CDP_ENDIAN_NATIVE, strVal, uiStrLen + 1 );
return strVal;
}
static void hb_oleStringToItem( BSTR strVal, PHB_ITEM pItem )
{
hb_itemPutStrLenU16( pItem, HB_CDP_ENDIAN_NATIVE, strVal,
SysStringLen( strVal ) );
}
static void hb_oleVariantRef( VARIANT * pVariant, VARIANT * pVarRef )
{
if( V_VT( pVariant ) & VT_BYREF )
{
VariantCopy( pVarRef, pVariant );
return;
}
V_VT( pVarRef ) = V_VT( pVariant ) | VT_BYREF;
switch( V_VT( pVariant ) )
{
case VT_I1:
V_I1REF( pVarRef ) = &V_I1( pVariant );
break;
case VT_UI1:
V_UI1REF( pVarRef ) = &V_UI1( pVariant );
break;
case VT_I2:
V_I2REF( pVarRef ) = &V_I2( pVariant );
break;
case VT_UI2:
V_UI2REF( pVarRef ) = &V_UI2( pVariant );
break;
case VT_I4:
V_I4REF( pVarRef ) = &V_I4( pVariant );
break;
case VT_UI4:
V_UI4REF( pVarRef ) = &V_UI4( pVariant );
break;
case VT_I8:
#if defined( HB_OLE_NO_LLREF ) || defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
V_R8REF( pVarRef ) = &V_R8( pVariant );
#else
V_I8REF( pVarRef ) = &V_I8( pVariant );
#endif
break;
case VT_UI8:
#if defined( HB_OLE_NO_LLREF ) || defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
V_R8REF( pVarRef ) = &V_R8( pVariant );
#else
V_I8REF( pVarRef ) = &V_I8( pVariant );
#endif
break;
case VT_INT:
V_INTREF( pVarRef ) = &V_INT( pVariant );
break;
case VT_UINT:
V_UINTREF( pVarRef ) = &V_UINT( pVariant );
break;
case VT_ERROR:
V_ERRORREF( pVarRef ) = &V_ERROR( pVariant );
break;
case VT_BOOL:
V_BOOLREF( pVarRef ) = &V_BOOL( pVariant );
break;
case VT_R4:
V_R4REF( pVarRef ) = &V_R4( pVariant );
break;
case VT_R8:
V_R8REF( pVarRef ) = &V_R8( pVariant );
break;
case VT_CY:
V_CYREF( pVarRef ) = &V_CY( pVariant );
break;
case VT_DATE:
V_R8REF( pVarRef ) = &V_R8( pVariant );
break;
case VT_BSTR:
V_BSTRREF( pVarRef ) = &V_BSTR( pVariant );
break;
default:
if( V_VT( pVariant ) & VT_ARRAY )
V_ARRAYREF( pVarRef ) = &V_ARRAY( pVariant );
else
{
V_VT( pVarRef ) = VT_VARIANT | VT_BYREF;
V_BYREF( pVarRef ) = pVariant;
}
break;
}
}
static HB_BOOL hb_oleSafeArrayFill( SAFEARRAY * pSafeArray, VARTYPE vt, PHB_ITEM pItem,
int iDims, int iDim, long * plSize, long * plIndex )
{
const char * pStr;
void * pData;
UINT uiPos, cElements;
if( pItem == NULL || HB_IS_NIL( pItem ) )
return HB_TRUE;
if( HB_IS_STRING( pItem ) )
{
pStr = hb_itemGetCPtr( pItem );
uiPos = ( UINT ) hb_itemGetCLen( pItem );
}
else if( HB_IS_ARRAY( pItem ) )
{
pStr = NULL;
uiPos = ( UINT ) hb_arrayLen( pItem );
}
else
return HB_FALSE;
cElements = ( UINT ) plSize[ iDim - 1 ];
if( uiPos < cElements )
cElements = uiPos;
if( iDim < iDims )
{
if( pStr )
return HB_FALSE;
for( uiPos = 1; uiPos <= cElements; ++uiPos )
{
plIndex[ iDim - 1 ] = ( long ) ( uiPos - 1 );
if( ! hb_oleSafeArrayFill( pSafeArray, vt,
hb_arrayGetItemPtr( pItem, uiPos ),
iDims, iDim + 1, plSize, plIndex ) )
return HB_FALSE;
}
return HB_TRUE;
}
if( pStr && ( vt == VT_I1 || vt == VT_UI1 ) &&
SafeArrayGetDim( pSafeArray ) == 1 &&
SafeArrayAccessData( pSafeArray, &pData ) == S_OK )
{
memcpy( pData, pStr, cElements );
SafeArrayUnaccessData( pSafeArray );
return HB_TRUE;
}
for( uiPos = 1; uiPos <= cElements; ++uiPos )
{
VARIANT v;
void * ptr = NULL;
switch( vt )
{
case VT_I1:
V_I1( &v ) = pStr ? ( HB_I8 ) ( signed char ) pStr[ uiPos - 1 ] :
( HB_I8 ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_I1( &v );
break;
case VT_UI1:
V_UI1( &v ) = pStr ? ( HB_U8 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_U8 ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_UI1( &v );
break;
case VT_I2:
V_I2( &v ) = pStr ? ( HB_I16 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_I16 ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_I2( &v );
break;
case VT_UI2:
V_UI2( &v ) = pStr ? ( HB_U16 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_U16 ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_UI2( &v );
break;
case VT_I4:
V_I4( &v ) = pStr ? ( HB_I32 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_I32 ) hb_arrayGetNL( pItem, uiPos );
ptr = &V_I4( &v );
break;
case VT_UI4:
V_UI4( &v ) = pStr ? ( HB_U32 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_U32 ) hb_arrayGetNL( pItem, uiPos );
ptr = &V_UI4( &v );
break;
#if ! defined( HB_LONG_LONG_OFF )
case VT_I8:
# if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
ptr = &V_I4( &v );
*( ( HB_LONGLONG * ) ptr ) =
pStr ? ( HB_I64 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_I64 ) hb_arrayGetNInt( pItem, uiPos );
# else
V_I8( &v ) = pStr ? ( HB_I64 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_I64 ) hb_arrayGetNInt( pItem, uiPos );
ptr = &V_I8( &v );
# endif
break;
case VT_UI8:
# if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
ptr = &V_UI4( &v );
*( ( HB_ULONGLONG * ) ptr ) =
pStr ? ( HB_U64 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_U64 ) hb_arrayGetNInt( pItem, uiPos );
# else
V_UI8( &v ) = pStr ? ( HB_U64 ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_U64 ) hb_arrayGetNInt( pItem, uiPos );
ptr = &V_UI8( &v );
# endif
break;
#endif
case VT_INT:
V_INT( &v ) = pStr ? ( HB_INT ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_INT ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_INT( &v );
break;
case VT_UINT:
V_UINT( &v ) = pStr ? ( HB_UINT ) ( unsigned char ) pStr[ uiPos - 1 ] :
( HB_UINT ) hb_arrayGetNI( pItem, uiPos );
ptr = &V_UINT( &v );
break;
case VT_ERROR:
if( pStr == NULL )
{
V_ERROR( &v ) = ( SCODE ) hb_arrayGetNL( pItem, uiPos );
ptr = &V_ERROR( &v );
}
break;
case VT_BOOL:
if( pStr == NULL )
{
V_BOOL( &v ) = hb_arrayGetL( pItem, uiPos ) ? TRUE : FALSE;
ptr = &V_BOOL( &v );
}
break;
case VT_R4:
if( pStr == NULL )
{
V_R4( &v ) = ( float ) hb_arrayGetND( pItem, uiPos );
ptr = &V_R4( &v );
}
break;
case VT_R8:
if( pStr == NULL )
{
V_R8( &v ) = hb_arrayGetND( pItem, uiPos );
ptr = &V_R8( &v );
}
break;
case VT_CY:
if( pStr == NULL )
{
VarCyFromR8( hb_arrayGetND( pItem, uiPos ), &V_CY( &v ) );
ptr = &V_CY( &v );
}
break;
case VT_DATE:
if( pStr == NULL )
{
V_R8( &v ) = hb_arrayGetTD( pItem, uiPos ) - HB_OLE_DATE_BASE;
ptr = &V_R8( &v );
}
break;
case VT_BSTR:
if( pStr == NULL )
ptr = hb_oleItemToString( hb_arrayGetItemPtr( pItem, uiPos ) );
break;
case VT_VARIANT:
if( pStr == NULL )
{
VariantInit( &v );
hb_oleItemToVariant( &v, hb_arrayGetItemPtr( pItem, uiPos ) );
ptr = &v;
}
break;
}
if( ptr != NULL )
{
plIndex[ iDim - 1 ] = ( long ) ( uiPos - 1 );
SafeArrayPutElement( pSafeArray, plIndex, ptr );
if( vt == VT_VARIANT )
VariantClear( &v );
}
else
return HB_FALSE;
}
return HB_TRUE;
}
static SAFEARRAY * hb_oleSafeArrayFromItem( PHB_ITEM pItem, VARTYPE vt,
int iDims, long * plSize )
{
SAFEARRAYBOUND boundbuf[ 16 ], * sabound;
SAFEARRAY * pSafeArray;
long * plIndex;
if( iDims == 0 )
{
if( pItem )
{
if( HB_IS_STRING( pItem ) )
plSize[ 0 ] = ( UINT ) hb_itemGetCLen( pItem );
else if( HB_IS_ARRAY( pItem ) )
plSize[ 0 ] = ( UINT ) hb_arrayLen( pItem );
else if( ! HB_IS_NIL( pItem ) )
return NULL;
}
iDims = 1;
}
sabound = iDims > ( int ) HB_SIZEOFARRAY( boundbuf ) ? ( SAFEARRAYBOUND * )
hb_xgrab( sizeof( SAFEARRAYBOUND ) * iDims ) : boundbuf;
/* use the same buffer for dimensions and indexes */
plIndex = &sabound[ 0 ].lLbound;
if( iDims == 1 && plSize[ 0 ] > 0 )
pSafeArray = SafeArrayCreateVector( vt, 0, plSize[ 0 ] );
else
{
int iDim;
for( iDim = 0; iDim < iDims; ++iDim )
{
sabound[ iDim ].lLbound = 0;
sabound[ iDim ].cElements = plSize[ iDim ];
}
pSafeArray = SafeArrayCreate( vt, iDims, sabound );
}
if( pSafeArray && pItem && iDims && plSize[ 0 ] )
{
if( ! hb_oleSafeArrayFill( pSafeArray, vt, pItem,
iDims, 1, plSize, plIndex ) )
{
SafeArrayDestroy( pSafeArray );
pSafeArray = NULL;
}
}
if( sabound != boundbuf )
hb_xfree( sabound );
return pSafeArray;
}
static HB_BOOL hb_oleSafeArrayToString( PHB_ITEM pItem, SAFEARRAY * pSafeArray )
{
long lFrom, lTo;
VARTYPE vt = VT_UI1;
if( SafeArrayGetElemsize( pSafeArray ) == 1 &&
#if ! defined( HB_OLE_NO_SAFEARRAYGETVARTYPE )
SafeArrayGetVartype( pSafeArray, &vt ) == S_OK &&
#endif
( vt == VT_I1 || vt == VT_UI1 ) &&
SafeArrayGetLBound( pSafeArray, 1, &lFrom ) == S_OK &&
SafeArrayGetUBound( pSafeArray, 1, &lTo ) == S_OK &&
lFrom <= lTo + 1 ) /* accept empty arrays */
{
void * pData;
if( SafeArrayAccessData( pSafeArray, &pData ) == S_OK )
{
hb_itemPutCL( pItem, ( const char * ) pData, lTo - lFrom + 1 );
SafeArrayUnaccessData( pSafeArray );
return HB_TRUE;
}
}
return HB_FALSE;
}
IDispatch * hb_oleItemGetDispatch( PHB_ITEM pItem )
{
if( HB_IS_OBJECT( pItem ) )
{
if( hb_objHasMessage( pItem, s_pDyns_hObjAccess ) )
{
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 ) );
V_VT( pVariant ) = VT_DISPATCH;
V_DISPATCH( pVariant ) = pDisp;
if( pVarRef )
{
V_VT( pVarRef ) = VT_DISPATCH | VT_BYREF;
V_DISPATCHREF( pVarRef ) = &V_DISPATCH( pVariant );
}
}
/* Item <-> Variant conversion */
static void hb_oleItemToVariantRef( VARIANT * pVariant, PHB_ITEM pItem,
VARIANT * pVarRef, HB_OLEOBJ_FUNC pObjFunc )
{
VariantClear( pVariant ); /* VT_T( pVariant ) = VT_EMPTY; */
switch( hb_itemType( pItem ) )
{
case HB_IT_STRING:
case HB_IT_MEMO:
V_VT( pVariant ) = VT_BSTR;
V_BSTR( pVariant ) = hb_oleItemToString( pItem );
if( pVarRef )
{
V_VT( pVarRef ) = VT_BSTR | VT_BYREF;
V_BSTRREF( pVarRef ) = &V_BSTR( pVariant );
}
break;
case HB_IT_LOGICAL:
V_VT( pVariant ) = VT_BOOL;
V_BOOL( pVariant ) = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE;
if( pVarRef )
{
V_VT( pVarRef ) = VT_BOOL | VT_BYREF;
V_BOOLREF( pVarRef ) = &V_BOOL( pVariant );
}
break;
case HB_IT_INTEGER:
V_VT( pVariant ) = VT_I4;
V_I4( pVariant ) = hb_itemGetNL( pItem );
if( pVarRef )
{
V_VT( pVarRef ) = VT_I4 | VT_BYREF;
V_I4REF( pVarRef ) = &V_I4( pVariant );
}
break;
case HB_IT_LONG:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
V_VT( pVariant ) = VT_I4;
V_I4( pVariant ) = hb_itemGetNL( pItem );
if( pVarRef )
{
V_VT( pVarRef ) = VT_I4 | VT_BYREF;
V_I4REF( pVarRef ) = &V_I4( pVariant );
}
#else
V_VT( pVariant ) = VT_I8;
# if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
* ( ( HB_LONGLONG * ) &V_I4( pVariant ) ) = hb_itemGetNInt( pItem );
# else
V_I8( pVariant ) = hb_itemGetNInt( pItem );
# endif
if( pVarRef )
{
V_VT( pVarRef ) = VT_I8 | VT_BYREF;
# if defined( HB_OLE_NO_LLREF ) || defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
V_R8REF( pVarRef ) = &V_R8( pVariant );
# else
V_I8REF( pVarRef ) = &V_I8( pVariant );
# endif
}
#endif
break;
case HB_IT_DOUBLE:
V_VT( pVariant ) = VT_R8;
V_R8( pVariant ) = hb_itemGetND( pItem );
if( pVarRef )
{
V_VT( pVarRef ) = VT_R8 | VT_BYREF;
V_R8REF( pVarRef ) = &V_R8( pVariant );
}
break;
case HB_IT_DATE:
{
long lDate = hb_itemGetDL( pItem );
if( lDate == 0 && hb_oleGetNullDateFlag() )
{
V_VT( pVariant ) = VT_NULL;
if( pVarRef )
{
V_VT( pVarRef ) = VT_VARIANT | VT_BYREF;
V_VARIANTREF( pVarRef ) = pVariant;
}
}
else
{
V_VT( pVariant ) = VT_DATE;
V_R8( pVariant ) = ( double ) ( lDate - HB_OLE_DATE_BASE );
if( pVarRef )
{
V_VT( pVarRef ) = VT_DATE | VT_BYREF;
V_R8REF( pVarRef ) = &V_R8( pVariant );
}
}
break;
}
case HB_IT_TIMESTAMP:
{
double dDate = hb_itemGetTD( pItem );
if( dDate == 0 && hb_oleGetNullDateFlag() )
{
V_VT( pVariant ) = VT_NULL;
if( pVarRef )
{
V_VT( pVarRef ) = VT_VARIANT | VT_BYREF;
V_VARIANTREF( pVarRef ) = pVariant;
}
}
else
{
V_VT( pVariant ) = VT_DATE;
V_R8( pVariant ) = dDate - HB_OLE_DATE_BASE;
if( pVarRef )
{
V_VT( pVarRef ) = VT_DATE | VT_BYREF;
V_R8REF( pVarRef ) = &V_R8( pVariant );
}
}
break;
}
case HB_IT_POINTER:
{
IDispatch * pDisp;
VARIANT * pVarPtr;
if( ( pDisp = hb_oleItemGet( pItem ) ) != NULL )
hb_oleDispatchToVariant( pVariant, pDisp, pVarRef );
else if( ( pVarPtr = hb_oleItemGetVariant( pItem ) ) != NULL )
{
if( pVarRef )
hb_oleVariantRef( pVarPtr, pVarRef );
else
VariantCopy( pVariant, pVarPtr );
}
#ifdef HB_OLE_PASS_POINTERS
else
{
V_VT( pVariant ) = VT_PTR;
V_BYREF( pVariant ) = hb_itemGetPtr( pItem );
if( pVarRef )
{
V_VT( pVarRef ) = VT_PTR | VT_BYREF;
V_BYREF( pVarRef ) = &V_BYREF( pVariant );
}
}
#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 n, nLen;
nLen = hb_arrayLen( pItem );
sabound[ 0 ].lLbound = 0;
sabound[ 0 ].cElements = ( long ) nLen;
pSafeArray = SafeArrayCreate( VT_VARIANT, 1, sabound );
V_VT( pVariant ) = VT_VARIANT | VT_ARRAY;
V_ARRAY( pVariant ) = pSafeArray;
if( pVarRef )
{
V_VT( pVarRef ) = VT_VARIANT | VT_ARRAY | VT_BYREF;
V_ARRAYREF( pVarRef ) = &V_ARRAY( pVariant );
}
for( n = 0; n < nLen; n++ )
{
VARIANT vItem;
long lIndex[ 1 ];
VariantInit( &vItem );
hb_oleItemToVariantRef( &vItem, hb_arrayGetItemPtr( pItem, n + 1 ), NULL, pObjFunc );
lIndex[ 0 ] = ( long ) n;
SafeArrayPutElement( pSafeArray, lIndex, &vItem );
VariantClear( &vItem );
}
}
break;
case HB_IT_NIL:
if( hb_oleGetNil2NullFlag() )
V_VT( pVariant ) = VT_NULL;
/* fallthrough */
default:
if( pVarRef )
{
V_VT( pVarRef ) = VT_VARIANT | VT_BYREF;
V_VARIANTREF( pVarRef ) = 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 )
{
V_VT( pVarRef ) = VT_VARIANT | VT_BYREF;
V_VARIANTREF( pVarRef ) = 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 iDims, int iDim, long * plIndex, VARTYPE vt,
HB_USHORT uiClass )
{
long lFrom, lTo;
if( SafeArrayGetLBound( pSafeArray, iDim, &lFrom ) == S_OK &&
SafeArrayGetUBound( pSafeArray, iDim, &lTo ) == S_OK &&
lFrom <= lTo )
{
HB_SIZE nIndex = 0;
hb_arrayNew( pItem, lTo - lFrom + 1 );
if( iDim == iDims )
{
VARIANT vItem;
VariantInit( &vItem );
do
{
plIndex[ iDim - 1 ] = 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 * ) &HB_WIN_U1( &vItem, decVal ) :
( void * ) &HB_WIN_U3( &vItem, bVal ) ) ) == S_OK )
{
if( vt != VT_VARIANT )
V_VT( &vItem ) = vt; /* it's reserved in VT_DECIMAL structure */
hb_oleVariantToItemEx( hb_arrayGetItemPtr( pItem, ++nIndex ), &vItem, uiClass );
VariantClear( &vItem );
}
}
while( ++lFrom <= lTo );
}
else
{
do
{
plIndex[ iDim - 1 ] = lFrom;
hb_oleSafeArrayToItem( hb_arrayGetItemPtr( pItem, ++nIndex ),
pSafeArray, iDims, iDim + 1, plIndex, vt, uiClass );
}
while( ++lFrom <= lTo );
}
}
else
hb_arrayNew( pItem, 0 );
}
void hb_oleDispatchToItem( PHB_ITEM pItem, IDispatch * pdispVal, HB_USHORT uiClass )
{
if( pdispVal )
{
if( hb_vmRequestReenter() )
{
PHB_SYMB pClassFunc;
PHB_ITEM pObject, pPtrGC;
pClassFunc = hb_clsFuncSym( uiClass );
if( ! pClassFunc )
pClassFunc = hb_dynsymSymbol( s_pDyns_hb_oleauto );
hb_vmPushSymbol( pClassFunc );
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 actually can be stack's return item!
*/
hb_itemMove( pItem, pObject );
hb_itemRelease( pObject );
}
}
}
void hb_oleVariantToItemEx( PHB_ITEM pItem, VARIANT * pVariant, HB_USHORT uiClass )
{
if( V_VT( pVariant ) == ( VT_VARIANT | VT_BYREF ) )
pVariant = V_VARIANTREF( pVariant );
switch( V_VT( pVariant ) )
{
case VT_UNKNOWN:
case VT_UNKNOWN | VT_BYREF:
{
IDispatch * pdispVal = NULL;
IUnknown * punkVal = V_VT( pVariant ) == VT_UNKNOWN ?
V_UNKNOWN( pVariant ) :
*V_UNKNOWNREF( pVariant );
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, uiClass );
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
break;
}
case VT_DISPATCH:
case VT_DISPATCH | VT_BYREF:
hb_itemClear( pItem );
hb_oleDispatchToItem( pItem, V_VT( pVariant ) == VT_DISPATCH ?
V_DISPATCH( pVariant ) :
*V_DISPATCHREF( pVariant ), uiClass );
break;
case VT_BSTR:
hb_oleStringToItem( V_BSTR( pVariant ), pItem );
break;
case VT_BSTR | VT_BYREF:
hb_oleStringToItem( *V_BSTRREF( pVariant ), pItem );
break;
case VT_BOOL:
hb_itemPutL( pItem, V_BOOL( pVariant ) ? HB_TRUE : HB_FALSE );
break;
case VT_BOOL | VT_BYREF:
hb_itemPutL( pItem, *V_BOOLREF( pVariant ) ? HB_TRUE : HB_FALSE );
break;
case VT_I1:
hb_itemPutNI( pItem, ( signed char ) V_I1( pVariant ) );
break;
case VT_I1 | VT_BYREF:
hb_itemPutNI( pItem, ( signed char ) *V_I1REF( pVariant ) );
break;
case VT_I2:
hb_itemPutNI( pItem, ( short ) V_I2( pVariant ) );
break;
case VT_I2 | VT_BYREF:
hb_itemPutNI( pItem, ( short ) *V_I2REF( pVariant ) );
break;
case VT_I4:
hb_itemPutNL( pItem, V_I4( pVariant ) );
break;
case VT_I4 | VT_BYREF:
hb_itemPutNL( pItem, *V_I4REF( pVariant ) );
break;
case VT_I8:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) V_I4( pVariant ) );
#elif defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, *( ( HB_LONGLONG * ) &V_I4( pVariant ) ) );
#else
hb_itemPutNInt( pItem, V_I8( pVariant ) );
#endif
break;
case VT_I8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) *V_I4REF( pVariant ) );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, *( HB_LONGLONG * ) V_R8REF( pVariant ) );
#else
hb_itemPutNInt( pItem, *V_I8REF( pVariant ) );
#endif
break;
case VT_UI1:
hb_itemPutNI( pItem, ( unsigned char ) V_UI1( pVariant ) );
break;
case VT_UI1 | VT_BYREF:
hb_itemPutNI( pItem, ( unsigned char ) *V_UI1REF( pVariant ) );
break;
case VT_UI2:
hb_itemPutNI( pItem, ( unsigned short ) V_UI2( pVariant ) );
break;
case VT_UI2 | VT_BYREF:
hb_itemPutNI( pItem, ( unsigned short ) *V_UI2REF( pVariant ) );
break;
case VT_UI4:
hb_itemPutNInt( pItem, V_UI4( pVariant ) );
break;
case VT_UI4 | VT_BYREF:
hb_itemPutNInt( pItem, *V_UI4REF( pVariant ) );
break;
case VT_UI8:
/* TODO: sign is lost. Conversion to double will lose significant digits. */
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) V_UI4( pVariant ) );
#elif defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, *( ( HB_LONGLONG * ) &V_UI4( pVariant ) ) );
#else
hb_itemPutNInt( pItem, ( HB_MAXINT ) V_UI8( pVariant ) );
#endif
break;
case VT_UI8 | VT_BYREF:
/* TODO: sign is lost. Conversion to double will lose significant digits. */
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
hb_itemPutNInt( pItem, ( HB_MAXINT ) *V_UI4REF( pVariant ) );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
hb_itemPutNInt( pItem, *( HB_LONGLONG * ) V_R8REF( pVariant ) );
#else
hb_itemPutNInt( pItem, ( HB_MAXINT ) *V_UI8REF( pVariant ) );
#endif
break;
case VT_INT:
hb_itemPutNI( pItem, V_INT( pVariant ) );
break;
case VT_INT | VT_BYREF:
hb_itemPutNI( pItem, *V_INTREF( pVariant ) );
break;
case VT_UINT:
hb_itemPutNInt( pItem, V_UINT( pVariant ) );
break;
case VT_UINT | VT_BYREF:
hb_itemPutNInt( pItem, *V_UINTREF( pVariant ) );
break;
case VT_ERROR:
hb_itemPutNInt( pItem, V_ERROR( pVariant ) );
break;
case VT_ERROR | VT_BYREF:
hb_itemPutNInt( pItem, *V_ERRORREF( pVariant ) );
break;
case VT_R4:
hb_itemPutND( pItem, ( double ) V_R4( pVariant ) );
break;
case VT_R4 | VT_BYREF:
hb_itemPutND( pItem, ( double ) *V_R4REF( pVariant ) );
break;
case VT_R8:
hb_itemPutND( pItem, V_R8( pVariant ) );
break;
case VT_R8 | VT_BYREF:
hb_itemPutND( pItem, *V_R8REF( pVariant ) );
break;
case VT_CY:
case VT_CY | VT_BYREF:
{
double dblVal;
if( VarR8FromCy( V_VT( pVariant ) == VT_CY ?
V_CY( pVariant ) :
*V_CYREF( pVariant ), &dblVal ) != S_OK )
dblVal = 0;
hb_itemPutND( pItem, dblVal );
#if 0
hb_itemPutNDLen( pItem, dblVal, 0, 4 );
#endif
break;
}
case VT_DECIMAL:
case VT_DECIMAL | VT_BYREF:
{
double dblVal;
if( VarR8FromDec( V_VT( pVariant ) == VT_DECIMAL ?
&HB_WIN_U1( pVariant, decVal ) :
V_DECIMALREF( pVariant ), &dblVal ) != S_OK )
dblVal = 0;
hb_itemPutND( pItem, dblVal );
break;
}
case VT_DATE:
case VT_DATE | VT_BYREF:
{
long lJulian, lMilliSec;
double dblVal = V_VT( pVariant ) == VT_DATE ?
V_R8( pVariant ) :
*V_R8REF( pVariant );
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, V_BYREF( pVariant ) );
break;
#endif
case VT_EMPTY:
case VT_EMPTY | VT_BYREF:
case VT_NULL:
case VT_NULL | VT_BYREF:
hb_itemClear( pItem );
break;
default:
if( V_VT( pVariant ) & VT_ARRAY )
{
SAFEARRAY * pSafeArray = ( V_VT( pVariant ) & VT_BYREF ) ?
*V_ARRAYREF( pVariant ) :
V_ARRAY( pVariant );
if( pSafeArray )
{
int iDims = ( int ) SafeArrayGetDim( pSafeArray );
if( iDims >= 1 )
{
if( iDims > 1 || ! hb_oleSafeArrayToString( pItem, pSafeArray ) )
{
long * plIndex = ( long * ) hb_xgrab( iDims * sizeof( long ) );
hb_oleSafeArrayToItem( pItem, pSafeArray, iDims, 1, plIndex,
( VARTYPE ) ( V_VT( pVariant ) & ~( VT_ARRAY | VT_BYREF ) ),
uiClass );
hb_xfree( plIndex );
}
}
else
hb_arrayNew( pItem, 0 );
break;
}
}
/* possible RT error - unsupported variant */
hb_itemClear( pItem );
}
}
void hb_oleVariantToItem( PHB_ITEM pItem, VARIANT * pVariant )
{
hb_oleVariantToItemEx( pItem, pVariant, 0 );
}
void hb_oleVariantUpdate( VARIANT * pVariant, PHB_ITEM pItem,
HB_OLEOBJ_FUNC pObjFunc )
{
switch( V_VT( pVariant ) )
{
case VT_DISPATCH | VT_BYREF:
{
IDispatch * pDisp = hb_oleItemGetDispatch( pItem );
if( pDisp )
{
IDispatch * pdispVal = *V_DISPATCHREF( pVariant );
if( pdispVal != pDisp )
{
HB_VTBL( pDisp )->AddRef( HB_THIS( pDisp ) );
*V_DISPATCHREF( pVariant ) = 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 = *V_DISPATCHREF( pVariant );
*V_DISPATCHREF( pVariant ) = V_DISPATCH( &variant );
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 = *V_UNKNOWNREF( pVariant );
if( punkVal )
HB_VTBL( punkVal )->Release( HB_THIS( punkVal ) );
*V_UNKNOWNREF( pVariant ) = pUnk;
}
}
else if( pObjFunc && HB_IS_OBJECT( pItem ) )
{
VARIANTARG variant;
VariantInit( &variant );
if( pObjFunc( &variant, pItem ) )
{
IDispatch * pdispVal = *V_DISPATCHREF( pVariant );
*V_DISPATCHREF( pVariant ) = V_DISPATCH( &variant );
if( pdispVal )
HB_VTBL( pdispVal )->Release( HB_THIS( pdispVal ) );
}
}
break;
}
case VT_BSTR | VT_BYREF:
SysFreeString( *V_BSTRREF( pVariant ) );
*V_BSTRREF( pVariant ) = hb_oleItemToString( pItem );
break;
case VT_BOOL | VT_BYREF:
*V_BOOLREF( pVariant ) = ( VARIANT_BOOL ) hb_itemGetL( pItem );
break;
case VT_I1 | VT_BYREF:
*V_I1REF( pVariant ) = ( signed char ) hb_itemGetNI( pItem );
break;
case VT_I2 | VT_BYREF:
*V_I2REF( pVariant ) = ( short ) hb_itemGetNI( pItem );
break;
case VT_I4 | VT_BYREF:
*V_I4REF( pVariant ) = hb_itemGetNL( pItem );
break;
case VT_I8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
*V_I4REF( pVariant ) = ( long ) hb_itemGetNInt( pItem );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
*( HB_LONGLONG * ) V_R8REF( pVariant ) = ( HB_LONGLONG ) hb_itemGetNInt( pItem );
#else
*V_I8REF( pVariant ) = ( HB_LONGLONG ) hb_itemGetNInt( pItem );
#endif
break;
case VT_UI1 | VT_BYREF:
*V_UI1REF( pVariant ) = ( unsigned char ) hb_itemGetNI( pItem );
break;
case VT_UI2 | VT_BYREF:
*V_UI2REF( pVariant ) = ( unsigned short ) hb_itemGetNI( pItem );
break;
case VT_UI4 | VT_BYREF:
*V_UI4REF( pVariant ) = ( unsigned long ) hb_itemGetNL( pItem );
break;
case VT_UI8 | VT_BYREF:
#if HB_VMLONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
*V_UI4REF( pVariant ) = ( unsigned long ) hb_itemGetNInt( pItem );
#elif defined( HB_OLE_NO_LLREF )
/* workaround for wrong OLE variant structure definition */
*( HB_ULONGLONG * ) V_R8REF( pVariant ) = ( HB_ULONGLONG ) hb_itemGetNInt( pItem );
#else
*V_UI8REF( pVariant ) = ( HB_ULONGLONG ) hb_itemGetNInt( pItem );
#endif
break;
case VT_INT | VT_BYREF:
*V_INTREF( pVariant ) = hb_itemGetNI( pItem );
break;
case VT_UINT | VT_BYREF:
*V_UINTREF( pVariant ) = ( unsigned int ) hb_itemGetNI( pItem );
break;
case VT_ERROR | VT_BYREF:
*V_ERRORREF( pVariant ) = ( SCODE ) hb_itemGetNL( pItem );
break;
case VT_R4 | VT_BYREF:
*V_R4REF( pVariant ) = ( float ) hb_itemGetND( pItem );
break;
case VT_R8 | VT_BYREF:
*V_R8REF( pVariant ) = hb_itemGetND( pItem );
break;
case VT_CY | VT_BYREF:
VarCyFromR8( hb_itemGetND( pItem ), V_CYREF( pVariant ) );
break;
case VT_DECIMAL | VT_BYREF:
VarDecFromR8( hb_itemGetND( pItem ), V_DECIMALREF( pVariant ) );
break;
case VT_DATE | VT_BYREF:
*V_R8REF( pVariant ) = hb_itemGetTD( pItem ) - HB_OLE_DATE_BASE;
break;
#ifdef HB_OLE_PASS_POINTERS
case VT_PTR | VT_BYREF:
V_BYREF( pVariant ) = hb_itemGetPtr( pItem );
break;
#endif
case VT_BYREF | VT_VARIANT:
hb_oleItemToVariantRef( V_VARIANTREF( pVariant ), 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, HB_USHORT uiClass )
{
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( V_VT( &pParams->rgvarg[ i ] ) & 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( ( V_VT( &pParams->rgvarg[ iCount - i ] ) & VT_BYREF ) &&
( ii < iRefs ) )
{
refArray[ ii ].variant = &pParams->rgvarg[ iCount - i ];
hb_oleVariantToItemEx( refArray[ ii ].item,
refArray[ ii ].variant, uiClass );
hb_vmPushItemRef( refArray[ ii++ ].item );
}
else
hb_oleVariantToItemEx( hb_stackAllocItem(),
&pParams->rgvarg[ iCount - i ], uiClass );
}
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, HB_UINT uiOffset, HB_BOOL fUseRef,
UINT uiNamedArgs, PHB_ITEM * pNamedArgs, DISPID * pDispIds )
{
VARIANTARG * pArgs = NULL;
UINT uiArgCount;
uiArgCount = ( UINT ) hb_pcount();
if( uiOffset > uiArgCount )
uiArgCount = 0;
else
uiArgCount -= uiOffset;
if( uiArgCount > 0 || uiNamedArgs > 0 )
{
VARIANTARG * pRefs;
UINT uiArg, uiRefs;
uiRefs = 0;
if( fUseRef )
{
for( uiArg = 1; uiArg <= uiArgCount; uiArg++ )
{
if( HB_ISBYREF( uiOffset + uiArg ) )
uiRefs++;
}
}
pArgs = ( VARIANTARG * ) hb_xgrab( sizeof( VARIANTARG ) * ( uiArgCount + uiRefs + uiNamedArgs ) );
pRefs = &pArgs[ uiArgCount + uiNamedArgs ];
for( uiArg = 0; uiArg < uiNamedArgs; uiArg++ )
{
VARIANT * pVariant = &pArgs[ uiArg ];
VariantInit( pVariant );
hb_oleItemToVariantRef( pVariant, pNamedArgs[ uiArg ], NULL, NULL );
}
for( uiArg = 0; uiArg < uiArgCount; uiArg++ )
{
VARIANT * pVariant = &pArgs[ uiArg + uiNamedArgs ];
int iParam = ( int ) ( uiOffset + uiArgCount - uiArg );
VariantInit( pVariant );
if( fUseRef && HB_ISBYREF( iParam ) )
{
VariantInit( pRefs );
hb_oleItemToVariantRef( pRefs, hb_param( iParam, HB_IT_ANY ),
pVariant, NULL );
++pRefs;
}
else
hb_oleItemToVariantRef( pVariant, hb_param( iParam, HB_IT_ANY ), NULL, NULL );
}
}
dispparam->rgvarg = pArgs;
dispparam->cArgs = uiArgCount + uiNamedArgs;
dispparam->rgdispidNamedArgs = pDispIds;
dispparam->cNamedArgs = uiNamedArgs;
}
#define HB_OLE_MAX_NAMEDARGS 32
static HRESULT GetNamedParams( IDispatch * pDisp, OLECHAR * szMethodName, PHB_ITEM pHash,
UINT * puiNamedArgs, PHB_ITEM * pArgs, DISPID * pDispIds )
{
OLECHAR * pNames[ HB_OLE_MAX_NAMEDARGS + 1 ];
void * phStrings[ HB_OLE_MAX_NAMEDARGS ];
HB_SIZE nLen = hb_hashLen( pHash ), nPos;
int iArgs = 0, iArg;
HRESULT lOleError;
pNames[ 0 ] = szMethodName;
for( nPos = 1; nPos <= nLen; ++nPos )
{
PHB_ITEM pKey = hb_hashGetKeyAt( pHash, nPos );
if( HB_IS_STRING( pKey ) )
{
pNames[ iArgs + 1 ] = ( HB_WCHAR * ) HB_UNCONST( hb_itemGetStrU16( pKey, HB_CDP_ENDIAN_NATIVE, &phStrings[ iArgs ], NULL ) );
if( pNames[ iArgs + 1 ] != NULL )
{
pArgs[ iArgs ] = hb_hashGetValueAt( pHash, nPos );
if( ++iArgs == HB_OLE_MAX_NAMEDARGS )
break;
}
}
}
*puiNamedArgs = ( UINT ) iArgs;
lOleError = HB_VTBL( pDisp )->GetIDsOfNames( HB_THIS_( pDisp ) HB_ID_REF( IID_NULL ),
pNames, iArgs + 1, LOCALE_USER_DEFAULT, pDispIds );
for( iArg = 0; iArg < iArgs; ++iArg )
hb_strfree( phStrings[ iArg ] );
return lOleError;
}
static void PutParams( DISPPARAMS * dispparam, HB_UINT uiOffset, HB_USHORT uiClass )
{
VARIANTARG * pRefs = &dispparam->rgvarg[ dispparam->cArgs ];
PHB_ITEM pItem = NULL;
UINT uiArg;
if( dispparam->cNamedArgs > 0 )
++uiOffset;
for( uiArg = dispparam->cNamedArgs; uiArg < dispparam->cArgs; uiArg++ )
{
HB_USHORT uiParam = ( HB_USHORT ) ( uiOffset + dispparam->cArgs - uiArg );
if( HB_ISBYREF( uiParam ) )
{
if( ! pItem )
pItem = hb_itemNew( NULL );
hb_oleVariantToItemEx( pItem, &dispparam->rgvarg[ uiArg ], uiClass );
hb_itemParamStoreForward( uiParam, pItem );
VariantClear( pRefs );
pRefs++;
}
}
if( pItem )
hb_itemRelease( pItem );
}
static void FreeParams( DISPPARAMS * dispparam )
{
if( dispparam->cArgs > 0 )
{
UINT ui;
for( ui = 0; ui < dispparam->cArgs; ui++ )
VariantClear( &dispparam->rgvarg[ ui ] );
hb_xfree( dispparam->rgvarg );
}
}
/* PRG level functions and methods */
HB_FUNC( __OLEISDISP )
{
hb_retl( hb_oleItemGet( hb_param( 1, HB_IT_ANY ) ) != NULL );
}
HB_FUNC( WIN_OLECLASSEXISTS ) /* ( cOleName | cCLSID ) */
{
HB_BOOL fExists = HB_FALSE;
const char * cOleName = hb_parc( 1 );
if( cOleName )
{
CLSID ClassID;
wchar_t * cCLSID = AnsiToWide( cOleName );
if( cOleName[ 0 ] == '{' )
fExists = ( CLSIDFromString( ( LPOLESTR ) cCLSID, &ClassID ) == NOERROR );
else
fExists = ( CLSIDFromProgID( ( LPCOLESTR ) cCLSID, &ClassID ) == S_OK );
hb_xfree( cCLSID );
}
hb_retl( fExists );
}
HB_FUNC( __OLECREATEOBJECT ) /* ( cOleName | cCLSID [, cIID ] ) */
{
GUID ClassID, iid = IID_IDispatch;
IDispatch * pDisp = NULL;
const char * cOleName = hb_parc( 1 );
const char * cID = hb_parc( 2 );
HRESULT lOleError;
hb_oleInit();
if( cOleName )
{
wchar_t * 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;
hb_oleInit();
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 );
HB_VTBL( pUnk )->Release( HB_THIS( pUnk ) );
}
}
}
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;
IEnumVARIANT * pEnum;
VARIANTARG variant;
DISPPARAMS dispparam;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
pDisp = hb_oleParam( 1 );
if( ! pDisp )
return;
if( hb_parl( 2 ) )
{
hb_oleSetError( S_OK );
hb_errRT_OLE( EG_UNSUPPORTED, 1003, 0, NULL, HB_ERR_FUNCNAME, NULL );
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( V_VT( &variant ) == VT_UNKNOWN )
lOleError = HB_VTBL( V_UNKNOWN( &variant ) )->QueryInterface(
HB_THIS_( HB_WIN_U3( &variant, punkVal ) )
HB_ID_REF( IID_IEnumVARIANT ), ( void ** ) ( void * ) &pEnum );
else if( V_VT( &variant ) == VT_DISPATCH )
lOleError = HB_VTBL( HB_WIN_U3( &variant, pdispVal ) )->QueryInterface(
HB_THIS_( HB_WIN_U3( &variant, pdispVal ) )
HB_ID_REF( IID_IEnumVARIANT ), ( void ** ) ( void * ) &pEnum );
else
{
VariantClear( &variant );
hb_oleSetError( lOleError );
hb_errRT_OLE( EG_ARG, 1004, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME, NULL );
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, NULL );
}
HB_FUNC( __OLEENUMNEXT )
{
IEnumVARIANT * pEnum = hb_oleenumParam( 1 );
HB_BOOL fResult = HB_FALSE;
if( pEnum )
{
VARIANTARG variant;
hb_oleInit();
VariantInit( &variant );
if( HB_VTBL( pEnum )->Next( HB_THIS_( pEnum ) 1, &variant, NULL ) == S_OK )
{
hb_oleVariantToItemEx( hb_stackReturnItem(), &variant,
( HB_USHORT ) hb_parni( 3 ) );
VariantClear( &variant );
fResult = HB_TRUE;
}
}
hb_storl( fResult, 2 );
}
HB_FUNC( WIN_OLEERROR )
{
hb_retnint( hb_oleGetError() );
}
#ifndef DISP_E_BUFFERTOOSMALL
#define DISP_E_BUFFERTOOSMALL 0x80020013L
#endif
HB_FUNC( WIN_OLEERRORTEXT )
{
HRESULT lOleError = HB_ISNUM( 1 ) ? hb_parnl( 1 ) : 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_PENDING: hb_retc_const( "E_PENDING" ); break;
case E_NOTIMPL: hb_retc_const( "E_NOTIMPL" ); break;
case E_NOINTERFACE: hb_retc_const( "E_NOINTERFACE" ); break;
case E_POINTER: hb_retc_const( "E_POINTER" ); break;
case E_ABORT: hb_retc_const( "E_ABORT" ); break;
case E_FAIL: hb_retc_const( "E_FAIL" ); break;
case E_UNEXPECTED: hb_retc_const( "E_UNEXPECTED" ); break;
case E_ACCESSDENIED: hb_retc_const( "E_ACCESSDENIED" ); break;
case E_HANDLE: hb_retc_const( "E_HANDLE" ); break;
case E_OUTOFMEMORY: hb_retc_const( "E_OUTOFMEMORY" ); break;
case E_INVALIDARG: hb_retc_const( "E_INVALIDARG" ); break;
case DISP_E_UNKNOWNINTERFACE: hb_retc_const( "DISP_E_UNKNOWNINTERFACE" ); break;
case DISP_E_MEMBERNOTFOUND: hb_retc_const( "DISP_E_MEMBERNOTFOUND" ); 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_UNKNOWNNAME: hb_retc_const( "DISP_E_UNKNOWNNAME" ); break;
case DISP_E_NONAMEDARGS: hb_retc_const( "DISP_E_NONAMEDARGS" ); 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_OVERFLOW: hb_retc_const( "DISP_E_OVERFLOW" ); break;
case DISP_E_BADINDEX: hb_retc_const( "DISP_E_BADINDEX" ); break;
case DISP_E_UNKNOWNLCID: hb_retc_const( "DISP_E_UNKNOWNLCID" ); break;
case DISP_E_ARRAYISLOCKED: hb_retc_const( "DISP_E_ARRAYISLOCKED" ); break;
case DISP_E_BADPARAMCOUNT: hb_retc_const( "DISP_E_BADPARAMCOUNT" ); break;
case DISP_E_PARAMNOTOPTIONAL: hb_retc_const( "DISP_E_PARAMNOTOPTIONAL" ); break;
case DISP_E_BADCALLEE: hb_retc_const( "DISP_E_BADCALLEE" ); break;
case DISP_E_NOTACOLLECTION: hb_retc_const( "DISP_E_NOTACOLLECTION" ); break;
case DISP_E_DIVBYZERO: hb_retc_const( "DISP_E_DIVBYZERO" ); break;
case DISP_E_BUFFERTOOSMALL: hb_retc_const( "DISP_E_BUFFERTOOSMALL" ); break;
default:
{
char buf[ 16 ];
hb_snprintf( buf, 16, "0x%08x", ( UINT ) ( HB_PTRUINT ) lOleError );
hb_retc( buf );
}
}
}
/*
VBScript and Harbour syntax and IDispatch:Invoke() usage differences
VBScript syntax dispid DISPATCH_* flags argcnt | Harbour syntax :Invoke parameters
================================================================+=======================================
obj DISPID_VALUE METHOD+PROPERTYGET 0 | Same :Invoke is not used
obj() DISPID_VALUE METHOD 0 | Not supported
obj(param) DISPID_VALUE METHOD+PROPERTYGET 1 | obj[param] Same
obj.name name METHOD+PROPERTYGET 0 | Same, =obj.name() Same
obj.name() name METHOD 0 | Same, =obj.name flags=METHOD+PROPERTYGET
obj.name(param) name METHOD+PROPERTYGET 1 | Same Same
|
obj = value obj reassigned, :Invoke is not used | Same
obj() = value DISPID_VALUE PROPERTYPUT 1 | Not supported
obj(param) = value DISPID_VALUE PROPERTYPUT 2 | obj[param] = value
obj.name = value name PROPERTYPUT 1 | Same Same
obj.name() = value name PROPERTYPUT 1 | Not supported, use obj.name = value
obj.name(param) = value name PROPERTYPUT 2 | Not supported, workaround obj._name(param, value)
*/
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;
HB_USHORT uiClass;
int iPCount;
hb_oleInit();
uiClass = hb_objGetClass( hb_stackSelfItem() );
if( uiClass == 0 )
return;
/* Get object handle */
hb_vmPushDynSym( s_pDyns_hObjAccess );
hb_vmPush( hb_stackSelfItem() );
hb_vmSend( 0 );
pDisp = hb_oleParam( -1 );
if( ! pDisp )
return;
dispid = ( DISPID ) 0; /* to pacify MSVC false warning */
iPCount = hb_pcount();
szMethod = hb_itemGetSymbol( hb_stackBaseItem() )->szName;
AnsiToWideBuffer( szMethod, szMethodWide, ( int ) HB_SIZEOFARRAY( szMethodWide ) );
/* Try property put */
if( szMethod[ 0 ] == '_' && iPCount >= 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;
WORD wFlags;
memset( &excep, 0, sizeof( excep ) );
GetParams( &dispparam, 0, HB_FALSE, 0, NULL, NULL );
dispparam.rgdispidNamedArgs = &lPropPut;
dispparam.cNamedArgs = 1;
wFlags = V_VT( &dispparam.rgvarg[ 0 ] ) == VT_DISPATCH ? DISPATCH_PROPERTYPUTREF :
DISPATCH_PROPERTYPUT;
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) dispid, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT, wFlags,
&dispparam, NULL, &excep, &uiArgErr );
if( lOleError == DISP_E_MEMBERNOTFOUND && wFlags == DISPATCH_PROPERTYPUTREF )
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( iPCount, HB_IT_ANY ) );
hb_oleSetError( lOleError );
if( lOleError != S_OK )
{
char * szDescription = NULL;
char * szSource = NULL;
if( lOleError == DISP_E_EXCEPTION )
hb_oleExcepDescription( &excep, &szDescription, &szSource );
hb_errRT_OLE( EG_ARG, 1006, ( HB_ERRCODE ) lOleError, szDescription, HB_ERR_FUNCNAME, szSource );
if( szSource )
hb_xfree( szSource );
if( szDescription )
hb_xfree( szDescription );
}
return;
}
}
/* Try property get and invoke */
if( iPCount >= 1 && HB_ISHASH( 1 ) )
{
/* named parameters are passed in hash array */
PHB_ITEM pArgs[ HB_OLE_MAX_NAMEDARGS ];
DISPID pDispIds[ HB_OLE_MAX_NAMEDARGS + 1 ];
UINT uiNamedArgs;
lOleError = GetNamedParams( pDisp, szMethodWide, hb_param( 1, HB_IT_HASH ),
&uiNamedArgs, pArgs, pDispIds );
if( lOleError == S_OK )
{
dispid = pDispIds[ 0 ];
GetParams( &dispparam, 1, HB_TRUE, uiNamedArgs, pArgs, &pDispIds[ 1 ] );
}
}
else
{
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 )
GetParams( &dispparam, 0, HB_TRUE, 0, NULL, NULL );
}
if( lOleError == S_OK )
{
memset( &excep, 0, sizeof( excep ) );
VariantInit( &variant );
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, 0, uiClass );
FreeParams( &dispparam );
hb_oleVariantToItemEx( hb_stackReturnItem(), &variant, uiClass );
VariantClear( &variant );
hb_oleSetError( lOleError );
if( lOleError != S_OK )
{
char * szDescription = NULL;
char * szSource = NULL;
if( lOleError == DISP_E_EXCEPTION )
hb_oleExcepDescription( &excep, &szDescription, &szSource );
hb_errRT_OLE( EG_ARG, 1007, ( HB_ERRCODE ) lOleError, szDescription, HB_ERR_FUNCNAME, szSource );
if( szSource )
hb_xfree( szSource );
if( szDescription )
hb_xfree( szDescription );
}
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, NULL );
else
hb_errRT_OLE( EG_NOMETHOD, 1009, ( HB_ERRCODE ) lOleError, NULL, szMethod, NULL );
}
HB_FUNC( WIN_OLEAUTO___OPINDEX )
{
IDispatch * pDisp;
DISPPARAMS dispparam;
VARIANTARG variant;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
HB_BOOL fAssign;
HB_USHORT uiClass;
hb_oleInit();
uiClass = hb_objGetClass( hb_stackSelfItem() );
if( uiClass == 0 )
return;
/* Get object handle */
hb_vmPushDynSym( s_pDyns_hObjAccess );
hb_vmPush( hb_stackSelfItem() );
hb_vmSend( 0 );
pDisp = hb_oleParam( -1 );
if( ! pDisp )
return;
fAssign = hb_pcount() > 1;
if( fAssign )
{
/* Assign */
DISPID lPropPut = DISPID_PROPERTYPUT;
memset( &excep, 0, sizeof( excep ) );
GetParams( &dispparam, 0, HB_FALSE, 0, NULL, NULL );
dispparam.rgdispidNamedArgs = &lPropPut;
dispparam.cNamedArgs = 1;
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) DISPID_VALUE, 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( hb_pcount(), HB_IT_ANY ) );
}
else
{
/* Access */
memset( &excep, 0, sizeof( excep ) );
VariantInit( &variant );
GetParams( &dispparam, 0, HB_TRUE, 0, NULL, NULL );
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) DISPID_VALUE, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET | DISPATCH_METHOD,
&dispparam, &variant, &excep, &uiArgErr );
PutParams( &dispparam, 0, uiClass );
FreeParams( &dispparam );
hb_oleVariantToItemEx( hb_stackReturnItem(), &variant, uiClass );
VariantClear( &variant );
}
hb_oleSetError( lOleError );
if( lOleError != S_OK )
{
/* Try to detect if object is a collection */
char * szDescription = NULL;
char * szSource = NULL;
HRESULT lOleErrorEnum;
if( lOleError == DISP_E_EXCEPTION )
hb_oleExcepDescription( &excep, &szDescription, &szSource );
memset( &excep, 0, sizeof( excep ) );
memset( &dispparam, 0, sizeof( dispparam ) );
VariantInit( &variant );
lOleErrorEnum = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) DISPID_NEWENUM, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT,
DISPATCH_PROPERTYGET,
&dispparam, &variant, &excep, &uiArgErr );
VariantClear( &variant );
hb_errRT_OLE( lOleErrorEnum == S_OK ? EG_BOUND : EG_ARG, 1016, ( HB_ERRCODE ) lOleError,
lOleErrorEnum == S_OK ? hb_langDGetErrorDesc( fAssign ? EG_ARRASSIGN : EG_ARRACCESS ) : szDescription,
NULL, szSource );
if( szDescription )
hb_xfree( szDescription );
if( szSource )
hb_xfree( szSource );
}
}
HB_FUNC( __OLEGETNAMEID )
{
IDispatch * pDisp;
pDisp = hb_oleParam( 1 );
if( pDisp )
{
OLECHAR * pwszMethod;
HRESULT lOleError;
void * hMethod;
DISPID dispid;
pwszMethod = ( HB_WCHAR * ) hb_parstr_u16( 2, HB_CDP_ENDIAN_NATIVE, &hMethod, NULL );
lOleError = HB_VTBL( pDisp )->GetIDsOfNames( HB_THIS_( pDisp ) HB_ID_REF( IID_NULL ),
&pwszMethod, 1, LOCALE_USER_DEFAULT, &dispid );
hb_strfree( hMethod );
if( lOleError == S_OK )
hb_retnint( dispid );
}
}
static void hb_oleInvokeCall( WORD wFlags )
{
HB_USHORT uiOffset = 0;
PHB_ITEM pObject;
IDispatch * pDisp;
pObject = hb_stackSelfItem();
if( HB_IS_NIL( pObject ) )
pObject = hb_param( ++uiOffset, HB_IT_ANY );
pDisp = pObject ? hb_oleItemGetDispatch( pObject ) : NULL;
if( pDisp )
{
DISPID dispid;
DISPPARAMS dispparam;
VARIANTARG variant;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError;
HB_USHORT uiClass;
OLECHAR * pwszMethod;
void * hMethod;
uiClass = hb_objGetClass( pObject );
++uiOffset;
pwszMethod = ( HB_WCHAR * ) hb_parstr_u16( uiOffset, HB_CDP_ENDIAN_NATIVE, &hMethod, NULL );
if( pwszMethod )
{
lOleError = HB_VTBL( pDisp )->GetIDsOfNames( HB_THIS_( pDisp ) HB_ID_REF( IID_NULL ),
&pwszMethod, 1, LOCALE_USER_DEFAULT, &dispid );
hb_strfree( hMethod );
}
else
{
dispid = ( DISPID ) hb_parnint( uiOffset );
lOleError = S_OK;
}
if( lOleError == S_OK )
{
DISPID lPropPut = wFlags;
HB_BOOL fPut = wFlags == DISPATCH_PROPERTYPUT;
memset( &excep, 0, sizeof( excep ) );
VariantInit( &variant );
GetParams( &dispparam, uiOffset, ! fPut, 0, NULL, NULL );
if( fPut )
{
dispparam.rgdispidNamedArgs = &lPropPut;
dispparam.cNamedArgs = 1;
}
lOleError = HB_VTBL( pDisp )->Invoke( HB_THIS_( pDisp ) dispid, HB_ID_REF( IID_NULL ),
LOCALE_USER_DEFAULT, wFlags,
&dispparam, &variant, &excep, &uiArgErr );
if( ! fPut )
PutParams( &dispparam, uiOffset, uiClass );
FreeParams( &dispparam );
hb_oleVariantToItemEx( hb_stackReturnItem(), &variant, uiClass );
VariantClear( &variant );
hb_oleSetError( lOleError );
if( lOleError != S_OK )
{
char * szExcepDescription = NULL;
char * szExcepSource = NULL;
if( lOleError == DISP_E_EXCEPTION )
hb_oleExcepDescription( &excep, &szExcepDescription, &szExcepSource );
hb_errRT_OLE( EG_ARG, 1007, ( HB_ERRCODE ) lOleError, szExcepDescription, HB_ERR_FUNCNAME, szExcepSource );
if( szExcepDescription )
hb_xfree( szExcepDescription );
if( szExcepSource )
hb_xfree( szExcepSource );
}
return;
}
hb_errRT_OLE( EG_NOMETHOD, 1009, ( HB_ERRCODE ) lOleError, NULL, hb_parc( uiOffset ), NULL );
}
else
hb_errRT_OLE( EG_ARG, 1001, 0, NULL, HB_ERR_FUNCNAME, NULL );
}
HB_FUNC( __OLEINVOKEMETHOD )
{
hb_oleInvokeCall( DISPATCH_METHOD );
}
HB_FUNC( __OLEINVOKEGET )
{
hb_oleInvokeCall( DISPATCH_PROPERTYGET );
}
HB_FUNC( __OLEINVOKEPUT )
{
hb_oleInvokeCall( DISPATCH_PROPERTYPUT );
}
/* __oleVariantGetValue( <pVariant> ) --> <xValue> */
HB_FUNC( __OLEVARIANTGETVALUE )
{
VARIANT * pVariant = hb_oleVariantParam( 1 );
if( pVariant )
hb_oleVariantToItemEx( hb_stackReturnItem(), pVariant, 0 );
}
/* __oleVariantGetType( <pVariant> ) --> <nVariantType> */
HB_FUNC( __OLEVARIANTGETTYPE )
{
VARIANT * pVariant = hb_oleVariantParam( 1 );
if( pVariant )
hb_retni( V_VT( pVariant ) );
}
/* __oleVariantNew( <nVariantType>, [<xInitValue>], [<nDims,...>] ) --> <pVariant> */
HB_FUNC( __OLEVARIANTNEW )
{
int iType = hb_parni( 1 );
PHB_ITEM pInit = hb_param( 2, HB_IT_ANY );
IDispatch * pDisp;
VARIANT variant;
V_VT( &variant ) = VT_ILLEGAL;
if( pInit && HB_IS_ARRAY( pInit ) && iType == ( iType & VT_TYPEMASK ) )
iType |= VT_ARRAY;
switch( iType )
{
case VT_EMPTY:
case VT_NULL:
V_VT( &variant ) = ( VARTYPE ) ( iType );
break;
case VT_BOOL:
if( pInit == NULL || HB_IS_LOGICAL( pInit ) )
{
V_VT( &variant ) = VT_BOOL;
V_BOOL( &variant ) = hb_itemGetL( pInit ) ? TRUE : FALSE;
}
break;
case VT_I1:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_I1;
V_I1( &variant ) = ( signed char ) hb_itemGetNI( pInit );
}
break;
case VT_I2:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_I2;
V_I2( &variant ) = ( short ) hb_itemGetNI( pInit );
}
break;
case VT_I4:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_I4;
V_I4( &variant ) = hb_itemGetNL( pInit );
}
break;
case VT_I8:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_I8;
#if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
*( ( HB_LONGLONG * ) &V_I4( &variant ) ) = hb_itemGetNInt( pInit );
#else
V_I8( &variant ) = hb_itemGetNInt( pInit );
#endif
}
break;
case VT_UI1:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_UI1;
V_UI1( &variant ) = ( unsigned char ) hb_itemGetNI( pInit );
}
break;
case VT_UI2:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_UI2;
V_UI2( &variant ) = ( unsigned short ) hb_itemGetNI( pInit );
}
break;
case VT_UI4:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_UI4;
V_UI4( &variant ) = hb_itemGetNL( pInit );
}
break;
case VT_UI8:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_UI8;
#if defined( HB_OLE_NO_LL )
/* workaround for wrong OLE variant structure definition */
*( ( HB_ULONGLONG * ) &V_I4( &variant ) ) = hb_itemGetNInt( pInit );
#else
V_UI8( &variant ) = hb_itemGetNInt( pInit );
#endif
}
break;
case VT_INT:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_INT;
V_INT( &variant ) = hb_itemGetNI( pInit );
}
break;
case VT_UINT:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_UINT;
V_UINT( &variant ) = ( UINT ) hb_itemGetNI( pInit );
}
break;
case VT_ERROR:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_ERROR;
V_ERROR( &variant ) = ( SCODE ) hb_itemGetNL( pInit );
}
break;
case VT_R4:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_R4;
V_R4( &variant ) = ( float ) hb_itemGetND( pInit );
}
break;
case VT_R8:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_R8;
V_R8( &variant ) = hb_itemGetND( pInit );
}
break;
case VT_CY:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_CY;
VarCyFromR8( hb_itemGetND( pInit ), &V_CY( &variant ) );
}
break;
case VT_DECIMAL:
if( pInit == NULL || HB_IS_NUMERIC( pInit ) )
{
V_VT( &variant ) = VT_DECIMAL;
VarDecFromR8( hb_itemGetND( pInit ), &HB_WIN_U1( &variant, decVal ) /*&V_DECIMAL( &variant )*/ );
}
break;
case VT_DATE:
if( pInit == NULL || HB_IS_DATETIME( pInit ) )
{
V_VT( &variant ) = VT_DATE;
V_R8( &variant ) = hb_itemGetTD( pInit ) - HB_OLE_DATE_BASE;
}
break;
#ifdef HB_OLE_PASS_POINTERS
case VT_PTR:
if( pInit == NULL || HB_IS_POINTER( pInit ) )
{
V_VT( &variant ) = VT_PTR;
V_BYREF( &variant ) = hb_itemGetPtr( pInit );
}
break;
#endif
case VT_BSTR:
if( pInit == NULL || HB_IS_STRING( pInit ) )
{
V_VT( &variant ) = VT_BSTR;
V_BSTR( &variant ) = hb_oleItemToString( pInit );
}
break;
case VT_UNKNOWN:
pDisp = hb_oleItemGetDispatch( pInit );
if( pDisp )
{
if( HB_VTBL( pDisp )->QueryInterface( HB_THIS_( pDisp )
HB_ID_REF( IID_IEnumVARIANT ),
( void ** ) ( void * ) &V_UNKNOWN( &variant ) ) == S_OK )
{
V_VT( &variant ) = VT_UNKNOWN;
}
}
break;
case VT_DISPATCH:
pDisp = hb_oleItemGetDispatch( pInit );
if( pDisp )
{
V_VT( &variant ) = VT_DISPATCH;
V_DISPATCH( &variant ) = pDisp;
HB_VTBL( pDisp )->AddRef( HB_THIS( pDisp ) );
}
break;
case VT_VARIANT:
VariantInit( &variant );
if( pInit != NULL )
hb_oleItemToVariant( &variant, pInit );
break;
default:
if( iType & VT_ARRAY )
{
iType &= ~VT_ARRAY;
if( iType == ( iType & VT_TYPEMASK ) )
{
long plBuf[ 16 ], * plSize;
int iPCount = hb_pcount() - 2, iDims;
if( iPCount < 0 )
iPCount = 0;
iDims = iPCount;
plSize = iDims < ( int ) HB_SIZEOFARRAY( plBuf ) ? plBuf :
( long * ) hb_xgrab( sizeof( long ) * iDims );
while( iPCount > 0 && HB_ISNIL( iPCount + 2 ) )
--iPCount;
while( iPCount > 0 )
{
--iPCount;
plSize[ iPCount ] = hb_parnl( iPCount + 3 );
if( plSize[ iPCount ] <= 0 )
break;
}
if( iPCount <= 0 )
{
V_ARRAY( &variant ) = hb_oleSafeArrayFromItem( pInit, ( VARTYPE ) iType, iDims, plSize );
if( V_ARRAY( &variant ) )
V_VT( &variant ) = ( VARTYPE ) ( iType | VT_ARRAY );
}
if( plSize != plBuf )
hb_xfree( plBuf );
break;
}
}
break;
}
if( V_VT( &variant ) != VT_ILLEGAL )
hb_oleItemPutVariant( hb_stackReturnItem(), &variant, HB_TRUE );
else
hb_errRT_OLE( EG_ARG, 1018, 0, NULL, HB_ERR_FUNCNAME, NULL );
}
/* __oleVariantNullDate( [<lNewNullDateFlag>] ) --> <lPrevNullDateFlag> */
HB_FUNC( __OLEVARIANTNULLDATE )
{
hb_retl( hb_oleGetNullDateFlag() );
if( HB_ISLOG( 1 ) )
hb_oleSetNullDateFlag( hb_parl( 1 ) );
}
/* __oleVariantNil2Null( [<lNewNil2NullFlag>] ) --> <lPrevNil2NullFlag> */
HB_FUNC( __OLEVARIANTNIL2NULL )
{
hb_retl( hb_oleGetNil2NullFlag() );
if( HB_ISLOG( 1 ) )
hb_oleSetNil2NullFlag( hb_parl( 1 ) );
}
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
Reference in New Issue View Git Blame Copy Permalink