I use this code in my app, i use xharbour, the GLOBAL is exclusive in xharbour, but you can use static with harbour.
the functions "main_ini" and "main_end" is calls automatic for xharbour. not is need call manually in the code.
sorry for my bad english.
salu2
carlos vargas
add this line al begin in your main prg.
add this functions to main prg
...
INIT PROCEDURE Main_Ini()
/*crea objeto tmutex*/
oMutex := TMutex():Open( NIL, FALSE, "KDSoft" )
/*valida mutex*/
IF oMutex:hMutex==0
oMutex := TMutex():Create( NIL, FALSE, "KDSoft" )
ELSE
MsgAlert("La aplicación esta en ejecución actualmente!")
oMutex:Close()
QUIT
ENDIF
RETURN
/*Elimina mutex creado*/
EXIT PROCEDURE Main_End()
IF oMutex != Nil
oMutex:Close()
ENDIF
RETURN
...
add tyhis file tmutex.prg to your project.
//-----------------------------------------------------------------------------
#include "FiveWin.ch"
//-----------------------------------------------------------------------------
#define iKERNEL "Kernel32.dll"
#define iASPASCAL .T.
#define iTRUE 1
#define iFALSE 0
#define MUTANT_QUERY_STATE 1
#define STANDARD_RIGHTS_REQUIRED 983040
#define SYNCHRONIZE 1048576
#define MUTEX_ALL_ACCESS nOr( STANDARD_RIGHTS_REQUIRED, SYNCHRONIZE, MUTANT_QUERY_STATE )
#xtranslate Bool2Int( <lVar> ) => If( <lVar>, iTRUE, iFALSE )
//-----------------------------------------------------------------------------
CREATE CLASS TMutex
DATA cName
DATA hMutex
METHOD Create( sMutexAttr, lInitialOwner, cName ) CONSTRUCTOR
METHOD New( sMutexAttr, lInitialOwner, cName ) INLINE ::Create( sMutexAttr, lInitialOwner, cName )
METHOD Open( nAccess, lInitialOwner, cName ) Constructor
METHOD Close()
METHOD Release()
METHOD End() INLINE ::Close()
METHOD Failed() HIDDEN
ENDCLASS
//-----------------------------------------------------------------------------
METHOD Create( sMutexAttr, lInitialOwner, cName ) CLASS TMutex
LOCAL hDLL := LoadLibrary( iKERNEL )
LOCAL cFunc := "CreateMutexA"
LOCAL cBuffer := NIL
LOCAL cFarProc
DEFAULT lInitialOwner := .F., cName := "FiveWin App"
::hMutex := 0
::cName := ""
IF ValType( sMutexAttr ) == "O" .and. Upper( sMutexAttr:className() ) == "TSTRUCT"
cBuffer := sMutexAttr:cBuffer
Endif
::cName := cName
IF Abs( hDLL ) > 32
cFarProc := GetProcAdd( hDLL, cFunc, iASPASCAL, LONG, LONG, LONG, STRING )
::hMutex := FWCallDLL( cFarProc, iif( cBuffer != NIL, @cBuffer, cBuffer ), Bool2Int( lInitialOwner ), cName + Chr(0) )
FreeLibrary( hDLL )
IF cBuffer != NIL
sMutexAttr:cBuffer := cBuffer
ENDIF
ELSE
::Failed( hDLL, cFunc )
ENDIF
RETURN Self
//-----------------------------------------------------------------------------
METHOD Open( nAccess, lInitialOwner, cName ) CLASS TMutex
LOCAL hDLL := LoadLibrary( iKERNEL )
LOCAL cFunc := "OpenMutexA"
LOCAL cFarProc
DEFAULT nAccess := MUTEX_ALL_ACCESS, lInitialOwner := .F., cName := "FiveWin App"
::cName := cName
IF Abs( hDLL ) > 32
cFarProc := GetProcAdd( hDLL, cFunc, iASPASCAL, LONG, LONG, LONG, STRING )
::hMutex := FWCallDLL( cFarProc, nAccess, Bool2Int( lInitialOwner ), cName + Chr(0) )
FreeLibrary( hDLL )
ELSE
::Failed( hDLL, cFunc )
ENDIF
RETURN Self
//-----------------------------------------------------------------------------
METHOD Close() CLASS TMutex
LOCAL hDLL := LoadLibrary( iKERNEL )
LOCAL cFunc := "CloseHandle"
LOCAL nResult
LOCAL cFarProc
IF Abs( hDLL ) > 32
cFarProc := GetProcAdd( hDLL, cFunc, iASPASCAL, LONG, LONG )
nResult := FWCallDLL( cFarProc, ::hMutex )
FreeLibrary( hDLL )
::hMutex := 0
ELSE
::Failed( hDLL, cFunc )
ENDIF
RETURN nResult
//-----------------------------------------------------------------------------
METHOD Release() CLASS TMutex
LOCAL hDLL := LoadLibrary( iKERNEL )
LOCAL cFunc := "ReleaseMutex"
LOCAL cFarProc
LOCAL nResult
IF Abs( hDLL ) > 32
cFarProc := GetProcAdd( hDLL, cFunc, iASPASCAL, LONG, LONG )
nResult := FWCallDLL( cFarProc, ::hMutex )
FreeLibrary( hDLL )
ELSE
::Failed( hDLL, cFunc )
ENDIF
RETURN nResult
//-----------------------------------------------------------------------------
METHOD Failed( nError, cFunc ) CLASS TMutex
MsgAlert( "Error: " + LTrim( Str( nError ) ) + " al cargar " + iKERNEL + CRLF + "Función: " + cFunc, "Clase " + ::className() )
RETURN Self
//-----------------------------------------------------------------------------
//EOF
//-----------------------------------------------------------------------------
