To Antonio: Harbour OLE implementation

[vailtom]

Please, Antonio Linares can perhaps give us a suggestion about this ...
http://lists.harbour-project.org/piperm ... 19190.html

Many thanks,
Vailton

[Rossine]

Hello Antonio,

would be possible to implement these changes ?

[Antonio Linares]

Vailton, Rossine,

Those changes are welcome and will not break FWH code. They can move from numers to pointers. No problem about it.

FWH uses standard Class TOleAuto, so if Harbour code gets improved, its fine for FWH

[Rossine]

Hello Antonio,

Could we change that now for the next version ?

[Rossine]

Hello Antonio,

This error, still persists:

[ERROR]

Error description: Error BASE/3012 Argument error: NEW
Args:
[ 1] = N 1470288

Stack Calls
===========
Called from: => HB_OLEAUTO:NEW(0)
Called from: classes\ACTIVEX.PRG => TACTIVEX:NEW(0)
Called from: webexp.prg => MAIN(10)

[ENDERROR]

It is possible to reconcile with the activex FWH Harbour to FWH 9.05 version ?

[Rossine]

Hello Antonio,

Welcome to your home.

You can adjust the activex from fwh to work with latest version of the harbour ?

[Rossine]

up

[Antonio Linares]

Rossine,

Please use this function to generate a Harbour pointer:

Code: Select all

HB_FUNC( RETPTR ) // nValue --> Harbour_Pointer
{
   hb_retptr( ( void * ) hb_parnl( 1 ) );
}
 

Then modify this in Class TActiveX:

Code: Select all

::oOleAuto = TOleAuto():New( RetPtr( ActXPdisp( ::hActiveX ) ) )
 

[Rossine]

Hello Antonio,

The problem persist:

Code: Select all

Application
===========
   Path and name: C:\fwh\samples\webexp.exe (32 bits)
   Size: 1,492,992 bytes
   Time from start: 0 hours 0 mins 1 secs 
   Error occurred at: 06/13/09, 09:45:56
   Error description: Error BASE/3012  Argument error: NEW
   Args:
     [   1] = P   

Stack Calls
===========
   Called from:  => TOLEAUTO:NEW(0)
   Called from: classes\ACTIVEX.PRG => TACTIVEX:NEW(0)
   Called from: WEBEXP.prg => MAIN(10)
 

Here my activex.prg:

Code: Select all

// FiveWin ActiveX support (32/64 bits only)
// (c) FiveTech Software, all rights reserved

#include "FiveWin.ch"

#define  HKEY_CLASSES_ROOT       2147483648

//----------------------------------------------------------------------------//

CLASS TActiveX FROM TControl

   CLASSDATA lRegistered AS LOGICAL

   DATA   hActiveX
   DATA   cProgID
   DATA   cString
   DATA   aProperties, aMethods, aEvents
   DATA   bOnEvent
   DATA   oOleAuto

   METHOD New( oWnd, cProgID, nRow, nCol, nWidth, nHeight ) CONSTRUCTOR

   METHOD ReDefine( nId, oWnd, cProgID ) CONSTRUCTOR

   METHOD Do( cMethodName, uParam1, uParam2, uParam3, uParam4, uParam5 )

   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0

   METHOD EraseBkGnd( hDC ) INLINE 1

   METHOD GetProp( cPropName ) INLINE __ObjSendMsg( ::oOleAuto, cPropName )

   METHOD Initiate( hDlg )
   
   METHOD OnEvent( nEvent, aParams )

   METHOD ReadTypes()

   METHOD ReSize( nFlags, nWidth, nHeight ) INLINE ;
             ActXSetLocation( ::hActiveX, 0, 0, nWidth, nHeight )

   METHOD SetProp( cPropName, uParam1 ) INLINE __ObjSendMsg( ::oOleAuto, cPropName, uParam1 )
             
   METHOD Destroy() INLINE ActXEnd( ::hActiveX ), Super:Destroy()   
   
   ERROR HANDLER OnError( uParam1 )       
             
ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( oWnd, cProgID, nRow, nCol, nWidth, nHeight ) CLASS TActiveX

   DEFAULT oWnd := GetWndDefault(), nRow := 0, nCol := 0, nWidth := 200,;
           nHeight := 200

   ::nTop    = nRow
   ::nLeft   = nCol
   ::nBottom = nRow + nHeight
   ::nRight  = nCol + nWidth
   ::oWnd    = oWnd
   ::nId     = ::GetNewId()
   ::nStyle  = nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP )
   ::cProgID = cProgID
   ::cString = ActXString( cProgID )
   ::Register()

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
      ::hActiveX = CreateActiveX( ::hWnd, cProgID, Self )

msgstop( valtype( ::hActiveX ) )                       && Here return "Numeric"

msgstop( valtype( RetPtr( ActXPdisp( ::hActiveX ) ) ) )      && Here return "Pointer"

      ::oOleAuto = TOleAuto():New( RetPtr( ActXPdisp( ::hActiveX ) ) )
**      ::oOleAuto = TOleauto():New( ActXPdisp( ::hActiveX ) )
      ::nTop = nRow
      ::nLeft = nCol
      ::nWidth = nWidth
      ::nHeight = nHeight
      ::ReadTypes()
   else
      oWnd:DefControl( Self )
   endif

return Self

//----------------------------------------------------------------------------//

METHOD Do( ... ) CLASS TActiveX

#ifndef __XHARBOUR__
   return __ObjSendMsg( ::oOleAuto, ... )
#else
   local aParams := hb_aParams()

   AIns( aParams, 1, ::oOleAuto, .T. )

   return hb_execFromArray( @__ObjSendMsg(), aParams )   
#endif   

//----------------------------------------------------------------------------//

METHOD ReDefine( nId, oWnd, cProgID ) CLASS TActiveX

   DEFAULT oWnd := GetWndDefault()
   
   ::nId     = nId
   ::oWnd    = oWnd
   ::cProgID = cProgID
   ::cString = ActXString( cProgID )

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
   
   oWnd:DefControl( Self )

return Self

//----------------------------------------------------------------------------//

METHOD Initiate( hDlg ) CLASS TActiveX

   Super:Initiate( hDlg )

   ::hActiveX = CreateActiveX( ::hWnd, ::cProgID, Self )
   ::oOleAuto = TOleauto():New( ActXPdisp( ::hActiveX ) )
   ::ReadTypes()

return nil

//----------------------------------------------------------------------------//

METHOD OnEvent( nEvent, aParams ) CLASS TActiveX

   local nAt := AScan( ::aEvents, { | aEvent | aEvent[ 2 ] == nEvent } )
   local cEvent := If( nAt != 0, ::aEvents[ nAt ][ 1 ], "" )
   
   if ! Empty( ::bOnEvent )
      Eval( ::bOnEvent, If( ! Empty( cEvent ), cEvent, nEvent ), aParams )
   endif   

return nil

//----------------------------------------------------------------------------//

METHOD ReadTypes() CLASS TActiveX

   local oReg := TReg32():New( HKEY_CLASSES_ROOT, "CLSID\" + ::cString + ;
                               "\InprocServer32" )
   local cTypeLib := oReg:Get( "" )

   oReg:Close()
   
   if ! Empty( cTypeLib ) .and. File( cTypeLib )
      ::aEvents = ActXEvents( cTypeLib, ::hActiveX )
   endif   

return nil

//----------------------------------------------------------------------------//

METHOD OnError( ... ) CLASS TActiveX

#ifndef __XHARBOUR__
   return __ObjSendMsg( ::oOleAuto, __GetMessage(), ... )
#else
   local aParams := hb_aParams()

   AIns( aParams, 1, ::oOleAuto, .T. )
   AIns( aParams, 2, __GetMessage(), .T. )   

   return hb_execFromArray( @__ObjSendMsg(), aParams )   
#endif   

//----------------------------------------------------------------------------//

#pragma begindump

#include <windows.h>
#include <hbapi.h>

HB_FUNC( RETPTR ) // nValue --> Harbour_Pointer
{
   hb_retptr( ( void * ) hb_parnl( 1 ) );
}

#pragma ENDDUMP

I use fwh 9.04 + bcc (svn rev.11320).

Any more suggestions ?

[Antonio Linares]

Rossine,

Please try this code:

Code: Select all

#pragma BEGINDUMP

#include <hbapi.h>
#include <windows.h>

LPSTR hb_oleWideToAnsi( BSTR wString );

HB_FUNC( STRINGFROMCLSID )
{
   LPOLESTR pOleStr;
   LPSTR * psz;
 
   StringFromCLSID( ( REFCLSID ) hb_parnl( 1 ), &pOleStr );
   hb_retc( psz = hb_oleWideToAnsi( pOleStr ) );
   hb_xfree( psz );
}

#pragma ENDDUMP
 

Code: Select all

::oOleAuto = TOleAuto():New( STRINGFROMCLSID( ActXPdisp( ::hActiveX ) ) )
 

[Rossine]

Hello Antonio,

The problem persist

Code: Select all

Application
===========
   Path and name: C:\fwh\samples\webexp.exe (32 bits)
   Size: 1,492,992 bytes
   Time from start: 0 hours 0 mins 1 secs 
   Error occurred at: 06/15/09, 08:20:58
   Error description: Error BASE/3012  Argument error: NEW
   Args:
     [   1] = C   {403E0448-5608-4040-A84E-304028543040}

Stack Calls
===========
   Called from:  => TOLEAUTO:NEW(0)
   Called from: classes\ACTIVEX.PRG => TACTIVEX:NEW(0)
   Called from: webexp.prg => MAIN(10)
 

[Rossine]

Hello Antonio,

I updated the version of the harbour to 11.365 and now has changed message, see:

Code: Select all

Application
===========
   Path and name: C:\fwh\samples\webexp.exe (32 bits)
   Size: 1,492,992 bytes
   Time from start: 0 hours 0 mins 0 secs 
   Error occurred at: 06/15/09, 08:48:29
   Error description: Error BASE/3012  Argument error: NAVIGATE
   Args:
     [   1] = C   http://www.google.com.br

Stack Calls
===========
   Called from:  => TOLEAUTO:NAVIGATE(0)
   Called from:  => __OBJSENDMSG(0)
   Called from: classes\ACTIVEX.PRG => TACTIVEX:DO(0)
   Called from: webexp.prg => MAIN(15)

 

I test of three ways:

Code: Select all

::oOleAuto = TOleAuto():New( ActXPdisp( ::hActiveX ) )
...
::oOleAuto = TOleAuto():New( RetPtr( ActXPdisp( ::hActiveX ) ) )
...
::oOleAuto = TOleAuto():New( STRINGFROMCLSID( ActXPdisp( ::hActiveX ) ) )
...
 

strange

Here activex return "O":

Code: Select all

   oActiveX = TActiveX():New( oWnd, "Shell.Explorer" )

   msgstop( valtype( oActiveX ) )
 

...and this:

Code: Select all

memowrit( "dump.txt", hb_dumpvar( oActiveX ) )
 

...return:

Code: Select all

<TACTIVEX Object>
 | 
 +- PRIVATE/HIDDEN:
 | 
 +- PROTECTED:
 | 
 +- EXPORTED/VISIBLE/PUBLIC:
 |  +- >> Begin Data    ------
 |  +- ACONTROLS            [Data   ] [Ex,Su             ] U => NIL
 |  +- ADOTS                [Clsdata] [Ex,Sh,Cl,Su       ] U => NIL
 |  +- AEVENTS              [Data   ] [Ex                ] A => { Array of 38 Items }
 |  +- AMETHODS             [Data   ] [Ex                ] U => NIL
 |  +- AMINMAXINFO          [Data   ] [Ex,Su             ] U => NIL
 |  +- APROPERTIES          [Data   ] [Ex                ] U => NIL
 |  +- BCHANGE              [Data   ] [Ex,Su             ] U => NIL
...
 |  +- >> End   Methods ------
 |     
 +----------->

 

How to fix this ?

[Antonio Linares]

Rossine,

Yesterday a TOleAuto fix for Harbour was published.

Please do a checkout and try with the new one, thanks

[Rossine]

Hello Antonio,

I tested with the rev. 11383 today, and it occurs error. Tested the three ways you said above.

What to do

[toninhofwi]

Hi friends,

This works:

Code: Select all

   #include "winapi.ch"
   local oWindow, oActiveX
   DEFINE WINDOW oWindow FROM 0,0 to 400,300 TITLE "Flash Player"
   WIN_AxInit()
   oActiveX = WIN_AxGetControl( CreatePtrActiveX( 0, "AtlAxWin", "ShockwaveFlash.ShockwaveFlash.1", nOR( WS_CHILD, WS_VISIBLE ), 0, 0, 200, 200, oWindow:hWnd, 0 ), nil )
   ACTIVATE WINDOW oWindow ON INIT oActiveX:LoadMovie( 0, "c:\flash.swf" )

Code: Select all

#pragma BEGINDUMP

#include "windows.h"
#include "hbapi.h"

extern HINSTANCE _hInstance;

HB_FUNC( CREATEPTRACTIVEX )
{
   hb_retptr( CreateWindowEx(
      hb_parnl( 1 ),
      hb_parc( 2 ),
      (LPCTSTR)ISNIL( 3 ) ? ""                  : hb_parc( 3 ) ,   // cProgId
      (DWORD)  ISNIL( 4 ) ? WS_OVERLAPPEDWINDOW : hb_parni( 4 ),   // style
               ISNIL( 5 ) ? CW_USEDEFAULT       : hb_parni( 5 ),   // nLeft
               ISNIL( 6 ) ? CW_USEDEFAULT       : hb_parni( 6 ),   // nTop
               ISNIL( 7 ) ? 300                 : hb_parni( 7 ),   // nWidth
               ISNIL( 8 ) ? 300                 : hb_parni( 8 ),   // nHeight
               ISNIL( 9 ) ? HWND_DESKTOP        : (HWND) hb_parnl( 9 ),    // oParent:handle
               ISNIL( 10 ) ? 0                   : (HMENU) hb_parnl( 10 ),  // Id
               _hInstance,
               NULL ) );
}

#pragma ENDDUMP

http://www.fwi.com.br/toninho/flash.swf


Regards,

Toninho.