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

有几种方法

1.根据窗口名称判断

Option

ExplicitPrivate

Declare

Function

FindWindow

Lib

"user32"

Alias

"FindWindowA"

(ByVal

lpClassName

As

String,

ByVal

lpWindowName

As

String)

As

LongPrivate

Sub

Command1_Click()

Dim

lngWindow

As

Long

lngWindow

=

FindWindow(vbNullString,

"文档1

-

Microsoft

Word")

If

lngWindow

<>

0

Then

MsgBox

"Word已运行"

End

IfEnd

Sub2.最好的办法是根据类名判断，但是要预先知道窗口类名

比如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

LongPrivate

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

Sub3.检测进程名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

可以进“任务管理器” 两个步骤确定程序是否处于假死。 1，在“应用程序”里面，是否能切换该程序，如果不行，可以假定程序死机。 2，在“进程”中找到该程序，看CPU和内存使用，的数据有没有变化，如果20秒不变化，说明假死。

检查进程是否运行，根据进程名

Private Function CheckExeIsRun(exeName As String) As Boolean

On Error GoTo Err

Dim WMI

Dim Obj

Dim Objs

CheckExeIsRun = False

Set WMI = GetObject("WinMgmts:")

Set Objs = WMI.InstancesOf("Win32_Process")

For Each Obj In Objs

If (InStr(UCase(exeName), UCase(Obj.Description)) <>0) Then

CheckExeIsRun = True

If Not Objs Is Nothing Then Set Objs = Nothing

If Not WMI Is Nothing Then Set WMI = Nothing

Exit Function

End If

---