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

2010-02-12 12:49 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2010-02-12 11:50:18 +00:00
parent 8a2c2d71bd
commit dd737b5c65
6 changed files with 273 additions and 183 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

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

1
harbour/contrib/hbwin/Makefile
View File

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

31
harbour/contrib/hbwin/legacycd.c
View File

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

19
harbour/contrib/hbwin/tests/testdll.prg
View File

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

174
harbour/contrib/hbwin/win_dll.c
View File

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

212
harbour/contrib/hbwin/win_dllx.c Normal file
View File

@@ -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 <ptucker@sympatico.ca>
* Copyright 2002 Vic McClung <vicmcclung@vicmcclung.com>
* 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 */