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

2008-06-10 21:11 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* contrib/hbw32/dllcall.c
     % Optimizations. Removed one internal limit.

   + contrib/hbw32/tests/testdll.prg
     + Added small test code.
This commit is contained in:
Viktor Szakats
2008-06-10 19:13:02 +00:00
parent 1ac0a60e28
commit ae937b4b9b
3 changed files with 101 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
harbour/ChangeLog
View File

@@ -8,6 +8,13 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

66
harbour/contrib/hbw32/dllcall.c
View File

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

75
harbour/contrib/hbw32/tests/testdll.prg Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* DLL call demonstration.
*
* Copyright 2008 Viktor Szakats <harbour.01 syenar.hu>
* 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