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

VB如何判断某个程序是否已经运行,第1张

有几种方法

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

VB遍历进程查找窗口,这个过程很繁琐,而且代码量很大,所以我的代码用了巧妙的方法,在运行时在注册表保存了窗口句柄,这样就不用再查找了。测试通过,环境Win7+VB6:

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Const SW_SHOW = 5

Private Sub Command1_Click()

Me.Hide

End Sub

Private Sub Form_Load()

Dim hwd As Long

If App.PrevInstance Then

  MsgBox "程序已经运行!"

  hwd = CLng(GetSetting(App.EXEName, "App", "MyHwnd"))

  ShowWindow hwd, SW_SHOW

  End

Else

  SaveSetting App.EXEName, "App", "MyHwnd", Me.hwnd

End If

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12103568.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-21
下一篇 2023-05-21

发表评论

登录后才能评论

评论列表(0条)

保存