From 28df65d9b972669bb144c6163008d86b29607cad Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 14 Feb 2010 14:12:39 +0000 Subject: [PATCH] 2010-02-14 15:10 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbwin/hbdyn.c ! Fixed handling of HB_DYN_ENC_RAW and HB_DYN_CTYPE_CHAR_UNSIGNED buffer handling. * contrib/hbwin/tests/testdll1.prg + Added new test. ! Minor cleanup to prev tests. * contrib/hbwin/Makefile + contrib/hbwin/win_dllf.prg + Added WIN_DLLCALLFOXPRO( [, ] ) -> where is a valid Visual FoxPro declare command: "DECLARE [cFunctionType] FunctionName IN LibraryName [AS AliasName] [cParamType1 [@] ParamName1, cParamType2 [@] ParamName2, ...]" See more here: http://msdn.microsoft.com/en-us/library/ydcf39aa(VS.80).aspx * contrib/hbwin/Makefile - contrib/hbwin/win_dll.c + contrib/hbwin/win_dllc.c * Renamed. --- harbour/ChangeLog | 25 ++++ harbour/contrib/hbwin/Makefile | 3 +- harbour/contrib/hbwin/hbdyn.c | 52 +++++-- harbour/contrib/hbwin/tests/testdll1.prg | 29 ++-- .../contrib/hbwin/{win_dll.c => win_dllc.c} | 0 harbour/contrib/hbwin/win_dllf.prg | 129 ++++++++++++++++++ 6 files changed, 216 insertions(+), 22 deletions(-) rename harbour/contrib/hbwin/{win_dll.c => win_dllc.c} (100%) create mode 100644 harbour/contrib/hbwin/win_dllf.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6a39a6fa29..cc44eca0f0 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,31 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-14 15:10 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbwin/hbdyn.c + ! Fixed handling of HB_DYN_ENC_RAW and HB_DYN_CTYPE_CHAR_UNSIGNED + buffer handling. + + * contrib/hbwin/tests/testdll1.prg + + Added new test. + ! Minor cleanup to prev tests. + + * contrib/hbwin/Makefile + + contrib/hbwin/win_dllf.prg + + Added WIN_DLLCALLFOXPRO( [, ] ) -> + where is a valid Visual FoxPro declare command: + + "DECLARE [cFunctionType] FunctionName IN LibraryName [AS AliasName] + [cParamType1 [@] ParamName1, cParamType2 [@] ParamName2, ...]" + + See more here: + http://msdn.microsoft.com/en-us/library/ydcf39aa(VS.80).aspx + + * contrib/hbwin/Makefile + - contrib/hbwin/win_dll.c + + contrib/hbwin/win_dllc.c + * Renamed. + 2010-02-14 13:57 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * src/rtl/achoice.prg ! Fixed/added cursor positioning to resemble to Clipper. diff --git a/harbour/contrib/hbwin/Makefile b/harbour/contrib/hbwin/Makefile index e121bec9f5..73b4b28bca 100644 --- a/harbour/contrib/hbwin/Makefile +++ b/harbour/contrib/hbwin/Makefile @@ -35,7 +35,7 @@ C_SOURCES := \ win_bmpd.c \ win_com.c \ win_dlg.c \ - win_dll.c \ + win_dllc.c \ win_dllx.c \ win_misc.c \ win_osc.c \ @@ -49,6 +49,7 @@ PRG_SOURCES := \ oleauto.prg \ axfunc.prg \ wce_sim.prg \ + win_dllf.prg \ win_os.prg \ win_reg.prg \ win_tbmp.prg \ diff --git a/harbour/contrib/hbwin/hbdyn.c b/harbour/contrib/hbwin/hbdyn.c index ca23f6db88..b0ce17d781 100644 --- a/harbour/contrib/hbwin/hbdyn.c +++ b/harbour/contrib/hbwin/hbdyn.c @@ -120,6 +120,7 @@ typedef struct void * hString; int iType; int iEncoding; + HB_BOOL bRawBuffer; HB_BOOL bByRef; HB_DYNVAL value; } HB_DYNARG, * PHB_DYNARG; @@ -200,10 +201,16 @@ static HB_U64 hb_u64par( PHB_ITEM pParam, PHB_DYNARG pArg ) case HB_DYN_CTYPE_CHAR_UNSIGNED_PTR: case HB_DYN_CTYPE_STRUCTURE: - r = ( HB_PTRUINT ) hb_strunshare( &pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + { + HB_SIZE nLen = hb_itemGetCLen( pParam ); + pArg->hString = hb_xgrab( nLen + sizeof( char ) ); + pArg->bRawBuffer = HB_TRUE; + memcpy( ( char * ) pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + ( ( char * ) pArg->hString )[ nLen ] = '\0'; + r = ( HB_PTRUINT ) pArg->hString; pArg->value.t.n64 = r; break; - + } case HB_DYN_CTYPE_CHAR_PTR: switch( pArg->iEncoding ) @@ -230,7 +237,15 @@ static HB_U64 hb_u64par( PHB_ITEM pParam, PHB_DYNARG pArg ) break; } default: - r = ( HB_PTRUINT ) hb_strunshare( &pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + { + HB_SIZE nLen = hb_itemGetCLen( pParam ); + pArg->hString = hb_xgrab( nLen + sizeof( char ) ); + pArg->bRawBuffer = HB_TRUE; + memcpy( ( char * ) pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + ( ( char * ) pArg->hString )[ nLen ] = '\0'; + r = ( HB_PTRUINT ) pArg->hString; + break; + } } pArg->value.t.n64 = r; break; @@ -456,6 +471,7 @@ typedef struct void * hString; int iType; int iEncoding; + HB_BOOL bRawBuffer; HB_BOOL bByRef; HB_DYNVAL value; } HB_DYNARG, * PHB_DYNARG; @@ -559,10 +575,16 @@ static void hb_u32par( PHB_ITEM pParam, PHB_DYNARG pArg, HB_U32 * r1, HB_U32 * r case HB_DYN_CTYPE_CHAR_UNSIGNED_PTR: case HB_DYN_CTYPE_STRUCTURE: - *r1 = ( HB_U32 ) hb_strunshare( &pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + { + HB_SIZE nLen = hb_itemGetCLen( pParam ); + pArg->hString = hb_xgrab( nLen + sizeof( char ) ); + pArg->bRawBuffer = HB_TRUE; + memcpy( ( char * ) pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + ( ( char * ) pArg->hString )[ nLen ] = '\0'; + *r1 = ( HB_PTRUINT ) pArg->hString; pArg->value.t.n32 = *r1; break; - + } case HB_DYN_CTYPE_CHAR_PTR: switch( pArg->iEncoding ) @@ -589,7 +611,15 @@ static void hb_u32par( PHB_ITEM pParam, PHB_DYNARG pArg, HB_U32 * r1, HB_U32 * r break; } default: - *r1 = ( HB_U32 ) hb_strunshare( &pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + { + HB_SIZE nLen = hb_itemGetCLen( pParam ); + pArg->hString = hb_xgrab( nLen + sizeof( char ) ); + pArg->bRawBuffer = HB_TRUE; + memcpy( ( char * ) pArg->hString, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) ); + ( ( char * ) pArg->hString )[ nLen ] = '\0'; + *r1 = ( HB_PTRUINT ) pArg->hString; + break; + } } pArg->value.t.n32 = *r1; break; @@ -1140,7 +1170,10 @@ void hb_dynCall( int iFuncFlags, void * pFunctionRaw, int iParams, int iFirst, i hb_itemRelease( pItem ); } - hb_strfree( pArg[ tmp ].hString ); + if( pArg[ tmp ].bRawBuffer ) + hb_xfree( pArg[ tmp ].hString ); + else + hb_strfree( pArg[ tmp ].hString ); } if( pArg ) @@ -1533,7 +1566,10 @@ void hb_dynCall( int iFuncFlags, void * pFunctionRaw, int iParams, int iFirst, i hb_itemRelease( pItem ); } - hb_strfree( pArg[ tmp ].hString ); + if( pArg[ tmp ].bRawBuffer ) + hb_xfree( pArg[ tmp ].hString ); + else + hb_strfree( pArg[ tmp ].hString ); } if( pArg ) diff --git a/harbour/contrib/hbwin/tests/testdll1.prg b/harbour/contrib/hbwin/tests/testdll1.prg index 1d51d923ef..4f45049bd7 100644 --- a/harbour/contrib/hbwin/tests/testdll1.prg +++ b/harbour/contrib/hbwin/tests/testdll1.prg @@ -26,19 +26,22 @@ PROCEDURE Main() #endif ? "-", cFileName - a := NIL ; a := 567.89 ; ? ">", a, win_dllCall( { "TESTD" , cFileName, hb_bitOr( HB_DYN_CTYPE_DOUBLE , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_DOUBLE }, 567.89 ) - a := NIL ; a := 567.89 ; ? ">", a, win_dllCall( { "TESTF" , cFileName, hb_bitOr( HB_DYN_CTYPE_FLOAT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_FLOAT }, 567.89 ) - a := NIL ; a := -( 2 ^ 7 ) ; ? ">", a, win_dllCall( { "TESTC" , cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR }, -( 2 ^ 7 ) ) - a := NIL ; a := ( 2 ^ 8 ) - 1 ; ? ">", a, win_dllCall( { "TESTUC", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR_UNSIGNED }, ( 2 ^ 8 ) - 1 ) - a := NIL ; a := -( 2 ^ 15 ) ; ? ">", a, win_dllCall( { "TESTS" , cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT }, -( 2 ^ 15 ) ) - a := NIL ; a := ( 2 ^ 16 ) - 1 ; ? ">", a, win_dllCall( { "TESTUS", cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT_UNSIGNED }, ( 2 ^ 16 ) - 1 ) - a := NIL ; a := -( 2 ^ 31 ) ; ? ">", a, win_dllCall( { "TESTI" , cFileName, hb_bitOr( HB_DYN_CTYPE_INT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT }, -( 2 ^ 31 ) ) - a := NIL ; a := ( 2 ^ 32 ) - 1 ; ? ">", a, win_dllCall( { "TESTUI", cFileName, hb_bitOr( HB_DYN_CTYPE_INT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT_UNSIGNED }, ( 2 ^ 32 ) - 1 ) - a := NIL ; a := -( 2 ^ 31 ) ; ? ">", a, win_dllCall( { "TESTL" , cFileName, hb_bitOr( HB_DYN_CTYPE_LONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG }, -( 2 ^ 31 ) ) - a := NIL ; a := ( 2 ^ 32 ) - 1 ; ? ">", a, win_dllCall( { "TESTUL", cFileName, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG_UNSIGNED }, ( 2 ^ 32 ) - 1 ) - a := NIL ; a := -( 2 ^ 63 ) ; ? ">", a, win_dllCall( { "TEST6" , cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG }, -( 2 ^ 63 ) ) - a := NIL ; a := 18446744073709600000 ; ? ">", a, win_dllCall( { "TESTU6", cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG_UNSIGNED }, 18446744073709600000 ) - a := NIL ; a := "hello world!" ; ? ">", a, win_dllCall( { "TESTST", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_CDECL ) }, "hello world!" ) + a := NIL ; a := 567.89 ; ? ">", a, win_dllCall( { "TESTD" , cFileName, hb_bitOr( HB_DYN_CTYPE_DOUBLE , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_DOUBLE }, a ) + a := NIL ; a := 567.89 ; ? ">", a, win_dllCall( { "TESTF" , cFileName, hb_bitOr( HB_DYN_CTYPE_FLOAT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_FLOAT }, a ) + a := NIL ; a := -( 2 ^ 7 ) ; ? ">", a, win_dllCall( { "TESTC" , cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR }, a ) + a := NIL ; a := ( 2 ^ 8 ) - 1 ; ? ">", a, win_dllCall( { "TESTUC", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR_UNSIGNED }, a ) + a := NIL ; a := -( 2 ^ 15 ) ; ? ">", a, win_dllCall( { "TESTS" , cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT }, a ) + a := NIL ; a := ( 2 ^ 16 ) - 1 ; ? ">", a, win_dllCall( { "TESTUS", cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT_UNSIGNED }, a ) + a := NIL ; a := -( 2 ^ 31 ) ; ? ">", a, win_dllCall( { "TESTI" , cFileName, hb_bitOr( HB_DYN_CTYPE_INT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT }, a ) + a := NIL ; a := ( 2 ^ 32 ) - 1 ; ? ">", a, win_dllCall( { "TESTUI", cFileName, hb_bitOr( HB_DYN_CTYPE_INT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT_UNSIGNED }, a ) + a := NIL ; a := -( 2 ^ 31 ) ; ? ">", a, win_dllCall( { "TESTL" , cFileName, hb_bitOr( HB_DYN_CTYPE_LONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG }, a ) + a := NIL ; a := ( 2 ^ 32 ) - 1 ; ? ">", a, win_dllCall( { "TESTUL", cFileName, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG_UNSIGNED }, a ) + a := NIL ; a := -( 2 ^ 63 ) ; ? ">", a, win_dllCall( { "TEST6" , cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG }, a ) + a := NIL ; a := 18446744073709600000 ; ? ">", a, win_dllCall( { "TESTU6", cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG_UNSIGNED }, a ) + a := NIL ; a := "hello world!" ; ? ">", a, win_dllCall( { "TESTST", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_CDECL ) }, a ) ? "==" + a := NIL ; a := "hello world!" ; ? ">", a, win_dllCall( { "TESTST", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_CDECL, HB_DYN_ENC_RAW ), hb_bitOr( HB_DYN_CTYPE_CHAR_PTR, HB_DYN_ENC_RAW ) }, a ) + a := NIL ; a := "hello world!" ; ? ">", a, win_dllCallFoxPro( "DECLARE STRING TESTST IN " + cFileName + " STRING", a ) + RETURN diff --git a/harbour/contrib/hbwin/win_dll.c b/harbour/contrib/hbwin/win_dllc.c similarity index 100% rename from harbour/contrib/hbwin/win_dll.c rename to harbour/contrib/hbwin/win_dllc.c diff --git a/harbour/contrib/hbwin/win_dllf.prg b/harbour/contrib/hbwin/win_dllf.prg new file mode 100644 index 0000000000..7ffd16c63e --- /dev/null +++ b/harbour/contrib/hbwin/win_dllf.prg @@ -0,0 +1,129 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Windows .dll support (high-level) + * + * Copyright 2010 Viktor Szakats (harbour.01 syenar.hu) + * www - http://www.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 "common.ch" +#include "hbdyn.ch" + +/* +DECLARE [cFunctionType] FunctionName IN LibraryName [AS AliasName] + [cParamType1 [@] ParamName1, cParamType2 [@] ParamName2, ...] +*/ + +FUNCTION win_dllCallFoxPro( cCommand, ... ) + LOCAL cFunction + LOCAL cLibrary + LOCAL nFuncFlags := hb_bitOr( HB_DYN_CALLCONV_CDECL, HB_DYN_ENC_RAW ) + + LOCAL aCommand := hb_ATokens( cCommand ) + LOCAL nPos := 1 + LOCAL tmp + + LOCAL aTypeS := { "SHORT", "INTEGER", "SINGLE", "DOUBLE", "LONG", "STRING", "OBJECT" } + LOCAL aTypeN := { HB_DYN_CTYPE_SHORT, HB_DYN_CTYPE_INT, HB_DYN_CTYPE_FLOAT, HB_DYN_CTYPE_DOUBLE, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_VOID_PTR } + + LOCAL aParam + + IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "DECLARE" + ++nPos + ENDIF + + IF nPos <= Len( aCommand ) .AND. ( tmp := AScan( aTypeS, {| tmp | tmp == aCommand[ nPos ] } ) ) > 0 + nFuncFlags := hb_bitOr( nFuncFlags, aTypeN[ tmp ] ) + ++nPos + ELSE + RETURN NIL + ENDIF + + IF nPos <= Len( aCommand ) + cFunction := aCommand[ nPos ] + ++nPos + ELSE + RETURN NIL + ENDIF + + IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "IN" + ++nPos + ELSE + RETURN NIL + ENDIF + + IF nPos <= Len( aCommand ) + cLibrary := aCommand[ nPos ] + ++nPos + ELSE + RETURN NIL + ENDIF + + IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "AS" + nPos += 2 + ENDIF + + aParam := { cFunction, cLibrary, nFuncFlags } + + DO WHILE nPos <= Len( aCommand ) + IF ( tmp := AScan( aTypeS, {| tmp | tmp == aCommand[ nPos ] } ) ) > 0 + AAdd( aParam, hb_bitOr( HB_DYN_ENC_RAW, aTypeN[ tmp ] ) ) + ++nPos + ENDIF + IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "@" + ++nPos + ENDIF + /* ignore parameter name */ + IF nPos <= Len( aCommand ) + ++nPos + ENDIF + IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "," + ++nPos + ENDIF + ENDDO + + RETURN win_dllCall( aParam, ... )