vb.net 如何根据进程名字来取得进程的pid

vb.net 如何根据进程名字来取得进程的pid,第1张

''' <summary>

''' 返回某进程PID

''' </summary>

''' <param name="ProcessName">进程名(不带后缀)</param>

''' <returns></returns>

''' <remarks></remarks>

Public Function ProcessPidOnly(ByVal ProcessName As String) As String

Dim myProcess As Process() = ProcessGetProcessesByName(ProcessName)

Dim pid As String = ""

If myProcessLength - 1 = 0 Then

pid = myProcess(0)Id

Else

For i As Short = 0 To myProcessLength - 1

pid = pid & myProcess(i)Id & ";"

Next

End If

Return pid

End Function

。。一个进程下面可以有多个线程,你怎么能“这个PID的值的线程ID”?

你最多只能做到枚举这个进程下面的所有线程,然后你自己查找合适的线程。

要枚举进程中的所有线程,要先用

CreateToolHelp32Snapshot

创建一个快照,然后用

Thread32First

Thread32Next

一项一项遍历。

Option Explicit

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "USER32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long '获取指定句柄进程PID

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()

Sleep (2000)

Dim hwnd1, lpdwProcessId1

Dim p As POINTAPI

GetCursorPos p

hwnd1 = WindowFromPoint(pX, pY)

Call GetWindowThreadProcessId(hwnd1, lpdwProcessId1) '获取指定句柄的进程PID

MsgBox lpdwProcessId1

End Sub

这个只能是你点击按钮后两秒钟内将你鼠标移动到要获取PID的窗口即可取得PID。 你说的要鼠标指哪就马上得哪的PID 比较难实现 ,因为鼠标在本程序窗体外的移动事件比较难捕捉到,要用到全局钩子,那个比较复杂一般也没必要。你游戏双开就用上面那个就可以了。其他细节自己该下。

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Const WM_CLOSE = &H10

Public Function EndOld(WindowName As String)

Dim app_hWnd As Long

app_hWnd = FindWindow(vbNullString, WindowName)

If app_hWnd <> 0 Then

SendMessage app_hWnd, WM_CLOSE, 0, 0

TerminateProcess app_hWnd, 0

End If

End Function

Option Explicit

'获取窗体标题名声明

Private Const GW_CHILD = 5

Private Const GW_HWNDNEXT = 2

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd 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 260

End Type

'获取进程名pid声明

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_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'函数功能:获取窗体标题

'参数说明:WndTitle 窗体标题

'返回值:输入某个窗体名的时候显示它的pid值,不输人任何参数则获取所有窗体的标题名

Function FindWindow_EX(Optional ByVal WndTitle As String)

Dim level, iFound, Resu

Dim hWnd As Long, K As Long

Dim sWindowText As String

Dim sClassname As String

Dim sID

hWnd = GetWindow(GetDesktopWindow, GW_CHILD)

Do Until hWnd = 0

DoEvents

'sWindowText = GetWinText(hWnd)

sWindowText = Space$(254)

K = GetWindowText(hWnd, sWindowText, 254)

sWindowText = StrConv(LeftB(StrConv(sWindowText, vbFromUnicode), K), vbUnicode)

If sWindowText = WndTitle Or WndTitle = vbNullString Then

If WndTitle <> "" Then '返回窗口句柄

Resu = hWnd

Exit Do

Else '获取所有窗体的标题名

If sWindowText <> "" Then Resu = Resu & sWindowText & vbNewLine

End If

End If

hWnd = GetWindow(hWnd, GW_HWNDNEXT)

Loop

FindWindow_EX = Resu

End Function

'函数功能:获取进程名pid

'参数说明:ProcName 进程名称

'返回值:进程名的pid值,如有多个则分行显示出来

Function GetPIDFromProcName(ByVal ProcName As String) As String '根据路径获取被监控进程的进程句柄

Dim lPid As Long, S As String, i As Integer

Dim Proc As PROCESSENTRY32, hSnapshot As Long

Dim mSnapshot As Long

hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '创建一个snapshot对象

Procdwsize = Len(Proc)

lPid = ProcessFirst(hSnapshot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据

Do While lPid <> 0

mSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Procth32ProcessID)

S = ProcszExeFile

i = InStr(S, Chr(0))

If i Then S = Left(S, i - 1)

If LCase(ProcName) = LCase(S) Then '如果找到了,则…

GetPIDFromProcName = GetPIDFromProcName & Procth32ProcessID & vbNewLine

End If

CloseHandle (mSnapshot)

lPid = ProcessNext(hSnapshot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据

Loop

CloseHandle hSnapshot

End Function

VB启动/结束另一程序

VB 中,常以Shell指令来执行外部程式,然而它在Create该外部process 后,立刻

就会回到vb 的下一行程式,无法做到等待该Process结束时,才执行下一行指令,

或是说,无法得知该Process是否已结束,甚者,该Process执行到一半,又该如何

中止其执行等等,这些都不是Shell指令所能控制的,因此我们需使API的帮助来完

成。

第一个问题,如何等待shell所Create的process结束后才往后执行vb的程式。

首先要知道的是,每个Process有唯一的一个ProcessID,这是OS给定的,用来

区别每个 Process,这个Process ID(PID)主要可用来取得该Process相对应的一些

资讯,然而要对该Process的控制,却大多透过 Process Handle(hProcess)。VB

Shell指令的传回值是PID,而非hProcess,所以我们需透过OpenProcess这个API来

取得 hProcess而OpenProcess()的第一个叁数,指的是所取得的hProcess所具有的

能力,像 PROCESS_QUERY_INFORMATION 便是让GetExitCode()可取得hProcess所指

的process之状态,而PROCESS_TERMINATE,便是让TerminateProcess(hProcess)

的指令能够生效,也就是说,不同叁数设定,使hProcess所具有的权限、能力有所

不同。取得 hProcess后便可以使用WaitForSingleObject()来等待hProcess状态的

改变,也就是说,它会等待 hProcess所指的process执行完,这个指令才结束,它

第二个叁数所指的是 WaitForSingleObject()所要等待的时间(in milliseconds )

,如果超过所指的时间,就TimeOut而结束WaitForSingleObject()的等待。若要它

无限的等下去,就设定为INFIN99vE。

pid = Shell("C:\tools\spe3\pe2exe", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

ExitEvent = WaitForSingleObject(hProcess, INFIN99vE)

Call CloseHandle(hProcess)

上例会无限等待shell指令create之process结束后,才再做后面的vb指令。有

时觉得那会等太久,所以有第二个解决方式:等process结束时再通知vb 就好,即

:设定一个公用变数(isDone),当它变成True时代表Shell所Create的Process已结

束。当Process还在执行时,GetExitCodeProcess会传&H103给其第二个叁数,直到

结束时才传另外的数值,如果程式正常结束,那Exitcode = 0,否则就得看它如何

结束了。或许有人在其他地方看到 loop的地方是Loop while Exitcode <> 0,那

有一点危险,如果以这程子来看,您不是用F4来离开pe2而是用右上方 X 的结束

dos window那麽,会因为ExitCode的值永远不会是0,而进入无穷的回圈。

Dim pid As Long

pid = Shell("C:\tools\spe3\pe2exe", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

isDone = False

Do

Call GetExitCodeProcess(hProcess, ExitCode)

DebugPrint ExitCode

DoEvents

Loop While ExitCode = STILL_ALIVE

Call CloseHandle(hProcess)

isDone = True

另外,如果您的shell所Create的程式,有视窗且为立刻Focus者,可另外用以

下的方式Dim pid As Long

Dim hwnd5 As Long

pid = Shell("c:\tools\spe3\pe2exe", vbNormalFocus)

hwnd5 = GetForegroundWindow()

isDone = False

Do While IsWindow(hwnd5)

DoEvents

Loop

isDone = True

而如何强迫shell所Create的process结束呢,那便是

Dim aa As Long

If hProcess <> 0 Then

aa = TerminateProcess(hProcess, 3838)

End If

hProcess便是先前的例子中所取得的那个Process Handle, 3838所指的是传给

GetExitCodeProcess()中的第二叁数,这是我们任意给的,但最好不要是0,因为

0一般是代表正常结束,当然这样设也不会有错。当然不可设&H103,以这个例子来

看,如果程式正处於以下的LOOP

Do

Call GetExitCodeProcess(hProcess, ExitCode)

DebugPrint ExitCode

DoEvents

Loop While ExitCode = STILL_ALIVE

Debugprint ExitCode

而执行了 TerminateProcess(hProcess, 3838)那会看到ExitCode = 3838。然

而,这个方式在win95没问题,在NT中,可能您要在OpenProcess()的第一个叁数要

更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 这样才能Work。不过

良心的建议,非到最后关头,不要使用TerminateProcess(),因不正常的结束,往

往许多程式结束前所要做的事都没有做,可能造成Resource的浪费,甚者,下次再

执行某些程式时会有问题,例如:本人常使用MS-dos Shell Link 的方式执行一程

式,透过Com port与大电脑的联结,如果Ms-dos Shell Link 不正常结束,下次再

想Link时,会发现too Many Opens,这便是一例。

另外,有人使用Shell来执行bat档,即:

pid = Shell("c:\aabat", vbNormalFocus)

可是却遇上aabat结束了,但ms-dos的Window却仍活着,那可以用以下的方式来做

pid = Shell("c:\commandcom /c c:\aabat", vbNormalFocus)

那是执行Commandcom,而Commandcom指定执行c:\aabat 而且结束时自动Close

所有程式如下:

Private Declare Function OpenProcess Lib "kernel32" _

(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _

ByVal dwProcessId As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _

(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" _

(ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function IsWindow Lib "user32" _

(ByVal hwnd As Long) As Long

Const PROCESS_QUERY_INFORMATION = &H400

Const STILL_ALIVE = &H103

Const INFIN99vE = &HFFFF

Private ExitCode As Long

Private hProcess As Long

Private isDone As Long

Private Sub Command1_Click()

Dim pid As Long

pid = Shell("C:\tools\spe3\pe2exe", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

isDone = False

Do

Call GetExitCodeProcess(hProcess, ExitCode)

DebugPrint ExitCode

DoEvents

Loop While ExitCode = STILL_ALIVE

Call CloseHandle(hProcess)

isDone = True

End Sub

Private Sub Command2_Click()

Dim pid As Long

Dim ExitEvent As Long

pid = Shell("C:\tools\spe3\pe2exe", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

ExitEvent = WaitForSingleObject(hProcess, INFIN99vE)

Call CloseHandle(hProcess)

End Sub

Private Sub Command3_Click()

Dim aa As Long

If hProcess <> 0 Then

aa = TerminateProcess(hProcess, 3838)

End If

End Sub

Private Sub Command4_Click()

Dim pid As Long

Dim hwnd5 As Long

pid = Shell("c:\tools\spe3\pe2exe", vbNormalFocus)

hwnd5 = GetForegroundWindow()

isDone = False

Do While IsWindow(hwnd5)

DoEvents

Loop

isDone = True

End Sub

Private Sub Command5_Click()

Dim pid As Long

'pid = Shell("c:\windows\command\xcopy c:\aabat a:", vbHide)

pid = Shell("c:\commandcom /c c:\aabat", vbNormalFocus)

End Sub

窗体上添加一个 text 一个按钮 只需在text中输入进程名单击一下按钮 就可以

只需要三个api

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

Dim pid As Long

Dim pname As String

Dim a As String

Private Sub Command1_Click()

a = Trim(LCase(Text1))

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

mydwSize = 1060

End If

If (Process32First(l, my)) Then '遍历第一个进程

Do

i = InStr(1, myszExeFile, Chr(0)) '返回chr(0)在各个进程中出现的位置

mName = LCase(Left(myszExeFile, i - 1)) '返回小写的(返回i-1的前n个字符,即正确的名称)

If mName = a Then

pid = myth32ProcessID

Text1 = Text1 & "的pid是 " & "---" & pid

End If

Loop Until (Process32Next(l, my) < 1)

End If

End Sub

以上就是关于vb.net 如何根据进程名字来取得进程的pid全部的内容,包括:vb.net 如何根据进程名字来取得进程的pid、VB 如何获取指定pid的线程、VB取任意窗口PID谁会写啊等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

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

原文地址:https://54852.com/web/9628466.html

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

发表评论

登录后才能评论

评论列表(0条)

    保存