diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a99d3baeb7..47c09b31d6 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,25 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-12 12:49 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbwin/Makefile + * contrib/hbwin/win_dll.c + + contrib/hbwin/win_dllx.c + * contrib/hbwin/legacycd.c + + Moved LOADLIBRARY(), FREELIBRARY() and GETPROCADDRESS() to legacy source. + + Moved Xbase++ compatibel DLL interface to separate Xbase++ specific file. + ; From now on the recommended native DLL interface for Harbour apps is: + WAPI_LOADLIBRARY(), WAPI_GETPROCADDRESS(), WAPI_FREELIBRARY() and + WIN_DLLCALL() + ; TODO: Solve GC collected HMODULE in above WAPI LIB handling functions. + ; TODO: Clean HB_LIB*() vs. WAPI LIB handling confusion. + + * contrib/hbwin/tests/testdll.prg + * Changed to use WAPI_LOADLIBRARY()/WAPI_FREELIBRARY() + ! Fixed one remaining CALLDLLTYPED() call. + - Deleted no more valid comment about not-working libcurl .dll call. + Now it works. + 2010-02-12 12:20 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbwin/hbwin.ch + Added HB_WIN_DLL_CALLCONV_* macros. (so far only privately defined inside .c code) diff --git a/harbour/contrib/hbwin/Makefile b/harbour/contrib/hbwin/Makefile index a6a0a8adc3..8c190f7cb6 100644 --- a/harbour/contrib/hbwin/Makefile +++ b/harbour/contrib/hbwin/Makefile @@ -35,6 +35,7 @@ C_SOURCES := \ win_com.c \ win_dlg.c \ win_dll.c \ + win_dllx.c \ win_misc.c \ win_osc.c \ win_prn1.c \ diff --git a/harbour/contrib/hbwin/legacycd.c b/harbour/contrib/hbwin/legacycd.c index aa4dc253c7..dc88cef5b5 100644 --- a/harbour/contrib/hbwin/legacycd.c +++ b/harbour/contrib/hbwin/legacycd.c @@ -78,6 +78,37 @@ HB_FUNC( SETLASTERROR ) SetLastError( hb_parnl( 1 ) ); } +HB_FUNC( LOADLIBRARY ) +{ + void * hFileName; + + hb_retnint( ( HB_PTRDIFF ) LoadLibrary( HB_PARSTRDEF( 1, &hFileName, NULL ) ) ); + + hb_strfree( hFileName ); +} + +HB_FUNC( FREELIBRARY ) +{ + if( HB_ISPOINTER( 1 ) ) + hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) ? HB_TRUE : HB_FALSE ); + else if( HB_ISNUM( 1 ) ) + hb_retl( FreeLibrary( ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ) ) ? HB_TRUE : HB_FALSE ); + else + hb_retl( HB_FALSE ); +} + +HB_FUNC( GETPROCADDRESS ) +{ + HMODULE hDLL; + + if( HB_ISNUM( 1 ) ) + hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); + else + hDLL = ( HMODULE ) hb_parptr( 1 ); + + hb_retptr( hDLL ? ( void * ) hbwin_getprocaddress( hDLL, 2, NULL ) : NULL ); +} + #ifndef HB_WIN_NO_LEGACY #define HB_WIN_NO_LEGACY #endif diff --git a/harbour/contrib/hbwin/tests/testdll.prg b/harbour/contrib/hbwin/tests/testdll.prg index 91fc4e3f13..fbc7ead55c 100644 --- a/harbour/contrib/hbwin/tests/testdll.prg +++ b/harbour/contrib/hbwin/tests/testdll.prg @@ -74,11 +74,10 @@ PROCEDURE Main() ? "MsgBox:", DllCall( "user32.dll", NIL, "MessageBoxA", 0, "Hello world!", "Harbour sez", hb_bitOr( MB_OKCANCEL, MB_ICONEXCLAMATION, MB_HELP ) ) IF hb_FileExists( "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 ) + hDLL := wapi_LoadLibrary( "libcurl.dll" ) + ? wapi_GetProcAddress( hDLL, "curl_version" ) + ? win_dllCall( { NIL, HB_WIN_DLL_CTYPE_CHAR_PTR }, wapi_GetProcAddress( hDLL, "curl_version" ) ) + wapi_FreeLibrary( hDLL ) ENDIF /* Force Windows not to show dragged windows contents */ @@ -95,17 +94,17 @@ PROCEDURE Main() /* Get some standard Windows folders */ - hDLL := DllLoad( "shell32.dll" ) + hDLL := wapi_LoadLibrary( "shell32.dll" ) ? "ValType( hDLL ): ", ValType( hDLL ) cData := Space( MAX_PATH ) - ? "WIN_DLLCALL (BOOL retval): ", win_dllCall( { NIL, HB_WIN_DLL_CTYPE_BOOL }, GetProcAddress( hDLL, "SHGetSpecialFolderPath" ), 0, @cData, CSIDL_APPDATA, 0 ) + ? "WIN_DLLCALL (BOOL retval): ", win_dllCall( { NIL, HB_WIN_DLL_CTYPE_BOOL }, wapi_GetProcAddress( hDLL, "SHGetSpecialFolderPath" ), 0, @cData, CSIDL_APPDATA, 0 ) ? "@cData: ", cData - ? "WIN_DLLCALL: ", win_dllCall( GetProcAddress( hDLL, "SHGetFolderPath" ), 0, CSIDL_ADMINTOOLS, 0, 0, cData ) // WRONG + ? "WIN_DLLCALL: ", win_dllCall( wapi_GetProcAddress( hDLL, "SHGetFolderPath" ), 0, CSIDL_ADMINTOOLS, 0, 0, cData ) // WRONG ? "cData:", cData cData := Space( MAX_PATH ) - ? "WIN_DLLCALL: ", win_dllCall( GetProcAddress( hDLL, "SHGetFolderPath" ), 0, CSIDL_ADMINTOOLS, 0, 0, @cData ) + ? "WIN_DLLCALL: ", win_dllCall( wapi_GetProcAddress( hDLL, "SHGetFolderPath" ), 0, CSIDL_ADMINTOOLS, 0, 0, @cData ) ? "@cData: ", cData - DllUnload( hDLL ) + wapi_FreeLibrary( hDLL ) ? "DLLCALL" cData := Space( MAX_PATH ) diff --git a/harbour/contrib/hbwin/win_dll.c b/harbour/contrib/hbwin/win_dll.c index dfed4ba0a3..7bf84890d7 100644 --- a/harbour/contrib/hbwin/win_dll.c +++ b/harbour/contrib/hbwin/win_dll.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * Windows DLL handling function (Xbase++ compatible + proprietary) + * Windows DLL handling function * * Copyright 2009-2010 Viktor Szakats (harbour.01 syenar.hu) * Based on some original code by: @@ -1157,178 +1157,6 @@ FARPROC hbwin_getprocaddress( HMODULE hDLL, int iParam, HB_BOOL * pbUNICODE ) return lpFunction; } -HB_FUNC( LOADLIBRARY ) -{ - void * hFileName; - - hb_retnint( ( HB_PTRDIFF ) LoadLibrary( HB_PARSTRDEF( 1, &hFileName, NULL ) ) ); - - hb_strfree( hFileName ); -} - -HB_FUNC( FREELIBRARY ) -{ - if( HB_ISPOINTER( 1 ) ) - hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) ? HB_TRUE : HB_FALSE ); - else if( HB_ISNUM( 1 ) ) - hb_retl( FreeLibrary( ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ) ) ? HB_TRUE : HB_FALSE ); - else - hb_retl( HB_FALSE ); -} - -HB_FUNC( GETPROCADDRESS ) -{ - HMODULE hDLL; - - if( HB_ISNUM( 1 ) ) - hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); - else - hDLL = ( HMODULE ) hb_parptr( 1 ); - - hb_retptr( hDLL ? ( void * ) hbwin_getprocaddress( hDLL, 2, NULL ) : NULL ); -} - -#ifdef HB_COMPAT_XPP - -/* NOTE: I'm not totally familiar with how Xbase++ works. This functionality - was derived from the context in which the functions are used. [pt] */ - -typedef struct -{ - HMODULE hDLL; /* Handle */ - HB_BOOL bFreeDLL; /* Free library handle on destroy? */ - int iCallConv; - int iRetType; - HB_BOOL bUNICODE; - FARPROC lpFunction; /* Function Address */ -} HB_DLLEXEC, * PHB_DLLEXEC; - -static HB_GARBAGE_FUNC( _DLLUnload ) -{ - PHB_DLLEXEC xec = ( PHB_DLLEXEC ) Cargo; - - if( xec->hDLL && xec->bFreeDLL ) - { - FreeLibrary( xec->hDLL ); - xec->hDLL = NULL; - } -} - -static const HB_GC_FUNCS s_gcDllFuncs = -{ - _DLLUnload, - hb_gcDummyMark -}; - -HB_FUNC( DLLLOAD ) -{ - HB_FUNC_EXEC( LOADLIBRARY ); -} - -HB_FUNC( DLLUNLOAD ) -{ - HB_FUNC_EXEC( FREELIBRARY ); -} - -HB_FUNC( DLLCALL ) -{ - HMODULE hDLL; - - if( HB_ISPOINTER( 1 ) ) - hDLL = ( HMODULE ) hb_parptr( 1 ); - else if( HB_ISNUM( 1 ) ) - hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); - else if( HB_ISCHAR( 1 ) ) - { - void * hFileName; - hDLL = LoadLibrary( HB_PARSTR( 1, &hFileName, NULL ) ); - hb_strfree( hFileName ); - } - else - hDLL = NULL; - - if( hDLL && ( HB_PTRDIFF ) hDLL >= 32 ) - { - HB_BOOL bUNICODE; - FARPROC lpFunction = hbwin_getprocaddress( hDLL, 3, &bUNICODE ); - - hbwin_dllCall( HB_ISNUM( 2 ) ? hb_parni( 2 ) : HB_WIN_DLL_CALLCONV_STDCALL, - HB_WIN_DLL_CTYPE_DEFAULT, - bUNICODE, - lpFunction, - hb_pcount(), - 4, - NULL ); - - if( HB_ISCHAR( 1 ) ) - FreeLibrary( hDLL ); - } -} - -/* TODO: Add support for UNICODE (*W()) calls. */ - -HB_FUNC( DLLPREPARECALL ) -{ - PHB_DLLEXEC xec = ( PHB_DLLEXEC ) hb_gcAllocate( sizeof( HB_DLLEXEC ), &s_gcDllFuncs ); - const char * pszErrorText; - - memset( xec, 0, sizeof( HB_DLLEXEC ) ); - - if( HB_ISCHAR( 1 ) ) - { - void * hFileName; - xec->hDLL = LoadLibrary( HB_PARSTR( 1, &hFileName, NULL ) ); - hb_strfree( hFileName ); - if( xec->hDLL ) - xec->bFreeDLL = HB_TRUE; - } - else if( HB_ISPOINTER( 1 ) ) - xec->hDLL = ( HMODULE ) hb_parptr( 1 ); - else if( HB_ISNUM( 1 ) ) - xec->hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); - - if( xec->hDLL ) - { - HB_BOOL bUNICODE; - xec->lpFunction = hbwin_getprocaddress( xec->hDLL, 3, &bUNICODE ); - if( xec->lpFunction ) - { - xec->iCallConv = HB_ISNUM( 2 ) ? hb_parni( 2 ) : HB_WIN_DLL_CALLCONV_STDCALL; - xec->bUNICODE = bUNICODE; - - hb_retptrGC( xec ); - return; - } - pszErrorText = HB_ISCHAR( 3 ) ? "Invalid function name" : "Invalid function ordinal"; - } - else - pszErrorText = HB_ISCHAR( 1 ) ? "Invalid library name" : "Invalid library handle"; - - hb_gcFree( xec ); - - hb_errRT_BASE( EG_ARG, 2010, pszErrorText, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); -} - -HB_FUNC( DLLEXECUTECALL ) -{ - PHB_DLLEXEC xec = ( PHB_DLLEXEC ) hb_parptrGC( &s_gcDllFuncs, 1 ); - - if( xec && xec->hDLL && xec->lpFunction ) - { - hbwin_dllCall( xec->iCallConv, - xec->iRetType, - xec->bUNICODE, - xec->lpFunction, - hb_pcount(), - 2, - NULL ); - } -} - -#endif /* HB_COMPAT_XPP */ - -/* ------------------------------------------------------------------ */ - HB_FUNC( WIN_DLLCALL ) { PHB_ITEM pParam = hb_param( 1, HB_IT_ARRAY ); diff --git a/harbour/contrib/hbwin/win_dllx.c b/harbour/contrib/hbwin/win_dllx.c new file mode 100644 index 0000000000..fb900c8564 --- /dev/null +++ b/harbour/contrib/hbwin/win_dllx.c @@ -0,0 +1,212 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Windows DLL handling function (Xbase++ compatible) + * + * Copyright 2010 Viktor Szakats (harbour.01 syenar.hu) + * Copyright 2006 Paul Tucker + * Copyright 2002 Vic McClung + * 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 "hbwin.h" +#include "hbapierr.h" +#include "hbapiitm.h" +#include "hbvm.h" + +#ifndef HB_WIN_NO_LEGACY +#define HB_WIN_NO_LEGACY +#endif +#undef HB_LEGACY_LEVEL3 +#include "hbwin.ch" + +#ifdef HB_COMPAT_XPP + +/* NOTE: I'm not totally familiar with how Xbase++ works. This functionality + was derived from the context in which the functions are used. [pt] */ + +typedef struct +{ + HMODULE hDLL; /* Handle */ + HB_BOOL bFreeDLL; /* Free library handle on destroy? */ + int iCallConv; + int iRetType; + HB_BOOL bUNICODE; + FARPROC lpFunction; /* Function Address */ +} HB_DLLEXEC, * PHB_DLLEXEC; + +static HB_GARBAGE_FUNC( _DLLUnload ) +{ + PHB_DLLEXEC xec = ( PHB_DLLEXEC ) Cargo; + + if( xec->hDLL && xec->bFreeDLL ) + { + FreeLibrary( xec->hDLL ); + xec->hDLL = NULL; + } +} + +static const HB_GC_FUNCS s_gcDllFuncs = +{ + _DLLUnload, + hb_gcDummyMark +}; + +HB_FUNC( DLLLOAD ) +{ + void * hFileName; + + hb_retnint( ( HB_PTRDIFF ) LoadLibrary( HB_PARSTRDEF( 1, &hFileName, NULL ) ) ); + + hb_strfree( hFileName ); +} + +HB_FUNC( DLLUNLOAD ) +{ + if( HB_ISPOINTER( 1 ) ) + hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) ? HB_TRUE : HB_FALSE ); + else if( HB_ISNUM( 1 ) ) + hb_retl( FreeLibrary( ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ) ) ? HB_TRUE : HB_FALSE ); + else + hb_retl( HB_FALSE ); +} + +HB_FUNC( DLLCALL ) +{ + HMODULE hDLL; + + if( HB_ISPOINTER( 1 ) ) + hDLL = ( HMODULE ) hb_parptr( 1 ); + else if( HB_ISNUM( 1 ) ) + hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + void * hFileName; + hDLL = LoadLibrary( HB_PARSTR( 1, &hFileName, NULL ) ); + hb_strfree( hFileName ); + } + else + hDLL = NULL; + + if( hDLL && ( HB_PTRDIFF ) hDLL >= 32 ) + { + HB_BOOL bUNICODE; + FARPROC lpFunction = hbwin_getprocaddress( hDLL, 3, &bUNICODE ); + + hbwin_dllCall( HB_ISNUM( 2 ) ? hb_parni( 2 ) : HB_WIN_DLL_CALLCONV_STDCALL, + HB_WIN_DLL_CTYPE_DEFAULT, + bUNICODE, + lpFunction, + hb_pcount(), + 4, + NULL ); + + if( HB_ISCHAR( 1 ) ) + FreeLibrary( hDLL ); + } +} + +/* TODO: Add support for UNICODE (*W()) calls. */ + +HB_FUNC( DLLPREPARECALL ) +{ + PHB_DLLEXEC xec = ( PHB_DLLEXEC ) hb_gcAllocate( sizeof( HB_DLLEXEC ), &s_gcDllFuncs ); + const char * pszErrorText; + + memset( xec, 0, sizeof( HB_DLLEXEC ) ); + + if( HB_ISCHAR( 1 ) ) + { + void * hFileName; + xec->hDLL = LoadLibrary( HB_PARSTR( 1, &hFileName, NULL ) ); + hb_strfree( hFileName ); + if( xec->hDLL ) + xec->bFreeDLL = HB_TRUE; + } + else if( HB_ISPOINTER( 1 ) ) + xec->hDLL = ( HMODULE ) hb_parptr( 1 ); + else if( HB_ISNUM( 1 ) ) + xec->hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ); + + if( xec->hDLL ) + { + HB_BOOL bUNICODE; + xec->lpFunction = hbwin_getprocaddress( xec->hDLL, 3, &bUNICODE ); + if( xec->lpFunction ) + { + xec->iCallConv = HB_ISNUM( 2 ) ? hb_parni( 2 ) : HB_WIN_DLL_CALLCONV_STDCALL; + xec->bUNICODE = bUNICODE; + + hb_retptrGC( xec ); + return; + } + pszErrorText = HB_ISCHAR( 3 ) ? "Invalid function name" : "Invalid function ordinal"; + } + else + pszErrorText = HB_ISCHAR( 1 ) ? "Invalid library name" : "Invalid library handle"; + + hb_gcFree( xec ); + + hb_errRT_BASE( EG_ARG, 2010, pszErrorText, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( DLLEXECUTECALL ) +{ + PHB_DLLEXEC xec = ( PHB_DLLEXEC ) hb_parptrGC( &s_gcDllFuncs, 1 ); + + if( xec && xec->hDLL && xec->lpFunction ) + { + hbwin_dllCall( xec->iCallConv, + xec->iRetType, + xec->bUNICODE, + xec->lpFunction, + hb_pcount(), + 2, + NULL ); + } +} + +#endif /* HB_COMPAT_XPP */