禁止同时运行同一个exe程序该怎么写？请赐教

Question

我用VB写了个数据库程序，已编译生成exe。现在可同时运行N个该程序，我想实现只能同时运行一个，如果再点击运行图标就提示：该程序已运行！请问这个该如何写？请赐教！

Answer 1

Private Sub Form_Load()
  If App.PrevInstance = True Then
    MsgBox "该程序已经运行。", vbInformation
    End
  End If
End Sub

Answer 2

//前面也有讲到更灵活的进程控制，搜索一下。不过好象都只能判断同一目录下的这个程序。换了目录就不认了。要想将文件改名或者更换路径依然只能有一个实例的话，只能用互斥体解决了：一个窗体，一个模块，将工程的启动对象设为Sub Main，然后将下面的代码粘贴到模块中
Option Explicit
Public Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Public Const ERROR_ALREADY_EXISTS = 183&
Private Sub Main()
    Dim sa As SECURITY_ATTRIBUTES
    sa.bInheritHandle = 1
    sa.lpSecurityDescriptor = 0
    sa.nLength = Len(sa)
    'Try to create a new Mutex
    Call CreateMutex(sa, 1, App.Title)
    'Check if the function was succesfull
    If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
        'More than one instance detected
        MsgBox "More than one instance"
        End
    Else
        'No other instance detected...
        Dim newfrm As New Form1
        newfrm.Show
    End If
End Sub

Answer 3

不过，如果需要传递命令行参数的话，最安全的还是用DDE

Answer 4

Public Declare Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As LongPublic Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const MUTANT_QUERY_STATE = &H1
Public Const MUTANT_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or MUTANT_QUERY_STATE)
Public Const MUTEX_ALL_ACCESS = MUTANT_ALL_ACCESSPublic Const BSF_IGNORECURRENTTASK = &H2
Public Const BSF_POSTMESSAGE = &H10
Public Const BSM_APPLICATIONS = &H8Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End TypePublic Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Public Declare Function BroadcastSystemMessage Lib "user32" (ByVal dw As Long, pdw As Long, ByVal un As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As LongPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_WNDPROC = (-4)Public lPrevWndProc As Long                 '前一窗体过程
Public hMutex As Long                       '互斥事件句柄
Public WindowMsg As Long                    '自定义消息
Public sa As SECURITY_ATTRIBUTES            '安全属性Public Const Unique = "hisofty"             '自定义消息名Public Function NewWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                              ByVal wParam As Long, ByVal lParam As Long) As Long       '新窗体过程
    Select Case uMsg
        Case WindowMsg              '自定义窗体消息处理
            MsgBox "我已经运行了!", vbInformation, "呵呵,Hi_Softy"
            ShowWindow hWnd, SW_SHOWNORMAL
            If GetForegroundWindow() <> hWnd Then
                SetForegroundWindow hWnd
            End If
        Case Else
            NewWindowProc = CallWindowProc(lPrevWndProc, hWnd, uMsg, wParam, lParam)
    End Select
End FunctionPublic Sub WindowHook(ByVal hWnd As Long)           '设置窗体钩子
    lPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWindowProc)
End SubPublic Sub UnWindowHook(ByVal hWnd As Long)                 '卸载窗体钩子
    If lPrevWndProc <> GetWindowLong(hWnd, GWL_WNDPROC) Then
        SetWindowLong hWnd, GWL_WNDPROC, lPrevWndProc
        CloseHandle hMutex
    End If
End Sub
Private Sub Form_Initialize()
    WindowMsg = RegisterWindowMessage(Unique)
    hMutex = OpenMutex(MUTEX_ALL_ACCESS, False, Unique)
    If hMutex = 0 Then
        hMutex = CreateMutex(sa, False, Unique)
    Else
        BroadcastSystemMessage BSF_IGNORECURRENTTASK Or BSF_POSTMESSAGE, BSM_APPLICATIONS, WindowMsg, 0, 0
        Set Form1 = Nothing
        End
    End If
End SubPrivate Sub Form_Load()
    WindowHook Me.hWnd
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnWindowHook Me.hWnd
End Sub用互斥和自定义系统消息实现程序第二次启动时，将程序的第一个实例提至前台