Question

如何用vb检测某程序是否在运行？

我是想到了。FindWindow 这个函数，但是，好象必须是完整的程序名吧？
那如果 你要检测的那个程序 有很多版本,那又要怎么弄呢?

Answer 1

检测某程序是需要检测进程吧,FindWindow是查找窗口...别人把窗口隐藏了你找什么去~~~~~

先把找进程的贴出来,再贴查版本的....

进程查找:(我是把代码全搬出来了,有些其他你不要的函数自己清理下)
(模块)
声明:
'进程-查找
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
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 * 1024
End Type
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private WM_TASKBARCREATED As Long
'------------------------------------------------------------------------------

'进程操作部分：--------此部分只作为主程序的专有部分，其他子程序暂无操作进程功能-------------------------
'查找函数
Public Function FindPro(ByVal sExePro As String, ByRef lProID As Long) As Integer '1找到该进程，0没找到
Dim my As PROCESSENTRY32
Dim l As Long
Dim l1 As Long
Dim mName As String
Dim i As Integer
Dim PID
FindPro = 0
sExePro = LCase(sExePro)
l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If l Then
my.dwSize = 1060
If (Process32First(l, my)) Then '遍历开始
Do
i = InStr(1, my.szExeFile, Chr(0))
mName = LCase(Left(my.szExeFile, i - 1))
If mName = sExePro Then
PID = my.th32ProcessID
'pname = mName
Dim mProcID As Long
mProcID = OpenProcess(1&, -1&, PID)
lProID = mProcID
'MsgBox pname
'TerminateProcess mProcID, 0&
FindPro = 1 '找到进程
Exit Function
End If
Loop Until (Process32Next(l, my) < 1)
End If
l1 = CloseHandle(l)
End If
End Function
'结束进程（查找进程，如存在则结束，不存在则无操作）
Public Function SetEndPro(ByVal sExePro As String) As Integer '1成功结束，-1无此进程，0结束进程失败
Dim lProID As Long
Dim tmBack As Long
lProID = -1
If FindPro(sExePro, lProID) = 1 Then
tmBack = TerminateProcess(lProID, 0&)
If tmBack <> 0 Then
SetEndPro = 1 '成功结束进程
Else
SetEndPro = 0 '失败
End If
CloseHandle lProID
Exit Function
Else
SetEndPro = -1 '不存在
End If
End Function

'--------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'(完了再贴检测版本,你自己组合下函数就好了.仍然有很多你不要的函数声明,自己清理下)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''Ver for AOS.exe'''''''''''''''''''
Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer ' e.g. = &h0000 = 0
dwStrucVersionh As Integer ' e.g. = &h0042 = .42
dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
dwFileFlagsMask As Long ' = &h3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type

Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
"GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal _
dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
"GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "Version.dll" Alias _
"VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, ByVal Source As Long, ByVal Length As Long)

Public Function GetVer(Optional ExePath) As String
'*** Get Version Info ****
If Not IsMissing(ExePath) Then
fullfilename = ExePath
Else
fullfilename = App.EXEName + ".exe"
End If

Dim FileVer As String

Dim rc As Long
Dim lDummy As Long
Dim sBuffer() As Byte
Dim lBufferLen As Long
Dim lVerPointer As Long
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long

'*** Get size ****
lBufferLen = GetFileVersionInfoSize(fullfilename, lDummy)
If lBufferLen < 1 Then
'MsgBox "该文件没有版本信息!", vbInformation
Exit Function
End If

'**** Store info to udtVerBuffer struct ****
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(fullfilename, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)

'**** Determine File Version number ****
FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & _
Format$(udtVerBuffer.dwFileVersionMSl) & "." & _
Format$(udtVerBuffer.dwFileVersionLSh) & "." & _
Format$(udtVerBuffer.dwFileVersionLSl) '倒数第二句Format$(udtVerBuffer.dwFileVersionLSh) & "."

GetVer = FileVer
End Function

Answer 2

'在窗体代码区复制下面代码，并在Form_Load()修改具体的程序名，运行，即可。
Option Explicit

Function FindProcess(ProcessName) As Boolean
Dim ps
'枚举进程
For Each ps In GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_ '循环进程
If UCase(ps.Name) = UCase(ProcessName) Then
FindProcess = True
Exit Function
End If
Next
End Function

Private Sub Form_Load()
If FindProcess("xxxx.exe") Then '在此修改为你要找的程序名
MsgBox "该程序正在运行！"
Else
MsgBox "该程序不正在运行！"
End If
End Sub