Question

我正在尝试检查应用程序的另一个实例是否已在运行。如果确实如此，我想继续检查另外15秒左右才能继续......

if App.PrevInstance then 

  dim dtStart as date
  dtStart = now 

  do while datediff("s", dtStart, Now) < 15
    Sleep 1000  ' sleep for a second
    if not App.PrevInstance then exit do
  loop

end if

问题是App.PrevInstance似乎没有刷新自己。无论如何，它都保持初始值。

还有另一种方法可以解决这个问题吗？也许是API调用。请注意，应用程序可能有也可能没有窗口，因此我无法检查是否存在具有特定标题的窗口。

Answer 1

您可能想看看：http://www.codeguru.com/forum/showthread.php?t=293730

Answer 2

我使用以下类：

'--------------------------------------------------------------------------------------- ' Module    : CApplicationSingleton ' DateTime  : 24/03/2006 15:16 ' Author  : Fernando ' Purpose   : Enforces a single instance of an application. Uses a Mutex '             see http://www.codeguru.com/forum/showthread.php?s=&threadid=293730 '             http://www.codeguru.com/Cpp/W-P/system/processesmodules/article.php/c5745/ ' Copyright © 2001-2007 AGBO Business Architecture S.L. '---------------------------------------------------------------------------------------

Option Explicit

Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long 
End Type

Private Const ERROR_ALREADY_EXISTS = 183&

Private m_hMutex As Long Private m_lLastDllError As Long

Private Sub Class_Initialize() '

On Error GoTo errorBlock

'

Dim s As SECURITY_ATTRIBUTES 
m_hMutex = CreateMutex(s, 0, rcString(8700)) m_lLastDllError = Err.LastDllError


'


exitBlock:
    Exit Sub
     errorBlock:

    Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton", "Class_Initialize", GApp.copyDebugFiles())
    Resume exitBlock


' End Sub

Private Sub Class_Terminate() On Error GoTo errorBlock


If m_hMutex > 0 Then
    Call CloseHandle(m_hMutex) End If


exitBlock:
    Exit Sub
     errorBlock:

    Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton.cls", "Class_Terminate")
    Resume exitBlock




End Sub


Public Function IsAnotherInstanceRunning() As Boolean '

On Error GoTo errorBlock

'

IsAnotherInstanceRunning = (m_lLastDllError = ERROR_ALREADY_EXISTS)

'


exitBlock:
    Exit Function
     errorBlock:

    Call GError.handleError(Err.Number, Err.Description, Erl, "CApplicationSingleton", "IsAnotherInstanceRunning", GApp.copyDebugFiles())
    Resume exitBlock


' End Function

Answer 3

我使用Mutex类来解决同一个问题，多次启动同一个应用程序。它似乎工作然后停止工作返回假阳性。我发现vb6 IDE在IDE仍处于打开状态时也持有互斥锁。

你必须使用代码并编译它。关闭IDE后，EXE将正常工作..谁知道？让我疯狂（ier）几分钟..

如果有人想要，我会发一个样本。

App.PrevInstance没有刷新自己

3 个答案: