Agora temos no Harbour (GPL) essa nova possibilidade, recurso que no xHarbour tem apenas na versão comercial.
/*
* $Id: olesrv1.prg 14593 2010-05-25 22:04:04Z druzus $
*/
/*
* Harbour Project source code:
* demonstration/test code for NETIO-RPC OLE server
*
* Copyright 2010 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
*/
#define CLS_Name "MyOleRPCServer"
#define CLS_ID "{23245C3F-4487-404B-985F-E33886698D23}"
#include "hbclass.ch"
/* DllMain() is OLE server entry point
* It's executed just after loading OLE inproc server
* as server from other application and also by regsrv32.exe
* during registration and unregistration procedure.
* It should initialize OLE server ID and name.
*/
PROCEDURE DllMain()
/* Initialize OLE server ID and name.
* WIN_OleServerInit() should be executed from DllMain()
*
* WIN_OleServerInit( <cClassID>, <cServerName>, ;
* [ <hAction> | <oAction> | <bAction> | <sAction> ], ;
* [ <lHashClone> | <lAcceptAll> ] ) -> <lServerActive>
*
* <cClassID> is registered OLE server class GUID
*
* <cServerName> is OLE server class name
*
* <hAction> is optional parameter with hash array containing messages
* and instance variables used by OLE server. The keys in hash array
* are strings with message names and values are actions. Codeblock
* and symbol items means that given message is a method call and
* any other value means that it's variable.
* By default the same hash array is shared between all objects
* created by registered server. It's important when hash array
* contains values which are neither codeblock nor symbol items
* so they are not used as method but rather as instance variables
* because such instance variables are shared between OLE objects.
* Setting 4-th parameter <lHashClone> to .T. causes that each
* objects receives it's own copy of <hAction> item so instance
* variables inside hash array are also local to OLE object.
* Alternatively programmer can use <bAction> or <sAction> to create
* seprate copy of hash array for each object, i.e.:
* bAction := {|| hb_hClone( hValue ) }
* When hash array contains symbol item (@funcName()) then when it's
* executed by OLE object message it's possible to access the hash
* array bound with given OLE object using QSelf() function. It maybe
* useful if hash array contains instance variables and programmer
* wants to access them.
* Please remember that using hash array which was initialized to keep
* original assign order by HB_HKEEPORDER( <hAction>, .T. ) before
* adding its items you can define strict message numbers (DISPIDs), i.e.:
* hAction := {=>}
* HB_HKEEPORDER( hAction, .T. )
* hAction[ "OPEN" ] := @myole_open() // DISPID=1
* hAction[ "CLOSE" ] := @myole_close() // DISPID=2
* hAction[ "SAVE" ] := @myole_save() // DISPID=3
* hAction[ "LOAD" ] := @myole_load() // DISPID=4
* hAction[ "PRINT" ] := @myole_print() // DISPID=5
* (see example in olesrv2.prg)
*
* <oAction> is optional parameter with Harbour object which is used
* as base for all newly created OLE objects. All messages (method and
* instance variables) supported explicitly by <oAction> object (except
* ONERROR message redirecting) are inherited by OLE objects. Each
* newly created OLE object uses the same <oAction> object so its
* instance variables are shared between all of them. If programmer
* wants to create separate Harbour object for each OLE object then
* he should use <bAction> or <sAction>, i.e.:
* bAction := {|| myClass():new() }
*
* <bAction> is optional parameter with codeblock executed when new
* OLE object is created. It should return hash array or Harbour object
* which will be used as base for newly created OLE object.
*
* <sAction> is optional parameter with function symbol. This function
* is executed when new OLE object is created and should return hash
* array or Harbour object which is used as base for newly created
* OLE object.
*
* If the 3-rd parameter is <oAction>, <bAction> or <sAction> then
* it's possible to also set 4-th parameter <lAcceptAll> to .T. and
* in such case <xAction> parameter is used in different way. Newly
* created OLE object accepts any massage names invoking for each
* of them EVAL() message which is sent to <xAction> with OLE message
* name inserted as the 1-st item to OLE object parameters.
* It allows to create OLE server which will accept unknown messages
* redirecting them to some other code, i.e.:
* if netio_connect( cServer,,, cPasswd )
* WIN_OleServerInit( cClassID, cServerName, @netio_funcExec(), .T. )
* endif
* initialize OLE server which redirects all messages to default netio
* connection establish by netio_connect().
*
* If 3-rd parameter is not given then all HVM functions becomes
* OLE methods and HVM memvars (public and private variables) are
* OLE object instance variables so they are shared with all OLE
* objects created by this interface. It works just like xHarbour.com
* OLE server described at
* http://xharbour.com/index.asp?page=add_on_oleserver&show_sub=7&show_i=1
*/
WIN_OleServerInit( CLS_ID, CLS_Name, {|| OleNetioSrv():new() }, .T. )
RETURN
CREATE CLASS OleNetioSrv
HIDDEN:
VAR pConn
EXPORTED:
METHOD Eval( cMethodName, ... )
ENDCLASS
METHOD Eval( cMethodName, ... ) CLASS OleNetioSrv
SWITCH cMethodName
CASE "CONNECT"
RETURN !Empty( ::pConn := NETIO_GETCONNECTION( ... ) )
CASE "DISCONNECT"
::pConn := NIL
RETURN .T.
CASE "PROCEXISTS"
RETURN NETIO_PROCEXISTS( ::pConn, ... )
CASE "PROCEXEC"
RETURN NETIO_PROCEXEC( ::pConn, ... )
CASE "PROCEXECW"
RETURN NETIO_PROCEXECW( ::pConn, ... )
CASE "FUNCEXEC"
RETURN NETIO_FUNCEXEC( ::pConn, ... )
ENDSWITCH
/* redirect all other messages to RPC server as function calls */
RETURN NETIO_FUNCEXEC( ::pConn, cMethodName, ... )
ANNOUNCE GT_SYS
REQUEST HB_GT_GUI_DEFAULT
Usando:
/*
* $Id: oletst1.prg 14593 2010-05-25 22:04:04Z druzus $
*/
/*
* Harbour Project source code:
* demonstration/test code for NETIO-RPC OLE server client
*
* Copyright 2010 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
*/
#define NETSERVER "127.0.0.1"
#define NETPORT 2941
#define NETPASSWD "topsecret"
PROCEDURE Main()
LOCAL oObject
oObject := win_OleCreateObject( "MyOleRPCServer" )
IF !Empty( oObject )
IF oObject:connect( NETSERVER, NETPORT,, NETPASSWD )
? "Connected to the server:", NETSERVER
/* execute some functions on the server side and display
* the results.
*/
? oObject:upper( "hello world !!!" )
? "SERVER DATE:", oObject:DATE()
? "SERVER TIME:", oObject:TIME()
? "SERVER DATETIME:", oObject:HB_DATETIME()
ELSE
? "Cannot connect to the server:", NETSERVER
ENDIF
ELSE
? "Can not access 'MyOleRPCServer' OLE server."
ENDIF
WAIT
RETURN
Outro exemplo.
/*
* $Id: olesrv2.prg 14596 2010-05-25 23:44:42Z vszakats $
*/
/*
* Harbour Project source code:
* demonstration/test code for OLE server using hash array with
* strict item order (associative hash array) to define OLE objects
* with fixed message numbers (DISPIDs)
*
* Copyright 2010 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*/
#define CLS_Name "MyOleTimeServer"
#define CLS_ID "{5552013F-2990-4D6C-9C96-55A4BDDCE376}"
PROCEDURE DllMain()
LOCAL hAction
hAction := { => }
hb_HKeepOrder( hAction, .T. )
hb_HSetCaseMatch( hAction, .F. )
hAction[ "DATE" ] := @date() // DISPID=1
hAction[ "TIME" ] := @time() // DISPID=2
hAction[ "DATETIME" ] := @hb_datetime() // DISPID=3
hAction[ "VALUE" ] := NIL // DISPID=4
hAction[ "GETDATA" ] := @get_data() // DISPID=5
/* Initialize OLE server ID and name.
* WIN_OleServerInit() should be executed from DllMain()
*/
WIN_OleServerInit( CLS_ID, CLS_Name, hAction, .T. )
RETURN
STATIC FUNCTION get_data( ... )
LOCAL hAction := QSelf()
IF hAction[ "VALUE" ] == NIL
RETURN "(:VALUE IS NOT SET)"
ENDIF
RETURN ":VALUE='" + hAction[ "VALUE" ] + "'"
ANNOUNCE GT_SYS
REQUEST HB_GT_GUI_DEFAULT
Saudações,
Itamar M. Lins Jr.
