diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 0b908a893d..2e5707fa8a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,22 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-05-29 10:29 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/hbwin/olecore.c + ! fixed old bug in passing parameters by reference to OLE objects + (they were cleared in reverted order so half of the complex variants + were cleared before coping to HVM items) + + + harbour/contrib/hbwin/tests/oletst4.prg + + harbour/contrib/hbwin/tests/olesrv4.hbp + + harbour/contrib/hbwin/tests/olesrv4.prg + + harbour/contrib/hbwin/tests/oletst4.hbp + + added example of OLE server returning to client HVM objects as + OLE object and also some other values using parameters passed by + reference with client code. + Remember about registering the server by 'regsvr32 olesrv2.dll' + before testing the client code. + 2010-05-29 04:28 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * utils/hbmk2/hbmk2.prg ! Fixed silly variable initialization bug after last commit. diff --git a/harbour/contrib/hbwin/olecore.c b/harbour/contrib/hbwin/olecore.c index 5cd19860e8..58421e1da8 100644 --- a/harbour/contrib/hbwin/olecore.c +++ b/harbour/contrib/hbwin/olecore.c @@ -1126,7 +1126,8 @@ HB_BOOL hb_oleDispInvoke( PHB_SYMB pSym, PHB_ITEM pObject, PHB_ITEM pParam, for( i = 1, ii = 0; i <= iCount; i++ ) { - if( pParams->rgvarg[ iCount - i ].n1.n2.vt & VT_BYREF && ii < iRefs ) + 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 ); @@ -1170,9 +1171,9 @@ static void GetParams( DISPPARAMS * dispparam ) if( uiArgCount > 0 ) { uiRefs = 0; - for( uiArg = 0; uiArg < uiArgCount; uiArg++ ) + for( uiArg = 1; uiArg <= uiArgCount; uiArg++ ) { - if( HB_ISBYREF( uiArg + 1 ) ) + if( HB_ISBYREF( uiArg ) ) uiRefs++; } @@ -1206,14 +1207,14 @@ static void PutParams( DISPPARAMS * dispparam ) PHB_ITEM pItem = NULL; UINT uiArg; - for( uiArg = 1; uiArg <= dispparam->cArgs; uiArg++ ) + for( uiArg = 0; uiArg < dispparam->cArgs; uiArg++ ) { - if( HB_ISBYREF( uiArg ) ) + if( HB_ISBYREF( dispparam->cArgs - uiArg ) ) { if( !pItem ) pItem = hb_itemNew( NULL ); - hb_oleVariantToItem( pItem, &dispparam->rgvarg[ dispparam->cArgs - uiArg ] ); - hb_itemParamStoreForward( ( HB_USHORT ) uiArg, pItem ); + hb_oleVariantToItem( pItem, &dispparam->rgvarg[ uiArg ] ); + hb_itemParamStoreForward( ( HB_USHORT ) ( dispparam->cArgs - uiArg ), pItem ); VariantClear( pRefs ); pRefs++; } diff --git a/harbour/contrib/hbwin/tests/olesrv4.hbp b/harbour/contrib/hbwin/tests/olesrv4.hbp new file mode 100644 index 0000000000..114700de32 --- /dev/null +++ b/harbour/contrib/hbwin/tests/olesrv4.hbp @@ -0,0 +1,9 @@ +# +# $Id: olesrv3.hbp 14596 2010-05-25 23:44:42Z vszakats $ +# + +-hbdynvm + +../hbolesrv.hbc + +olesrv4.prg diff --git a/harbour/contrib/hbwin/tests/olesrv4.prg b/harbour/contrib/hbwin/tests/olesrv4.prg new file mode 100644 index 0000000000..0f1994b539 --- /dev/null +++ b/harbour/contrib/hbwin/tests/olesrv4.prg @@ -0,0 +1,66 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * demonstration/test code for OLE server returning to client + * HVM objects as OLE object. It's also test for parameters + * passed by reference. + * + * Copyright 2010 Przemyslaw Czerpak + * www - http://www.harbour-project.org + * + */ + + +#define CLS_Name "MyOleObjServer" +#define CLS_ID "{23245C3F-4487-404B-985F-E33886698D23}" + +#include "hbclass.ch" + +PROCEDURE DllMain() + + WIN_OleServerInit( CLS_ID, CLS_Name, OleObjServer():new() ) + +RETURN + + +CREATE CLASS OleObjServer + METHOD timer + METHOD info + METHOD ref +ENDCLASS + +METHOD timer() CLASS OleObjServer +RETURN timerCls():new() + +METHOD info() CLASS OleObjServer +RETURN infoCls():new() + +METHOD ref( p1, p2, p3, p4, p5, p6, p7 ) CLASS OleObjServer + p1 := date() + p2 := hb_datetime() + p3 := .t. + p4 := { "A", "B", "C" } + p5 := timerCls():new() + p6 := 123.456 + p7 := "text" +RETURN "DONE" + + +CREATE CLASS timerCls + MESSAGE date EXTERN date + MESSAGE time EXTERN time + MESSAGE now EXTERN hb_datetime +ENDCLASS + +CREATE CLASS infoCls + MESSAGE os EXTERN os + MESSAGE ver EXTERN version + MESSAGE compiler EXTERN hb_compiler + MESSAGE build EXTERN hb_builddate +ENDCLASS + +ANNOUNCE GT_SYS +REQUEST HB_GT_GUI_DEFAULT diff --git a/harbour/contrib/hbwin/tests/oletst4.hbp b/harbour/contrib/hbwin/tests/oletst4.hbp new file mode 100644 index 0000000000..746140de01 --- /dev/null +++ b/harbour/contrib/hbwin/tests/oletst4.hbp @@ -0,0 +1,7 @@ +# +# $Id: oletst3.hbp 14594 2010-05-25 22:23:11Z vszakats $ +# + +oletst4.prg + +-cflag={watcom}-6r diff --git a/harbour/contrib/hbwin/tests/oletst4.prg b/harbour/contrib/hbwin/tests/oletst4.prg new file mode 100644 index 0000000000..567a3fb6d4 --- /dev/null +++ b/harbour/contrib/hbwin/tests/oletst4.prg @@ -0,0 +1,47 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * demonstration/test client code for OLE server returning to client + * HVM objects as OLE object. It's also test for parameters + * passed by reference. + * + * Copyright 2010 Przemyslaw Czerpak + * www - http://www.harbour-project.org + */ + +PROCEDURE Main() + LOCAL oObject, oTime, oInfo + LOCAL p1, p2, p3, p4, p5, p6, p7 + + oObject := win_OleCreateObject( "MyOleObjServer" ) + + IF !Empty( oObject ) + oTime := oObject:timer() + ? "TIMER:" + ? " date:", oTime:date + ? " time:", oTime:time + ? " now:", oTime:now + oInfo := oObject:info() + ? "INFO:" + ? " os:", oInfo:os + ? " ver:", oInfo:ver + ? " compiler:", oInfo:compiler + ? " build:", oInfo:build + ? + ? "REF:", oObject:ref( @p1, @p2, @p3, @p4, @p5, @p6, @p7 ) + ? " p1:", hb_valToExp( p1 ) + ? " p2:", hb_valToExp( p2 ) + ? " p3:", hb_valToExp( p3 ) + ? " p4:", hb_valToExp( p4 ) + ? " p5:", p5:className() // hb_valToExp( p5 ) + ? " p6:", hb_valToExp( p6 ) + ? " p7:", hb_valToExp( p7 ) + ELSE + ? "Can not access 'MyOleObjServer' OLE server." + ENDIF + + WAIT +RETURN