实用无措vb6禁止程序多开的源代码

用vb6做程序，有时候只想运行一个，本功能完全可以阻止多开，并且还可以显示隐藏窗口，真是好东西分享啊

vb中只允许运行一个程序实例的方法刚从网上看到的，转载不过来，就复制一下，;)

利用vb中的App.PrevInstance即可,然后利用AppActivate来将前一个程序呼到前台.

Private Sub Main()
    If App.PrevInstance Then    '程序是否已运行
        Dim Title As String
        Title = App.Title
        App.Title = "The Sec"
On Error Resume Next
        AppActivate Title
        Exit Sub
    End If

    ...... '正常运行时的代码

End Sub

刚从网上看到的，转载不过来，就复制一下，;)

这样写的话,如果前一个程序窗口为Hide,就不会将窗口显示并提前,如果要让窗口为隐藏的时候也可以让窗口提前,则需要获得窗口的hwnd,然后将窗口先显示出来.

先声明两个api,及相关的常量:

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_FORCEMINIMIZE = 11
Public Const SW_MAX = 11

然后改写代码:

Private Sub Main()
    If App.PrevInstance Then    '程序是否已运行
        Dim Title As String
        Title = App.Title
        App.Title = "The Sec"
On Error GoTo FirstHide
        AppActivate Title
        Exit Sub
    End If

    ...... '正常运行时的代码

Exit Sub
FirstHide:
    Dim hwnd As Long
    hwnd = FindWindow(vbNullString, Title)
    If hwnd <> 0 Then
        ShowWindow hwnd, SW_SHOWNORMAL
        AppActivate Title
    End If
End Sub

这样,当窗口为Hide的时候,程序将跳转到错误处理语句FirstHide处,获得前一个窗口的句柄并显示窗口,然后再利用AppActivate将窗口提到前台.

退出时弹出提示退出？

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim strExit As String
If UnloadMode <> vbAppWindows Then
strExit = "您确定要停止运行吗？"
If vbNo = MsgBox(strExit, vbQuestion Or vbYesNo, "") Then
Cancel = True
Exit Sub
End If
End If
End
End Sub