VB如何判断某个程序是否已经运行

比如判断word是否已经运行，或者检测是否存在某个进程。

答案：有几种方法
1.根据窗口名称判断
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub Command1_Click()
    Dim lngWindow As Long
    lngWindow = FindWindow(vbNullString, "文档1 - Microsoft Word")
    If lngWindow <> 0 Then
        MsgBox "Word已运行"
    End If
End Sub
2.最好的办法是根据类名判断，但是要预先知道窗口类名
比如Word类名：OpusApp
Excel类名：XLMAIN
PPT2010类名：PP12FrameClass
PPT2007类名：PP11FrameClass
PPT2003类名：PP10FrameClass
'声明必要的 API ：
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'检测Word是否运行
Private Sub DetectWord()
    Dim hWnd As Long
    '如果 Word在运行，则该 API 调用将返回其句柄。
    hWnd = FindWindow("OpusApp", 0)
    If hWnd = 0 Then    '0 表示没有 Word在运行。
        MsgBox Word没有运行！"
    Else
        MsgBox Word已经运行！"
    End If
End Sub
3.检测进程名
Const TH32CS_SNAPHEAPLIST = &H1 
Const TH32CS_SNAPPROCESS = &H2 
Const TH32CS_SNAPTHREAD = &H4 
Const TH32CS_SNAPMODULE = &H8 
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE) 
Const TH32CS_INHERIT = &H80000000 
Const MAX_PATH As Integer = 260 
Private Type PROCESSENTRY32 
dwSize As Long 
cntUsage As Long 
th32ProcessID As Long 
th32DefaultHeapID As Long 
th32ModuleID As Long 
cntThreads As Long 
th32ParentProcessID As Long 
pcPriClassBase As Long 
dwFlags As Long 
szExeFile As String * MAX_PATH 
End Type 
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long 
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long 
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long 
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long) 
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 
 
Function exitproc(ByVal exefile As String) As Boolean 
exitproc = False 
Dim hSnapShot As Long, uProcess As PROCESSENTRY32 
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) 
uProcess.dwSize = Len(uProcess) 
r = Process32First(hSnapShot, uProcess) 
Do While r 
If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = exefile Then 
exitproc = True 
Exit Do 
End If 
r = Process32Next(hSnapShot, uProcess) 
Loop 
End Function 
Private Sub Command1_Click() 
If exitproc("winword.exe") = True Then 
MsgBox "Word已经运行！" 
Else 
MsgBox "Word没有运行！" 
End If 
End Sub 
如果是自己的软件,打开时可以向C盘创建一个文件,关闭后就删除,在检测时如果文件存在就是打开了,不存在就是没有打开~

上一个：VB中的shell函数的一些问题
下一个：VB与BCB那一个程序更实用一些。