
''' <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谁会写啊等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
微信扫一扫
支付宝扫一扫
评论列表(0条)