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

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

Browse Source 
* contrib/hbwin/tests/testdll1.prg
    + Displaying success/failure.

  * contrib/hbwin/win_dllf.prg
    % Using hashes.
This commit is contained in:
Viktor Szakats
2010-02-14 21:00:34 +00:00
parent 45ff380f71
commit 2f5b638242
3 changed files with 39 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
harbour/ChangeLog
View File

@@ -17,6 +17,13 @@
past entries belonging to author(s): Viktor Szakats.
*/
2010-02-14 21:59 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbwin/tests/testdll1.prg
+ Displaying success/failure.
* contrib/hbwin/win_dllf.prg
% Using hashes.
2010-02-14 15:32 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbwin/hbdyn.c
% Minor cleanup.

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

@@ -15,9 +15,11 @@
#include "hbdyn.ch"
#define _ISOK_( a, b ) iif( a == b, "OK", "WRONG" )
PROCEDURE Main()
LOCAL cFileName
LOCAL a
LOCAL a, b
#if defined( __ARCH64BIT__ )
cFileName := "test_x64.dll"
@@ -26,22 +28,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 }, 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 := 567.89 ; ? ">", a, b := win_dllCall( { "TESTD" , cFileName, hb_bitOr( HB_DYN_CTYPE_DOUBLE , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_DOUBLE }, a ), _ISOK_( a, b )
a := 567.89 ; ? ">", a, b := win_dllCall( { "TESTF" , cFileName, hb_bitOr( HB_DYN_CTYPE_FLOAT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_FLOAT }, a ), _ISOK_( a, b )
a := -( 2 ^ 7 ) ; ? ">", a, b := win_dllCall( { "TESTC" , cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR }, a ), _ISOK_( a, b )
a := ( 2 ^ 8 ) - 1 ; ? ">", a, b := win_dllCall( { "TESTUC", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_CHAR_UNSIGNED }, a ), _ISOK_( a, b )
a := -( 2 ^ 15 ) ; ? ">", a, b := win_dllCall( { "TESTS" , cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT }, a ), _ISOK_( a, b )
a := ( 2 ^ 16 ) - 1 ; ? ">", a, b := win_dllCall( { "TESTUS", cFileName, hb_bitOr( HB_DYN_CTYPE_SHORT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_SHORT_UNSIGNED }, a ), _ISOK_( a, b )
a := -( 2 ^ 31 ) ; ? ">", a, b := win_dllCall( { "TESTI" , cFileName, hb_bitOr( HB_DYN_CTYPE_INT , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT }, a ), _ISOK_( a, b )
a := ( 2 ^ 32 ) - 1 ; ? ">", a, b := win_dllCall( { "TESTUI", cFileName, hb_bitOr( HB_DYN_CTYPE_INT_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_INT_UNSIGNED }, a ), _ISOK_( a, b )
a := -( 2 ^ 31 ) ; ? ">", a, b := win_dllCall( { "TESTL" , cFileName, hb_bitOr( HB_DYN_CTYPE_LONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG }, a ), _ISOK_( a, b )
a := ( 2 ^ 32 ) - 1 ; ? ">", a, b := win_dllCall( { "TESTUL", cFileName, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LONG_UNSIGNED }, a ), _ISOK_( a, b )
a := -( 2 ^ 63 ) ; ? ">", a, b := win_dllCall( { "TEST6" , cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG }, a ), _ISOK_( a, b )
a := 18446744073709600000 ; ? ">", a, b := win_dllCall( { "TESTU6", cFileName, hb_bitOr( HB_DYN_CTYPE_LLONG_UNSIGNED , HB_DYN_CALLCONV_CDECL ), HB_DYN_CTYPE_LLONG_UNSIGNED }, a ), _ISOK_( a, b )
a := "hello world!" ; ? ">", a, b := win_dllCall( { "TESTST", cFileName, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_CDECL ) }, a ), _ISOK_( a, b )
? "=="
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 )
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 := "hello world!" ; ? ">", a, win_dllCallFoxPro( "DECLARE STRING TESTST IN " + cFileName + " STRING", a )
RETURN

23
harbour/contrib/hbwin/win_dllf.prg
View File

@@ -59,25 +59,30 @@ DECLARE [cFunctionType] FunctionName IN LibraryName [AS AliasName]
*/
FUNCTION win_dllCallFoxPro( cCommand, ... )
LOCAL aParam
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
LOCAL aType := {;
"SHORT" => HB_DYN_CTYPE_SHORT ,;
"INTEGER" => HB_DYN_CTYPE_INT ,;
"SINGLE" => HB_DYN_CTYPE_FLOAT ,;
"DOUBLE" => HB_DYN_CTYPE_DOUBLE ,;
"LONG" => HB_DYN_CTYPE_LONG ,;
"STRING" => HB_DYN_CTYPE_CHAR_PTR ,;
"OBJECT" => HB_DYN_CTYPE_VOID_PTR }
IF nPos <= Len( aCommand ) .AND. Upper( aCommand[ nPos ] ) == "DECLARE"
++nPos
ENDIF
IF nPos <= Len( aCommand ) .AND. ( tmp := AScan( aTypeS, {| tmp | tmp == Upper( aCommand[ nPos ] ) } ) ) > 0
nFuncFlags := hb_bitOr( nFuncFlags, aTypeN[ tmp ] )
IF nPos <= Len( aCommand ) .AND. Upper( aCommand[ nPos ] ) $ aType
nFuncFlags := hb_bitOr( nFuncFlags, aType[ Upper( aCommand[ nPos ] ) ] )
++nPos
ELSE
RETURN NIL
@@ -110,8 +115,8 @@ FUNCTION win_dllCallFoxPro( cCommand, ... )
aParam := { cFunction, cLibrary, nFuncFlags }
DO WHILE nPos <= Len( aCommand )
IF ( tmp := AScan( aTypeS, {| tmp | tmp == Upper( aCommand[ nPos ] ) } ) ) > 0
AAdd( aParam, hb_bitOr( HB_DYN_ENC_RAW, aTypeN[ tmp ] ) )
IF Upper( Upper( aCommand[ nPos ] ) ) $ aType
AAdd( aParam, hb_bitOr( HB_DYN_ENC_RAW, aType[ Upper( aCommand[ nPos ] ) ] ) )
++nPos
ENDIF
IF nPos <= Len( aCommand ) .AND. aCommand[ nPos ] == "@"