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

2011-08-27 12:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/hbwin/olecore.c
    * few cleanups in recently added functions

  * harbour/contrib/xhb/xhb.hbp
  * harbour/contrib/xhb/xhb.hbx
  + harbour/contrib/xhb/xhbprn.c
    * added xHarbour windows printer functions.

  * harbour/contrib/xhb/xhb.hbp
  * harbour/contrib/xhb/xhb.hbx
  + harbour/contrib/xhb/xhbole.prg
    * added xHarbour comnpatible TOLEAUTO class and OLE functions:
      CreateObject(), GetActiveObject(), CreateOLEObject()
This commit is contained in:
Przemyslaw Czerpak
2011-08-27 10:57:01 +00:00
parent 17b21e996b
commit 2a9eb57396
6 changed files with 365 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
harbour/ChangeLog
View File

@@ -16,6 +16,21 @@
The license applies to all entries newer than 2009-04-28.
*/
2011-08-27 12:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/hbwin/olecore.c
* few cleanups in recently added functions
* harbour/contrib/xhb/xhb.hbp
* harbour/contrib/xhb/xhb.hbx
+ harbour/contrib/xhb/xhbprn.c
* added xHarbour windows printer functions.
* harbour/contrib/xhb/xhb.hbp
* harbour/contrib/xhb/xhb.hbx
+ harbour/contrib/xhb/xhbole.prg
* added xHarbour comnpatible TOLEAUTO class and OLE functions:
CreateObject(), GetActiveObject(), CreateOLEObject()
2011-08-27 10:09 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/src/rtl/hbinet.c
% small simplification in error code setting

3
harbour/contrib/hbwin/olecore.c
View File

@@ -1826,8 +1826,6 @@ static void hb_oleInvokeCall( WORD wFlags )
DISPID lPropPut = DISPID_PROPERTYPUT;
HB_BOOL fPut = wFlags == DISPATCH_PROPERTYPUT;
if( wFlags == DISPATCH_PROPERTYGET )
uiOffset = hb_pcount();
memset( &excep, 0, sizeof( excep ) );
VariantInit( &variant );
GetParams( &dispparam, uiOffset, !fPut );
@@ -1853,6 +1851,7 @@ static void hb_oleInvokeCall( WORD wFlags )
hb_errRT_OLE( EG_ARG, 1007, ( HB_ERRCODE ) lOleError, NULL, HB_ERR_FUNCNAME );
return;
}
hb_errRT_OLE( EG_NOMETHOD, 1009, ( HB_ERRCODE ) lOleError, NULL, hb_parc( uiOffset ) );
}
else
hb_errRT_OLE( EG_ARG, 1001, 0, NULL, HB_ERR_FUNCNAME );

2
harbour/contrib/xhb/xhb.hbp
View File

@@ -66,6 +66,7 @@ xhbmsgs.c
xhbmtc.c
xhbmvinf.c
xhbqself.c
xhbprn.c
xhbproc.c
xhbregx.c
xhbsave.c
@@ -104,6 +105,7 @@ xhbfunp.prg
xhbinkey.prg
xhbmemo.prg
xhbmt.prg
xhbole.prg
xhbtedit.prg
xhbver.prg
xhw32prn.prg

11
harbour/contrib/xhb/xhb.hbx
View File

@@ -36,6 +36,8 @@ DYNAMIC ATSKIPSTRINGS
DYNAMIC BACKBUTTON
DYNAMIC BACKFORMBUTTON
DYNAMIC CGIPARSEVAR
DYNAMIC CREATEOBJECT
DYNAMIC CREATEOLEOBJECT
DYNAMIC CSTR
DYNAMIC CSTRTOVAL
DYNAMIC CTOT
@@ -57,7 +59,10 @@ DYNAMIC FPARSE
DYNAMIC FPARSEEX
DYNAMIC FPARSELINE
DYNAMIC FWORDCOUNT
DYNAMIC GETACTIVEOBJECT
DYNAMIC GETCURRENTTHREAD
DYNAMIC GETDEFAULTPRINTER
DYNAMIC GETPRINTERS
DYNAMIC GETREGISTRY
DYNAMIC GETSYSTEMTHREADID
DYNAMIC GETTABLE
@@ -339,12 +344,16 @@ DYNAMIC OS_NETVREDIROK
DYNAMIC OS_VERSIONINFO
DYNAMIC PARSESTRING
DYNAMIC PRGEXPTOVAL
DYNAMIC PRINTEREXISTS
DYNAMIC PRINTERPORTTONAME
DYNAMIC PRINTFILERAW
DYNAMIC PUTCOUNTER
DYNAMIC QUERYREGISTRY
DYNAMIC RASCAN
DYNAMIC SCROLLFIXED
DYNAMIC SECONDSSLEEP
DYNAMIC SETCORRUPTFUNC
DYNAMIC SETDEFAULTPRINTER
DYNAMIC SETERRORFOOTER
DYNAMIC SETNETDELAY
DYNAMIC SETNETMSGCOLOR
@@ -373,6 +382,7 @@ DYNAMIC THTMLFRAMESET
DYNAMIC TIMEOFDAY
DYNAMIC TJSLIST
DYNAMIC TJSWINDOW
DYNAMIC TOLEAUTO
DYNAMIC TRACELOG
DYNAMIC TRPCCLIENT
DYNAMIC TRPCFUNCTION
@@ -444,6 +454,7 @@ DYNAMIC XHB_SETTRACESTACK
DYNAMIC XHB_TMEMOEDITOR
DYNAMIC XHB_TRIM
DYNAMIC XHB__KEYBOARD
DYNAMIC XISPRINTER
DYNAMIC _ARRAY
DYNAMIC _BLOCK
DYNAMIC _CHARACTER

261
harbour/contrib/xhb/xhbole.prg Normal file
View File

@@ -0,0 +1,261 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Compatibility calls.
*
* Copyright 2011 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* Copyright 2009 Viktor Szakats (harbour.01 syenar.hu)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#ifndef __PLATFORM__WINDOWS
FUNCTION TOLEAUTO()
RETURN NIL
FUNCTION CreateObject()
RETURN NIL
FUNCTION GetActiveObject()
RETURN NIL
FUNCTION CreateOLEObject()
RETURN NIL
#else
#define HB_CLS_NOTOBJECT /* avoid definition of method: INIT */
#include "hbclass.ch"
#include "common.ch"
#include "error.ch"
#define EG_OLEEXCEPTION 1001
#define DISPID_VALUE 0
STATIC s_bBreak := { | oError | Break( oError ) }
STATIC FUNCTION s_oleOpError( cOperator, ... )
STATIC s_hErrCode := { "==" => 1070, ;
"=" => 1071, ;
"!=" => 1072, ;
"+" => 1081, ;
"-" => 1082, ;
"*" => 1083, ;
"/" => 1084, ;
"%" => 1085, ;
"++" => 1086, ;
"--" => 1087, ;
"^" => 1088 }
LOCAL oErr
oErr := ErrorNew()
oErr:Args := { ... }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := cOperator
oErr:Severity := ES_ERROR
oErr:SubCode := s_hErrCode[ cOperator ]
oErr:SubSystem := "BASE"
RETURN oErr
STATIC FUNCTION s_oleError( nGenCode, cDescript )
LOCAL oErr
oErr := ErrorNew()
oErr:Args := hb_AParams( 1 )
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
IF PCount() != 0
oErr:GenCode := nGenCode
oErr:Description := cDescript
ELSE
oErr:GenCode := EG_OLEEXCEPTION
oErr:Description := win_OleErrorText()
ENDIF
oErr:Operation := ProcName( 1 )
oErr:Severity := ES_ERROR
oErr:SubCode := -1
oErr:SubSystem := "TOleAuto"
RETURN oErr
CREATE CLASS TOLEAUTO FROM WIN_OLEAUTO
VAR cClassName
METHOD hObj( xOle )
METHOD New( xOle, cClass, cLicense )
METHOD GetActiveObject( cClass )
METHOD Invoke() EXTERN __oleInvokeMethod()
MESSAGE CallMethod EXTERN __oleInvokeMethod()
METHOD Set() EXTERN __oleInvokePut()
MESSAGE SetProperty EXTERN __oleInvokePut()
METHOD Get() EXTERN __oleInvokeGet()
MESSAGE GetProperty EXTERN __oleInvokeGet()
METHOD OleValue()
METHOD _OleValue( xValue )
METHOD OleValueExactEqual( xArg ) OPERATOR "=="
METHOD OleValueEqual( xArg ) OPERATOR "="
METHOD OleValueNotEqual( xArg ) OPERATOR "!="
METHOD OleValuePlus( xArg ) OPERATOR "+"
METHOD OleValueMinus( xArg ) OPERATOR "-"
METHOD OleValueMultiply( xArg ) OPERATOR "*"
METHOD OleValueDivide( xArg ) OPERATOR "/"
METHOD OleValueModulus( xArg ) OPERATOR "%"
METHOD OleValuePower( xArg ) OPERATOR "^"
METHOD OleValueInc() OPERATOR "++"
METHOD OleValueDec() OPERATOR "--"
ENDCLASS
METHOD hObj( xOle ) CLASS TOLEAUTO
IF xOle != NIL
IF HB_ISNUMERIC( xOle )
xOle := __OLEPDISP( xOle )
ENDIF
IF __OleIsDisp( xOle )
::__hObj := xOle
ENDIF
ENDIF
RETURN ::__hObj
METHOD New( xOle, cClass, cLicense ) CLASS TOLEAUTO
LOCAL hOle
IF HB_ISCHAR( xOle )
hOle := __OleCreateObject( xOle,, cLicense )
IF ! Empty( hOle )
::__hObj := hOle
::cClassName := xOle
ELSE
RETURN Throw( s_oleError() )
ENDIF
ELSE
::hObj := xOle
IF ::__hObj == NIL
RETURN Throw( s_oleError( 0, "Invalid argument to contructor!" ) )
ELSEIF HB_ISCHAR( cClass )
::cClassName := cClass
ELSE
::cClassName := hb_ntos( win_P2N( ::__hObj ) )
ENDIF
ENDIF
RETURN Self
METHOD GetActiveObject( cClass ) CLASS TOLEAUTO
IF HB_ISCHAR( cClass )
IF ! Empty( ::__hObj := __OleGetActiveObject( cClass ) )
::cClassName := cClass
ELSE
RETURN Throw( s_oleError() )
ENDIF
ELSE
WAPI_MessageBox( , "Invalid parameter type to constructor TOleAuto():GetActiveObject()!", ;
"OLE Interface", )
::__hObj := NIL
ENDIF
RETURN Self
METHOD OleValue() CLASS TOLEAUTO
RETURN __oleInvokeGet( ::__hObj, DISPID_VALUE )
METHOD _OleValue( xValue ) CLASS TOLEAUTO
RETURN __oleInvokePut( ::__hObj, DISPID_VALUE, xValue )
#xcommand OLE OPERATOR <op> METHOD <!mth!> [WITH <!arg!>] IS <exp> => ;
METHOD <mth>( <arg> ) CLASS TOLEAUTO ;;
LOCAL xRet ;;
BEGIN SEQUENCE WITH s_bBreak ;;
xRet := ( <exp> ) ;;
RECOVER ;;
RETURN Throw( s_oleOpError( <op>, Self [, <arg>] ) ) ;;
END SEQUENCE ;;
RETURN xRet
OLE OPERATOR "==" METHOD OleValueExactEqual WITH xArg IS ::OleValue == xArg
OLE OPERATOR "=" METHOD OleValueEqual WITH xArg IS ::OleValue = xArg
OLE OPERATOR "!=" METHOD OleValueNotEqual WITH xArg IS ::OleValue != xArg
OLE OPERATOR "+" METHOD OleValuePlus WITH xArg IS ::OleValue + xArg
OLE OPERATOR "-" METHOD OleValueMinus WITH xArg IS ::OleValue - xArg
OLE OPERATOR "*" METHOD OleValueMultiply WITH xArg IS ::OleValue * xArg
OLE OPERATOR "/" METHOD OleValueDivide WITH xArg IS ::OleValue / xArg
OLE OPERATOR "%" METHOD OleValueModulus WITH xArg IS ::OleValue % xArg
OLE OPERATOR "^" METHOD OleValuePower WITH xArg IS ::OleValue ^ xArg
OLE OPERATOR "++" METHOD OleValueInc IS ++::OleValue
OLE OPERATOR "--" METHOD OleValueDec IS --::OleValue
FUNCTION CreateObject( xOle, cLicense )
RETURN TOleAuto():New( xOle,, cLicense )
FUNCTION GetActiveObject( cString )
RETURN TOleAuto():GetActiveObject( cString )
FUNCTION CreateOLEObject( ... )
RETURN __OleCreateObject( ... )
#endif /* __PLATFORM__WINDOWS */

75
harbour/contrib/xhb/xhbprn.c Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Compatibility calls (Printer support).
*
* Copyright 2009 Viktor Szakats (harbour.01 syenar.hu)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#if defined( HB_OS_WIN )
HB_FUNC_EXTERN( WIN_PRINTEREXISTS ) ; HB_FUNC( PRINTEREXISTS ) { HB_FUNC_EXEC( WIN_PRINTEREXISTS ); }
HB_FUNC_EXTERN( WIN_PRINTERGETDEFAULT ) ; HB_FUNC( GETDEFAULTPRINTER ) { HB_FUNC_EXEC( WIN_PRINTERGETDEFAULT ); }
HB_FUNC_EXTERN( WIN_PRINTERSTATUS ) ; HB_FUNC( XISPRINTER ) { HB_FUNC_EXEC( WIN_PRINTERSTATUS ); }
HB_FUNC_EXTERN( WIN_PRINTERPORTTONAME ) ; HB_FUNC( PRINTERPORTTONAME ) { HB_FUNC_EXEC( WIN_PRINTERPORTTONAME ); }
HB_FUNC_EXTERN( WIN_PRINTFILERAW ) ; HB_FUNC( PRINTFILERAW ) { HB_FUNC_EXEC( WIN_PRINTFILERAW ); }
HB_FUNC_EXTERN( WIN_PRINTERLIST ) ; HB_FUNC( GETPRINTERS ) { HB_FUNC_EXEC( WIN_PRINTERLIST ); }
HB_FUNC_EXTERN( WIN_PRINTERSETDEFAULT ) ; HB_FUNC( SETDEFAULTPRINTER ) { HB_FUNC_EXEC( WIN_PRINTERSETDEFAULT ); }
#else
HB_FUNC( PRINTEREXISTS ) {}
HB_FUNC( GETDEFAULTPRINTER ) {}
HB_FUNC( XISPRINTER ) {}
HB_FUNC( PRINTERPORTTONAME ) {}
HB_FUNC( PRINTFILERAW ) {}
HB_FUNC( GETPRINTERS ) {}
HB_FUNC( SETDEFAULTPRINTER ) {}
#endif