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

2017-05-12 17:21 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* contrib/hbwin/oleauto.prg
  * contrib/hbwin/olecore.c
  * contrib/hbwin/hbwin.hbx
    * code cleanups and some synchronizations with Viktor's branch
    + added new PRG function borrowed from Viktor's branch:
         win_oleClassExists( <cOleName> | <cCLSID> ) -> <lExists>
This commit is contained in:
Przemysław Czerpak
2017-05-12 17:21:05 +02:00
parent 21a7ff7582
commit a105eb54cc
4 changed files with 67 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
ChangeLog.txt
View File

@@ -10,6 +10,14 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2017-05-12 17:21 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* contrib/hbwin/oleauto.prg
* contrib/hbwin/olecore.c
* contrib/hbwin/hbwin.hbx
* code cleanups and some synchronizations with Viktor's branch
+ added new PRG function borrowed from Viktor's branch:
win_oleClassExists( <cOleName> | <cCLSID> ) -> <lExists>
2017-05-12 14:12 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* contrib/hbwin/olecore.c
+ added support for typed variant references created by __oleVariantNew()

1
contrib/hbwin/hbwin.hbx
View File

@@ -341,6 +341,7 @@ DYNAMIC win_OEMToANSI
DYNAMIC win_oleAuto
DYNAMIC win_oleAuto___OnError
DYNAMIC win_oleAuto___OpIndex
DYNAMIC win_oleClassExists
DYNAMIC win_oleCreateObject
DYNAMIC win_oleError
DYNAMIC win_oleErrorText

9
contrib/hbwin/oleauto.prg
View File

@@ -70,8 +70,7 @@ METHOD __enumStart( enum, lDescend ) CLASS win_oleAuto
LOCAL hObjEnum
hObjEnum := __oleEnumCreate( ::__hObj, lDescend )
IF ! Empty( hObjEnum )
IF ! Empty( hObjEnum := __oleEnumCreate( ::__hObj, lDescend ) )
IF ! Empty( ::__hObjEnum )
/* small hack - clone the object array for nested FOR EACH calls */
self := __objClone( self )
@@ -111,8 +110,7 @@ FUNCTION win_oleGetActiveObject( ... )
LOCAL oOle, hOle
hOle := __oleGetActiveObject( ... )
IF ! Empty( hOle )
IF ! Empty( hOle := __oleGetActiveObject( ... ) )
oOle := win_oleAuto()
oOle:__hObj := hOle
ENDIF
@@ -124,8 +122,7 @@ FUNCTION win_oleCreateObject( ... )
LOCAL oOle, hOle
hOle := __oleCreateObject( ... )
IF ! Empty( hOle )
IF ! Empty( hOle := __oleCreateObject( ... ) )
oOle := win_oleAuto()
oOle:__hObj := hOle
ENDIF

85
contrib/hbwin/olecore.c
View File

@@ -55,7 +55,7 @@
#if ( defined( __POCC__ ) && defined( HB_OS_WIN_CE ) ) || \
defined( __DMC__ ) || \
( defined( _MSC_VER ) && ( _MSC_VER <= 1500 ) )
# define HB_OLE_NO_LL
#define HB_OLE_NO_LL
#endif
#if ( defined( __POCC__ ) && defined( HB_OS_WIN_CE ) ) || \
@@ -63,7 +63,7 @@
defined( __MINGW32__ ) || \
defined( __DMC__ ) || \
( defined( _MSC_VER ) && ( _MSC_VER <= 1500 ) )
# define HB_OLE_NO_LLREF
#define HB_OLE_NO_LLREF
#endif
@@ -364,10 +364,10 @@ void hb_oleItemSetCallBack( PHB_ITEM pItem, PHB_ITEM * pCallBack )
{
if( pOle->pCallBack && *pOle->pCallBack )
{
PHB_ITEM pCallBack = *pOle->pCallBack;
PHB_ITEM pCallBackPrev = *pOle->pCallBack;
*pOle->pCallBack = NULL;
pOle->pCallBack = NULL;
hb_itemRelease( pCallBack );
hb_itemRelease( pCallBackPrev );
}
if( pCallBack )
{
@@ -1049,10 +1049,9 @@ static void hb_oleSafeArrayToItem( PHB_ITEM pItem, SAFEARRAY * pSafeArray,
{
long lFrom, lTo;
SafeArrayGetLBound( pSafeArray, iDim, &lFrom );
SafeArrayGetUBound( pSafeArray, iDim, &lTo );
if( lFrom <= lTo )
if( SafeArrayGetLBound( pSafeArray, iDim, &lFrom ) == S_OK &&
SafeArrayGetUBound( pSafeArray, iDim, &lTo ) == S_OK &&
lFrom <= lTo )
{
HB_SIZE ul = 0;
@@ -1324,9 +1323,10 @@ void hb_oleVariantToItemEx( PHB_ITEM pItem, VARIANT * pVariant, HB_USHORT uiClas
case VT_CY | VT_BYREF:
{
double dblVal;
VarR8FromCy( V_VT( pVariant ) == VT_CY ?
V_CY( pVariant ) :
*V_CYREF( pVariant ), &dblVal );
if( VarR8FromCy( V_VT( pVariant ) == VT_CY ?
V_CY( pVariant ) :
*V_CYREF( pVariant ), &dblVal ) != S_OK )
dblVal = 0;
hb_itemPutND( pItem, dblVal );
/* hb_itemPutNDLen( pItem, dblVal, 0, 4 ); */
break;
@@ -1336,9 +1336,10 @@ void hb_oleVariantToItemEx( PHB_ITEM pItem, VARIANT * pVariant, HB_USHORT uiClas
case VT_DECIMAL | VT_BYREF:
{
double dblVal;
VarR8FromDec( V_VT( pVariant ) == VT_DECIMAL ?
&HB_WIN_U1( pVariant, decVal ) :
V_DECIMALREF( pVariant ), &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;
}
@@ -1377,7 +1378,7 @@ void hb_oleVariantToItemEx( PHB_ITEM pItem, VARIANT * pVariant, HB_USHORT uiClas
default:
if( V_VT( pVariant ) & VT_ARRAY )
{
SAFEARRAY * pSafeArray = V_VT( pVariant ) & VT_BYREF ?
SAFEARRAY * pSafeArray = ( V_VT( pVariant ) & VT_BYREF ) ?
*V_ARRAYREF( pVariant ) :
V_ARRAY( pVariant );
if( pSafeArray )
@@ -1674,8 +1675,8 @@ HB_BOOL hb_oleDispInvoke( PHB_SYMB pSym, PHB_ITEM pObject, PHB_ITEM pParam,
static void GetParams( DISPPARAMS * dispparam, HB_UINT uiOffset, HB_BOOL fUseRef,
UINT uiNamedArgs, PHB_ITEM * pNamedArgs, DISPID * pDispIds )
{
VARIANTARG * pArgs = NULL, * pRefs;
UINT uiArgCount, uiArg, uiRefs;
VARIANTARG * pArgs = NULL;
UINT uiArgCount;
uiArgCount = ( UINT ) hb_pcount();
if( uiOffset > uiArgCount )
@@ -1685,6 +1686,9 @@ static void GetParams( DISPPARAMS * dispparam, HB_UINT uiOffset, HB_BOOL fUseRef
if( uiArgCount > 0 || uiNamedArgs > 0 )
{
VARIANTARG * pRefs;
UINT uiArg, uiRefs;
uiRefs = 0;
if( fUseRef )
{
@@ -1795,10 +1799,10 @@ static void PutParams( DISPPARAMS * dispparam, HB_UINT uiOffset, HB_USHORT uiCla
static void FreeParams( DISPPARAMS * dispparam )
{
UINT ui;
if( dispparam->cArgs > 0 )
{
UINT ui;
for( ui = 0; ui < dispparam->cArgs; ui++ )
VariantClear( &dispparam->rgvarg[ ui ] );
@@ -1814,9 +1818,28 @@ 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 ] ) */
{
wchar_t * cCLSID;
GUID ClassID, iid = IID_IDispatch;
IDispatch * pDisp = NULL;
const char * cOleName = hb_parc( 1 );
@@ -1827,7 +1850,8 @@ HB_FUNC( __OLECREATEOBJECT ) /* ( cOleName | cCLSID [, cIID ] ) */
if( cOleName )
{
cCLSID = AnsiToWide( cOleName );
wchar_t * cCLSID = AnsiToWide( cOleName );
if( cOleName[ 0 ] == '{' )
lOleError = CLSIDFromString( ( LPOLESTR ) cCLSID, &ClassID );
else
@@ -2016,21 +2040,17 @@ HB_FUNC( __OLEENUMNEXT )
HB_FUNC( WIN_OLEERROR )
{
hb_retnl( hb_oleGetError() );
hb_retnint( hb_oleGetError() );
}
#ifndef DISP_E_BUFFERTOOSMALL
#define DISP_E_BUFFERTOOSMALL 0x80020013L
#define DISP_E_BUFFERTOOSMALL 0x80020013L
#endif
HB_FUNC( WIN_OLEERRORTEXT )
{
HRESULT lOleError;
if( HB_ISNUM( 1 ) )
lOleError = hb_parnl( 1 );
else
lOleError = hb_oleGetError();
HRESULT lOleError = HB_ISNUM( 1 ) ? hb_parnl( 1 ) : hb_oleGetError();
switch( lOleError )
{
@@ -2118,6 +2138,8 @@ HB_FUNC( WIN_OLEAUTO___ONERROR )
hb_oleInit();
uiClass = hb_objGetClass( hb_stackSelfItem() );
if( uiClass == 0 )
return;
/* Get object handle */
hb_vmPushDynSym( s_pDyns_hObjAccess );
@@ -2259,13 +2281,15 @@ HB_FUNC( WIN_OLEAUTO___OPINDEX )
VARIANTARG variant;
EXCEPINFO excep;
UINT uiArgErr;
HRESULT lOleError, lOleErrorEnum;
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 );
@@ -2323,6 +2347,7 @@ HB_FUNC( WIN_OLEAUTO___OPINDEX )
/* 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 );