From 05db0439434b8952a5703fd459f785da46c76b59 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sat, 29 May 2010 08:30:15 +0000 Subject: [PATCH] 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. --- harbour/ChangeLog | 16 ++++++ harbour/contrib/hbwin/olecore.c | 15 +++--- harbour/contrib/hbwin/tests/olesrv4.hbp | 9 ++++ harbour/contrib/hbwin/tests/olesrv4.prg | 66 +++++++++++++++++++++++++ harbour/contrib/hbwin/tests/oletst4.hbp | 7 +++ harbour/contrib/hbwin/tests/oletst4.prg | 47 ++++++++++++++++++ 6 files changed, 153 insertions(+), 7 deletions(-) create mode 100644 harbour/contrib/hbwin/tests/olesrv4.hbp create mode 100644 harbour/contrib/hbwin/tests/olesrv4.prg create mode 100644 harbour/contrib/hbwin/tests/oletst4.hbp create mode 100644 harbour/contrib/hbwin/tests/oletst4.prg 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