顯示進程、關閉進程

2024-07-21 02:28:03

字體：大中小

來源：轉載

供稿：網友

首先通過createtoolhelp32snapshot函數創建一個進程的快照，然后通過調用process32first使用快照返回的句柄對進程進行遍歷，相關的信息存放在processentry32結構類型的實例中，然后顯示出來。

winxp+vb6+sp6

代碼如下：

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

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

'添加listview控件,3個按鈕

'刪除listview中選定的進程

private sub command2_click()

if msgbox("你想刪除 " & listview1.selecteditem.subitems(2) & " 進程?", vbyesno + vbquestion) <> vbyes then

exit sub

end if

dim mprocid as long

mprocid = openprocess(1&, -1&, listview1.selecteditem)

terminateprocess mprocid, 0&

doevents

listview1.listitems.remove (listview1.selecteditem.index)

listview1.refresh

end sub

'得到進程填充listview

private sub command1_click()

dim my as processentry32

dim l as long

dim l1 as long

dim mlistitem as listitem

' list1.clear

l = createtoolhelp32snapshot(th32cs_snapprocess, 0)

if l then

my.dwsize = 1060

if (process32first(l, my)) then '遍歷第一個進程

do

set mlistitem = listview1.listitems.add(, , my.th32processid)

mlistitem.subitems(1) = my.th32parentprocessid

mlistitem.subitems(2) = my.szexefile

loop until (process32next(l, my) < 1) '遍歷所有進程知道返回值為false

end if

l1 = closehandle(l)

end if

end sub

private sub form_load()

listview1.listitems.clear

listview1.columnheaders.clear

listview1.fullrowselect = true

listview1.columnheaders.add , , "process id", 1500

listview1.columnheaders.add , , "process parent id", (1500)

listview1.columnheaders.add , , "name", (me.width - 3200)

listview1.view = lvwreport

end sub

'循環檢測進程中是否有指定進程，如果有，關閉，如果沒有，啟動一個程序

private sub command3_click()

dim my as processentry32

dim l as long

dim l1 as long

dim flag as boolean

dim mname as string

dim i as integer

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 = "winword.exe" then

pid = my.th32processid

pname = mname

msgbox "找到word"

if msgbox("你想刪除 " & mname & " 進程?", vbyesno + vbquestion) <> vbyes then

exit sub

end if

dim mprocid as long

mprocid = openprocess(1&, -1&, pid)

terminateprocess mprocid, 0&

flag = true

exit sub

else

flag = false

end if

loop until (process32next(l, my) < 1) '遍歷所有進程知道返回值為false

end if

l1 = closehandle(l)

end if

if flag = false then

msgbox "沒有找到word"

shell "c:/program files/microsoft office/office/winword.exe", vbnormalfocus

end if

end sub