From ae937b4b9b52008c51eeb9c00ca89dda0d78f771 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 10 Jun 2008 19:13:02 +0000 Subject: [PATCH] 2008-06-10 21:11 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * contrib/hbw32/dllcall.c % Optimizations. Removed one internal limit. + contrib/hbw32/tests/testdll.prg + Added small test code. --- harbour/ChangeLog | 7 +++ harbour/contrib/hbw32/dllcall.c | 66 +++++++--------------- harbour/contrib/hbw32/tests/testdll.prg | 75 +++++++++++++++++++++++++ 3 files changed, 101 insertions(+), 47 deletions(-) create mode 100644 harbour/contrib/hbw32/tests/testdll.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 180939ab5a..cef910f66b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,13 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-06-10 21:11 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * contrib/hbw32/dllcall.c + % Optimizations. Removed one internal limit. + + + contrib/hbw32/tests/testdll.prg + + Added small test code. + 2008-06-10 19:36 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/gtwvt/gtwvt.c ! do not use min()/max() C functions. These are not portable diff --git a/harbour/contrib/hbw32/dllcall.c b/harbour/contrib/hbw32/dllcall.c index adcabdf9fa..a8813aeaf7 100644 --- a/harbour/contrib/hbw32/dllcall.c +++ b/harbour/contrib/hbw32/dllcall.c @@ -789,42 +789,30 @@ HB_FUNC( DLLEXECUTECALL ) DllExec( 0, 0, NULL, xec, hb_pcount(), 2 ); } +static LPVOID hb_getprocaddress( HMODULE hInst, int i ) +{ + LPVOID lpFunction = ( LPVOID ) GetProcAddress( hInst, ISCHAR( i ) ? ( LPCSTR ) hb_parc( i ) : ( LPCSTR ) hb_parni( i ) ); + + if( lpFunction == 0 && ISCHAR( i ) ) /* try ANSI flavour? */ + { + char * pszFuncName = ( char * ) hb_xgrab( hb_parclen( i ) + 2 ); + hb_strncpy( pszFuncName, hb_parc( i ), hb_parclen( i ) ); + lpFunction = ( LPVOID ) GetProcAddress( hInst, strcat( pszFuncName, "A" ) ); + hb_xfree( pszFuncName ); + } + + return lpFunction; +} + HB_FUNC( DLLCALL ) { - HINSTANCE hInst; - BOOL lUnload; - - if( ISCHAR( 1 ) ) - { - hInst = LoadLibraryA( hb_parc( 1 ) ); - lUnload = TRUE; - } - else - { - hInst = ( HINSTANCE ) hb_parnl( 1 ); - lUnload = FALSE; - } + HINSTANCE hInst = ISCHAR( 1 ) ? LoadLibraryA( hb_parc( 1 ) ) : ( HINSTANCE ) hb_parnl( 1 ); if( hInst && ( DWORD ) hInst >= 32 ) { - LPVOID lpFunction; - - if( ( lpFunction = ( LPVOID ) GetProcAddress( ( HMODULE ) hInst, ISCHAR( 3 ) ? ( LPCSTR ) hb_parc( 3 ) : - ( LPCSTR ) hb_parni( 3 ) ) ) == 0 ) - { - if( ISCHAR( 3 ) ) - { - /* try ANSI flavour */ - char cFuncName[ MAX_PATH ]; - hb_strncpy( cFuncName, hb_parc( 3 ), sizeof( cFuncName ) - 2 ); - strcat( cFuncName, "A" ); - lpFunction = ( LPVOID ) GetProcAddress( ( HMODULE ) hInst, cFuncName ); - } - } + DllExec( hb_parni( 2 ), 0, hb_getprocaddress( ( HMODULE ) hInst, 3 ), NULL, hb_pcount(), 4 ); - DllExec( hb_parni( 2 ), 0, lpFunction, NULL, hb_pcount(), 4 ); - - if( lUnload ) + if( ISCHAR( 1 ) ) FreeLibrary( hInst ); } } @@ -854,23 +842,7 @@ HB_FUNC( SETLASTERROR ) HB_FUNC( GETPROCADDRESS ) { - LPVOID lpFunction; - - if( ( lpFunction = ( LPVOID ) GetProcAddress( ( HMODULE ) hb_parnl( 1 ), - ISCHAR( 2 ) ? ( LPCSTR ) hb_parc( 2 ) : - ( LPCSTR ) hb_parni( 2 ) ) ) == 0 ) - { - if( ISCHAR( 2 ) ) - { - /* try ANSI flavour */ - char cFuncName[ MAX_PATH ]; - hb_strncpy( cFuncName, hb_parc( 2 ), sizeof( cFuncName ) - 2 ); - strcat( cFuncName, "A" ); - lpFunction = ( LPVOID ) GetProcAddress( ( HMODULE ) hb_parnl( 1 ), cFuncName ); - } - } - - hb_retptr( lpFunction ); + hb_retptr( hb_getprocaddress( ( HMODULE ) hb_parnl( 1 ), 2 ) ); } /* Call a DLL function from (x)Harbour, the first parameter is a pointer returned from diff --git a/harbour/contrib/hbw32/tests/testdll.prg b/harbour/contrib/hbw32/tests/testdll.prg new file mode 100644 index 0000000000..cbb638f822 --- /dev/null +++ b/harbour/contrib/hbw32/tests/testdll.prg @@ -0,0 +1,75 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * DLL call demonstration. + * + * Copyright 2008 Viktor Szakats + * www - http://www.harbour-project.org + * + */ + +#define MB_OK 0x00000000 +#define MB_OKCANCEL 0x00000001 +#define MB_ABORTRETRYIGNORE 0x00000002 +#define MB_YESNOCANCEL 0x00000003 +#define MB_YESNO 0x00000004 +#define MB_RETRYCANCEL 0x00000005 +#define MB_CANCELTRYCONTINUE 0x00000006 +#define MB_ICONHAND 0x00000010 +#define MB_ICONQUESTION 0x00000020 +#define MB_ICONEXCLAMATION 0x00000030 +#define MB_ICONASTERISK 0x00000040 +#define MB_USERICON 0x00000080 +#define MB_DEFBUTTON2 0x00000100 +#define MB_DEFBUTTON3 0x00000200 +#define MB_DEFBUTTON4 0x00000300 +#define MB_SYSTEMMODAL 0x00001000 +#define MB_TASKMODAL 0x00002000 +#define MB_HELP 0x00004000 +#define MB_NOFOCUS 0x00008000 +#define MB_SETFOREGROUND 0x00010000 +#define MB_DEFAULT_DESKTOP_ONLY 0x00020000 +#define MB_TOPMOST 0x00040000 +#define MB_RIGHT 0x00080000 +#define MB_RTLREADING 0x00100000 + +PROCEDURE Main() + LOCAL hDLL + LOCAL cData + + IF File( "pscript.dll" ) + hDLL := DllLoad( "pscript.dll" ) + cData := Space( 24 ) + DllCall( hDll, NIL, "PSGetVersion", @cData ) + ? ">" + cData + "<" + DllUnload( hDLL ) + + // ; Testing failure 1 + hDLL := DllLoad( "pscript.dll" ) + cData := Space( 24 ) + DllCall( hDll, NIL, "PSGet__Version", @cData ) + ? ">" + cData + "<" + DllUnload( hDLL ) + ENDIF + + // ; Testing failure 2 + hDLL := DllLoad( "nothere.dll" ) + cData := Space( 24 ) + DllCall( hDll, NIL, "PSGetVersion", @cData ) + ? cData + DllUnload( hDLL ) + + DllCall( "user32.dll", NIL, "MessageBoxA", 0, "Hello world!", "Harbour sez", hb_bitOr( MB_OK, MB_ICONHAND ) ) + + IF File( "libcurl.dll" ) + hDLL := DllLoad( "libcurl.dll" ) + ? GetProcAddress( hDLL, "curl_version" ) + // ; This one doesn't work. + ? CallDllTyped( 10 /* return string */, GETPROCADDRESS( hDLL, "CURL_VERSION" ) ) + DllUnload( hDLL ) + ENDIF + + RETURN NIL