I created HMG_CallDLL() function based on Harbour Dynamic Call Library functions, please test it.
HMG_CallDLL ( cLibName, [ nRetType ] , cFuncName, Arg1, ..., ArgN ) ---> xRetValue
nRetType values are defined in hbdyn.ch
Code: Select all
#include "hmg.ch"
#include "hbdyn.ch"
// HMG_CallDLL ( cLibName, [ nRetType ] , cFuncName, Arg1, ..., ArgN ) ---> xRetValue
FUNCTION MAIN
LOCAL cBuffer, nFlags
cBuffer := SPACE (512 * 2)
MsgDebug (HMG_CallDLL ("shell32.dll", HB_DYN_CTYPE_INT, "SHGetSpecialFolderPath", 0, @cBuffer, CSIDL_APPDATA, 0), cBuffer)
cBuffer := GetCurrentFolder()
MsgDebug (cBuffer, HMG_CallDLL ("shell32.dll", HB_DYN_CTYPE_VOID, "PathGetShortPath", @cBuffer), cBuffer)
nFlags := 0
MsgDebug (nFlags, HMG_CallDLL ("WININET.DLL", HB_DYN_CTYPE_BOOL, "InternetGetConnectedState", @nFlags, 0), nFlags)
DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 800 ;
HEIGHT 500 ;
TITLE 'HMG_CallDLL Demo' ;
MAIN
ON KEY F3 ACTION (cBuffer := SPACE (512 * 2), MsgDebug (HMG_CallDLL ("USER32.DLL", HB_DYN_CTYPE_INT, "GetWindowModuleFileName", Win_1.HANDLE, @cBuffer, 512), cBuffer))
ON KEY F5 ACTION (cBuffer := SPACE (512 * 2), MsgDebug (HMG_CallDLL ("USER32.DLL", HB_DYN_CTYPE_INT, "GetWindowText", Win_1.HANDLE, @cBuffer, 512), cBuffer))
ON KEY F7 ACTION MsgDebug (HMG_CallDLL ("USER32.DLL", HB_DYN_CTYPE_BOOL, "SetWindowText", Win_1.HANDLE, "áéíóú"))
END WINDOW
CENTER WINDOW Win_1
ACTIVATE WINDOW Win_1
RETURN NIL
FUNCTION HMG_CallDLL ( cLibName, nRetType, cFuncName, ... )
STATIC s_hDLL := { => }
STATIC s_mutex := hb_mutexCreate()
LOCAL nCallConv := HB_DYN_CALLCONV_STDCALL
LOCAL nEncoding := IIF ( HMG_IsCurrentCodePageUnicode(), HB_DYN_ENC_UTF16, HB_DYN_ENC_ASCII )
LOCAL pLibrary
IF HB_ISSTRING( cFuncName ) .AND. HB_ISSTRING( cLibName )
hb_mutexLock( s_mutex )
IF !( cLibName $ s_hDLL )
s_hDLL[ cLibName ] := hb_libLoad( cLibName )
ENDIF
pLibrary := s_hDLL[ cLibName ]
hb_mutexUnlock( s_mutex )
IF .NOT. HB_ISNUMERIC( nRetType )
nRetType := HB_DYN_CTYPE_DEFAULT
ENDIF
cFuncName := ALLTRIM (cFuncName)
DO CASE
CASE HMG_IsCurrentCodePageUnicode() == .T. .AND. HMG_IsFuncDLL( pLibrary, cFuncName + "W" )
cFuncName := cFuncName + "W"
CASE HMG_IsCurrentCodePageUnicode() == .F. .AND. HMG_IsFuncDLL( pLibrary, cFuncName + "A" )
cFuncName := cFuncName + "A"
ENDCASE
RETURN hb_DynCall ( { cFuncName, pLibrary, hb_bitOR (nCallConv, nRetType, nEncoding) }, ... )
ENDIF
RETURN NIL
#pragma BEGINDUMP
#include "SET_COMPILE_HMG_UNICODE.ch"
#include "HMG_UNICODE.h"
#include <windows.h>
#include "hbapi.h"
// HMG_IsFuncDLL ( pLibDLL | cLibName, cFuncName ) ---> Boolean
HB_FUNC ( HMG_ISFUNCDLL )
{
HMODULE hModule = NULL;
BOOL bRelease;
if ( HB_ISCHAR (1) )
{ hModule = LoadLibrary ((TCHAR *) HMG_parc (1));
bRelease = TRUE;
}
else
{ hModule = hb_libHandle (hb_param (1, HB_IT_ANY));
bRelease = FALSE;
}
CHAR * cFuncName = (CHAR *) hb_parc (2);
hb_retl (GetProcAddress (hModule, cFuncName) ? TRUE : FALSE);
if (bRelease && hModule)
FreeLibrary (hModule);
}
#pragma ENDDUMP