Private Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long _
  ) As Long
 
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" ( _
    ByVal lpMutexAttributes As Long, _
    ByVal bInitialOwner As Long, _
    ByVal lpName As String _
  ) As Long
 
Private Declare Function OpenMutex Lib "kernel32.dll" Alias "OpenMutexA" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal lpName As String _
  ) As Long
 
Private Const MUTEX_ALL_ACCESS = &H1 Or &HF0000 Or &H100000
Private Const MY_MUTEX As String = "MeinSinnvollerMutexName"
 
Private m_Mutex                 As Long
 
Public Sub Main()
 
  On Error Resume Next
 
  If isAlreadyRunning Then 
    'Evtl. MsgBox
    End
  End If
 
  m_Mutex = CreateMutex(0&, 0&, ByVal MY_MUTEX)
 
 
  '...
 
End Sub
 
Private Function isAlreadyRunning() As Boolean
 
  Dim lngResult As Long
 
  On Error Resume Next
 
 
  lngResult = OpenMutex(MUTEX_ALL_ACCESS, 0&, MY_MUTEX)
  isAlreadyRunning = lngResult <> 0
 
  If isAlreadyRunning Then
    CloseHandle lngResult
  End If
 
End Function
 
'Muss beim Beenden deiner App aufgerufen werden
Public Sub ProgramTerminate()
  CloseHandle m_Mutex
End Sub

Gruß
Dirk

--
?Get it right the first time

Beitrag wurde zuletzt am 05.09.11 um 09:54:20 editiert.