在VB中检查应用程序(EXE)是否已运行的程序怎么写？

Question

应该是一个函数，参数是此应用程序的路径，返回值是真或假

Answer 1

如果是VB程序自身的话：
app.PrevInstance

Answer 2

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Sub Command1_Click()
'    RichTextBox1.SelFontSize = 20
    Dim hwd As Long
    
    hwd = FindWindow(vbNullString, "TextPad") 'TextPad为程序标题,你自己设置一下吧~~
    If hwd <> 0 Then MsgBox "程序已经运行!", vbExclamation
End Sub

Answer 3

如果你的程序是VB写的话可以用
Private Sub Command1_Click()
    If App.PrevInstance Then MsgBox "程序已经运行!", vbExclamation
End Sub

Answer 4

如果是自己的VB程序
可以用app.previnstance＝true
如果不是
用findwindow这个API实现，网上有很多例子，自己找找

Answer 5

如果是你自己的程序可以使用
If App.PrevInstance Then End
如果是其它程序可以使用Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongFunction IsRunning(ByVal lwinHwnd As Long) As Boolean
'-----------------------------------------------------------
'功能：
'       判断一个应用是否已经运行
'参数：
'       lwinHwnd.....该应用的句柄
'返回值：
'       IsRunning....如果此应用已经运行返回True；否则返回False
'-----------------------------------------------------------
Dim lhProgram As Long   '被检测的程序进程句柄    lhProgram = OpenProcess(0, False, lwinHwnd)
    If Not lhProgram = 0 Then
        IsRunning = True
    Else
        IsRunning = False
    End If
    
    CloseHandle lhProgram
    
End Function

Answer 6

不是自身，是任何一个应用程序（.exe文件）

Answer 7

不是自身就用这种方法啊~~Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Sub Command1_Click()
'    RichTextBox1.SelFontSize = 20
    Dim hwd As Long
    
    hwd = FindWindow(vbNullString, "TextPad") 'TextPad为程序标题,你自己设置一下吧~~
    If hwd <> 0 Then MsgBox "程序已经运行!", vbExclamation
End Sub把"TextPad"改为应用程序（.exe文件）的标题即可~~

Answer 8

知道标题也不推荐使用FindWindow ，原因是如果是不同的程序，却有相同的标题，就会引起混乱：Private Function IsRun(ByVal filename As String) As Boolean
    On Error GoTo myerr
    Open filename For Input Lock Read Write As #1
    Close #1
    IsRun = False
    Exit Function
myerr:
    Select Case Err.Number
    Case 70
        IsRun = True
        Exit Function
    End Select
End Function
'调用
Private Sub Command1_Click()
    MsgBox IsRun("d:\mc\ttest.exe")
End Sub

Answer 9

rainstormmaster,你给的函数不行呀，运行到Open filename For Input Lock Read Write As #1，无论filename参数（为一个应用程序的路径）是否运行，函数IsRun的返回值都为False.这是怎么回事？

Answer 10

在98下测试通过，不知你是什么系统修正一下，通过判断文件可否删除进行判定，如果可以，说明没有运行，如果正在运行，肯定不能删除，会触发75号错误。当然别忘了备份、还原文件。代码如下：Option ExplicitPrivate Function IsRun(ByVal filename As String) As Boolean
    On Error GoTo myerr
    Dim mytempfile As String
    mytempfile = App.Path + "\mytemp.bak"
    FileCopy filename, mytempfile
    Kill filename
    IsRun = False
    FileCopy mytempfile, filename
    Kill mytempfile
    Exit Function
myerr:
    Select Case Err.Number
    Case 75
        Kill mytempfile
        IsRun = True
        Exit Function
    Case Else
        MsgBox Err.Description
        
    End Select
End Function
'调用
Private Sub Command1_Click()
    MsgBox IsRun("d:\mc\Duba_CodeBlue.EXE")
End Sub

Answer 11

我是win2000，vb6。你的删除法可以通过