О запрете повторного запуска приложения

option explicit
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Declare Function CreateSemaphore Lib "kernel32" Alias "CreateSemaphoreA" (ByRef lpSemaphoreAttributes As SECURITY_ATTRIBUTES, ByVal lInitialCount As Long, ByVal lMaximumCount As Long, ByVal lpName As String) As Long
Private Declare Function ReleaseSemaphore Lib "kernel32" (ByVal hSemaphore As Long, ByVal lReleaseCount As Long, lpPreviousCount As Long) As Long
 
Private Const SEMAPHORE_MODIFY_STATE As Long = 2&
Private Const SEMAPHORE_ALL_ACCESS As Long = &H1F0003
Private Const ERROR_ALREADY_EXISTS As Long = 183&
 
Dim semHNDL As Long
 
Private Sub Form_Initialize()
    Dim lr As Long
    Dim SA As SECURITY_ATTRIBUTES
 
    SA.nLength = Len(SA)
    SA.lpSecurityDescriptor = SEMAPHORE_MODIFY_STATE
    SA.bInheritHandle = True
    Err.Clear
    semHNDL = CreateSemaphore(SA, 0&, 1&, "sem_MyProgram6")
    lr = Err.LastDllError
    Debug.Print "semHNDL = " & semHNDL & ". LastDllError = " & lr
    If lr = ERROR_ALREADY_EXISTS Then MsgBox "... уже запущен !", vbExclamation, "": End
    'SEMAPHORE_MODIFY_STATE --> 998 (0x3E6) ERROR_NOACCESS. Invalid access to memory location.
    'SEMAPHORE_ALL_ACCESS ----> 1305 (0x519) ERROR_UNKNOWN_REVISION. The revision level is unknown.
end sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lr As Long, lerr As Long
    If (semHNDL <> 0) Then lr = ReleaseSemaphore(semHNDL, 1&, 0&)
    lerr = Err.LastDllError 'Error 298 (0x12A) Too many posts were made to a semaphore.
    Debug.Print "ReleaseSemaphore = " & lr & ". LastDllError = " & lerr
End Sub

option explicit
 
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long
 
Private Const ERROR_ALREADY_EXISTS As Long = 183&
 
Dim mutHNDL As Long
Dim inIDE   As Boolean
 
Private Sub Form_Initialize()
    Dim lr As Long
 
    Debug.Assert CheckIDE(inIDE)
    If Not inIDE Then
        Err.Clear
        mutHNDL = CreateMutex(0&, 1&, "mut_MyProgram3")
        lr = Err.LastDllError
        Debug.Print "mutHNDL = " & mutHNDL & ". LastDllError = " & lr
        If (lr = ERROR_ALREADY_EXISTS) Then MsgBox "... уже запущен !", vbExclamation, "": End
    End If
end sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lr As Long, lerr As Long
 
    If Not inIDE Then
        If (mutHNDL <> 0) Then lr = ReleaseMutex(mutHNDL) 'Ret - nonZero is Success.
        lerr = Err.LastDllError
        Debug.Print "ReleaseMutex = " & lr & ". LastDllError = " & lerr
    End If
end sub
 
Function CheckIDE(Value As Boolean) As Boolean: Value = True: CheckIDE = True: End Function