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

2010-02-14 15:10 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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( <cDeclareCommand>[, <parameters...> ] ) -> <xResult>
      where <cDeclareCommand> 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.
This commit is contained in:
Viktor Szakats
2010-02-14 14:12:39 +00:00
parent 5dd43f4626
commit 28df65d9b9
6 changed files with 216 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
harbour/ChangeLog
View File

@@ -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( <cDeclareCommand>[, <parameters...> ] ) -> <xResult>
where <cDeclareCommand> 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.

3
harbour/contrib/hbwin/Makefile
View File

@@ -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 \

52
harbour/contrib/hbwin/hbdyn.c
View File

@@ -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 )

29
harbour/contrib/hbwin/tests/testdll1.prg
View File

@@ -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

0
harbour/contrib/hbwin/win_dll.c → harbour/contrib/hbwin/win_dllc.c
View File

129
harbour/contrib/hbwin/win_dllf.prg Normal file
View File

@@ -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, ... )