如何得到外部程序的 ProcessID?

paste an article, post by somebody( not so accomplish )
VB做的详细的WINDOWS进程管理程序Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId 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
'''''''''设置俺的程序优先极为最高
Const THREAD_BASE_PRIORITY_IDLE = -15
Const THREAD_BASE_PRIORITY_LOWRT = 15
Const THREAD_BASE_PRIORITY_MIN = -2
Const THREAD_BASE_PRIORITY_MAX = 2
Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Const THREAD_PRIORITY_NORMAL = 0
Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
Const HIGH_PRIORITY_CLASS = &H80
Const IDLE_PRIORITY_CLASS = &H40
Const NORMAL_PRIORITY_CLASS = &H20
Const REALTIME_PRIORITY_CLASS = &H100
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'''''''''这儿让我的窗体在最上Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_SHOWWINDOWS = &H40
''''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
Private Const TH32CS_SNAPPROCESS As Long = 2&
Dim procresult
Private Sub Form_Activate()
       prochlvwlis
End Sub
Sub prochlvwlis()
    Dim uprocess As PROCESSENTRY32
    Dim hsnapshot As Long
    Dim mname As String
    Dim i As Integer
    Dim proclvw As ListItem
    lvw.ListItems.Clear
    DoEvents
    uprocess.dwSize = Len(uprocess)
    hsnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

       ' If failure -1 (false)
    If hsnapshot Then
        procresult = Process32First(hsnapshot, uprocess)
            ' If failure -1 (false)
        Do While procresult
             i = InStr(1, uprocess.szExeFile, Chr(0))
             mname = LCase$(Left$(uprocess.szExeFile, i - 1))
             Set proclvw = lvw.ListItems.Add(, , Text:=mname)
             proclvw.SubItems(6) = uprocess.th32ModuleID
             proclvw.SubItems(5) = Hex(uprocess.th32ParentProcessID)
             proclvw.SubItems(4) = Hex(uprocess.th32ProcessID)
             proclvw.SubItems(3) = uprocess.cntUsage
             proclvw.SubItems(2) = uprocess.cntThreads
             proclvw.SubItems(1) = uprocess.pcPriClassBase
             procresult = Process32Next(hsnapshot, uprocess)
        Loop
    End If
End Sub
Sub ErrMsgProc(mMsg As String) ''''错误处理
    MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description
End Sub

Private Sub Form_Resize() '''改变窗体大小时的设置
lvw.Width = ProcH.Width - 100
lvw.Height = Abs(ProcH.Height - 4000)
TabStrip1.Height = Abs(ProcH.Height - 3350)
TabStrip1.Width = ProcH.Width - 100
morelvw.Width = TabStrip1.Width - 250
morelvw.Height = Abs(TabStrip1.Height - 500)
End SubPrivate Sub lvw_Click()
ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem
help
End SubPrivate Sub lvw_DblClick()
Call mnuTe_Click
End SubPrivate Sub fParent()
    If lvw.ListItems.Count = 0 Then
        Exit Sub
    End If
    Dim mParentProcID As Long
    Dim i As Integer
    Dim mFound As Boolean
    mFound = False
    mParentProcID = "&H" & (lvw.ListItems(lvw.SelectedItem.Index).SubItems(5))
    For i = 1 To lvw.ListItems.Count
        If "&H" & (lvw.ListItems(i).SubItems(4)) = mParentProcID Then
            lvw.SelectedItem = lvw.ListItems(i)
            lvw.SetFocus
            mFound = True
            Exit For
        End If
    Next
    If mFound = False Then
        MsgBox "没有父进程的东东----------最好不要试图终止它！"
    End If
End SubPrivate Sub Form_Load() '''''载入窗体时发生
ProcH.Width = 8400
ProcH.Height = 5280
        If App.PrevInstance Then
           MsgBox "程序正在运行，请检查窗口是否被最小化。"
        End If
        App.TaskVisible = False ''''将程序从CTRL+DEL+ALT的列表中隐藏
    Dim hThread As Long, hProcess As Long ''设置优先极了
    hThread = GetCurrentThread
    hProcess = GetCurrentProcess
    SetThreadPriority hThread, THREAD_PRIORITY_HIGHEST
    SetPriorityClass hProcess, REALTIME_PRIORITY_CLASS
    ''''
    Dim retValue As Long
    retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOWS)
    ''''''
    lvw.ListItems.Clear ''''清空列表，初始化
    lvw.ColumnHeaders.Clear ''''清空表头，初始化
    lvw.ColumnHeaders.Add , , "进程名称", 4000 '''添加到表头第一项，有顺序的
    lvw.ColumnHeaders.Add , , "优先极", 600
    lvw.ColumnHeaders.Add , , "线程数", 600 ''''
    lvw.ColumnHeaders.Add , , "引用", 600 ''
    lvw.ColumnHeaders.Add , , "进程ID", 1000 ''''
    lvw.ColumnHeaders.Add , , "父进程 ID", 1000 ''
    lvw.ColumnHeaders.Add , , "", 0
    lvw.LabelEdit = lvwManual
    lvw.FullRowSelect = True
    lvw.HideSelection = False
    lvw.HideColumnHeaders = False
    lvw.View = lvwReport


End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '''''窗体上按下鼠标时发生
      If Button >= 2 Then '''''如果鼠标按键是右键~也有特殊的情况如滚轮鼠标
         Me.PopupMenu mnuprochhead1
      End If
End SubPrivate Sub mnuaboutx_Click()
'''''给出一个消息框,这儿只使用了+VBCRLF+=&vbcrlf&,是实现换行的
      MsgBox "关于 ProcH XP.........." + vbCrLf + "  由 bob008（冻东）完成！" + vbCrLf + "☆☆☆严禁任何未经许可的商业性发布行为及修改！☆☆☆" + vbCrLf + "我会把注册表的偷懒设置设置的更多,如删除打开文件的历史记录等!" + vbCrLf + "最关键的是这是完全免费的程序!并且完全绿色" + vbCrLf + "如果你有什么好的提议或索取源码可与我联系" + vbCrLf + "如果有个免费的主页就好了,可惜-俺又懒的做!烦!" + vbCrLf + "还想加入木马的检测--正在搜集常见木马的特征及标识库!" + vbCrLf + "如果你搜集了,发个MAIL给我!因为我以后会很少用VB了,正在转汇编!"
End Sub
Private Sub mnufileexit_Click()
      Unload Me
End Sub
Private Sub mnurefreshlist_Click()
     prochlvwlis
End Sub'''''系统文件菜单
Private Sub mnusysfile_Click(Index As Integer)
Select Case Index
       Case 1
        Dim sysfile As String
        Dim openp As String
          sysfile = "c:\windows\system.ini"                  '要打开的文件
          openp = "Notepad.exe"                     '用记事本打开
          Shell openp & " " & sysfile, vbNormalFocus
       Case 2
          sysfile = "c:\windows\win.ini"                    '要打开的文件
          openp = "Notepad.exe"                     '用记事本打开
          Shell openp & " " & sysfile, vbNormalFocus
       Case 3
          sysfile = "c:\msdos.sys"                           '要打开的文件
          openp = "Notepad.exe"                     '用记事本打开
          Shell openp & " " & sysfile, vbNormalFocus
       Case 4
          sysfile = "c:\config.sys"                          '要打开的文件
          openp = "Notepad.exe"                     '用记事本打开
          Shell openp & " " & sysfile, vbNormalFocus
       Case 5
          sysfile = "c:\autoexec.bat"                        '要打开的文件
          openp = "Notepad.exe"                     '用记事本打开
          Shell openp & " " & sysfile, vbNormalFocus
End Select
End Sub
Private Sub mnusyspro_Click(Index As Integer)
Select Case Index
       Case 1
           Shell "C:\WINDOWS\SYSTEM\dxdiag.exe", 1 '''DirectX诊断工具
       Case 2
           Shell " C:\WINDOWS\SYSTEM\msconfig.exe", 1 '''系统配置实用程序
       Case 3
           Shell "c:\windows\Scanregw.exe", 1 ''''注册表检查程序
       Case 4
           Shell "c:\windows\regedit.exe", 1 ''''注册表编辑器
End Select
End Sub
Private Sub mnumailtome_Click()
        Shell "start mailto:[email protected]", vbHide '''''也可以是0，如果改为1，你可以看到效果就会很差
End SubPrivate Sub mnuTe_Click()
If lvw.ListItems.Count = 0 Then ''''如果没有选择就结束
        Exit Sub
    End If
    If MsgBox("结束 " & lvw.SelectedItem & " 吗?", vbYesNo + vbQuestion) <> vbYes Then
        Exit Sub
End If
Dim mProcID As Long
    mProcID = OpenProcess(1&, -1&, "&H" & lvw.SelectedItem.SubItems(4))
    TerminateProcess mProcID, 0&
    DoEvents
    lvw.ListItems.Remove (lvw.SelectedItem.Index)
    lvw.Refresh
prochlvwlis
End Sub

用GetWindowThreadProcessId得到进程ID
用OpenProcess打开进程，得到进程句柄GetWindowThreadProcessId VB声明
Declare Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

说明
获取与指定窗口关联在一起的一个进程和线程标识符
返回值
Long，拥有窗口的线程的标识符
参数表
参数类型及说明
lpdwProcessId Long，指定一个变量，用于装载拥有那个窗口的一个进程的标识符
hwnd Long，指定窗口句柄 OpenProcess
The OpenProcess function returns a handle to an existing process object. HANDLE OpenProcess(
  DWORD dwDesiredAccess,  // access flag
  BOOL bInheritHandle,    // handle inheritance flag
  DWORD dwProcessId       // process identifier
);

Parameters
dwDesiredAccess
Specifies the access to the process object. For operating systems that support security checking, this access is checked against any security descriptor for the target process. Any combination of the following access flags can be specified in addition to the STANDARD_RIGHTS_REQUIRED access flags: Access Description
PROCESS_ALL_ACCESS Specifies all possible access flags for the process object.
PROCESS_CREATE_PROCESS Used internally.
PROCESS_CREATE_THREAD Enables using the process handle in the CreateRemoteThread function to create a thread in the process.
PROCESS_DUP_HANDLE Enables using the process handle as either the source or target process in the DuplicateHandle function to duplicate a handle.
PROCESS_QUERY_INFORMATION Enables using the process handle in the GetExitCodeProcess and GetPriorityClass functions to read information from the process object.
PROCESS_SET_INFORMATION Enables using the process handle in the SetPriorityClass function to set the priority class of the process.
PROCESS_TERMINATE Enables using the process handle in the TerminateProcess function to terminate the process.
PROCESS_VM_OPERATION Enables using the process handle in the VirtualProtectEx and WriteProcessMemory functions to modify the virtual memory of the process.
PROCESS_VM_READ Enables using the process handle in the ReadProcessMemory function to read from the virtual memory of the process.
PROCESS_VM_WRITE Enables using the process handle in the WriteProcessMemory function to write to the virtual memory of the process.
SYNCHRONIZE Windows NT: Enables using the process handle in any of the wait functions to wait for the process to terminate.
bInheritHandle
Specifies whether the returned handle can be inherited by a new process created by the current process. If TRUE, the handle is inheritable.
dwProcessId
Specifies the process identifier of the process to open.
Return Values
If the function succeeds, the return value is an open handle to the specified process.If the function fails, the return value is NULL. To get extended error information, call GetLastError. Res
The handle returned by the OpenProcess function can be used in any function that requires a handle to a process, such as the wait functions, provided the appropriate access rights were requested. When you are finished with the handle, be sure to close it using the CloseHandle function.QuickInfo
  Windows NT: Requires version 3.1 or later.
  Windows: Requires Windows 95 or later.
  Windows CE: Unsupported.
  Header: Declared in winbase.h.
  Import Library: Use kernel32.lib.

Private Sub mnutouprocesshomepage_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler http://www.csdn.net"     ''''你可以更改你要的链接
End SubPrivate Sub TabStrip1_Click()
Select Case TabStrip1.SelectedItem.Key
       Case "modlis"
           morelisa
       Case "thrlis"
           morelisb
       Case "verlis"
           morelisc
       Case "proclis"
End Select
End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
       Case 1
       Call mnuTe_Click
       Case 3
       fParent
       Case 5
       Dim b As Object
       Dim s As String
       Dim o As String
       Dim g As String
       Dim h As String
       Dim k As String

       On Error Resume Next
       Set b = CreateObject("wscript.shell")
       s = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools"
       b.regdelete s
       On Error Resume Next
       o = "HKLM\SYSTEM\CurrentControlSet\Services\Cdrom\AUTORUN"
       b.regwrite o, 0, "REG_DWORD"
       On Error Resume Next
       g = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\RunMRU\"
       b.regdelete g
       On Error Resume Next
       h = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\Doc Find Spec MRU\"
       b.regdelete h
       On Error Resume Next
       k = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\RecentDocs\"
       b.regdelete k
       On Error Resume Next
End Select
End Sub
Sub help() ''''''statusbar上的常见提示
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\kernel32.dll" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   内核驱动--警告:不要试图终止它!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\mmtask.tsk" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   计划任务--讨厌的家伙!俺从不用它!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\ddhelp.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   实时帮助--不要终止它,这个东东的优先极极高!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\internat.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   输入法图标--不要终止它!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\systray.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   音量控制图标--不要终止它!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\msgsrv.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   ☆★☆严重警告--你好毒啊!☆★☆"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\explorer.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + "   警告--不要试图终止它!!!"
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\mprexe.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!!   "
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\wmiexe.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!!   "
If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\msgsrv32.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!!   "
End SubSub morelisa()
     morelvw.ListItems.Clear ''''清空列表，初始化
    morelvw.ColumnHeaders.Clear ''''清空表头，初始化
    morelvw.ColumnHeaders.Add , , "模块名称", 2000 '''添加到表头第一项，有顺序的
    morelvw.ColumnHeaders.Add , , "模块路径", 4000
    morelvw.ColumnHeaders.Add , , "占用内存", 1000 ''''
    morelvw.ColumnHeaders.Add , , "引用数", 1000 ''
    morelvw.ColumnHeaders.Add , , "全局引用", 1000 ''''
    morelvw.ColumnHeaders.Add , , "模块ID", 1000 ''
    morelvw.LabelEdit = lvwManual
    morelvw.FullRowSelect = True
    morelvw.HideSelection = False
    morelvw.HideColumnHeaders = False
    morelvw.View = lvwReport
End Sub
Sub morelisb()
    morelvw.ListItems.Clear ''''清空列表，初始化
    morelvw.ColumnHeaders.Clear ''''清空表头，初始化
    morelvw.ColumnHeaders.Add , , "线程ID", 1400 '''添加到表头第一项，有顺序的
    morelvw.ColumnHeaders.Add , , "基础优先极", 2000
    morelvw.ColumnHeaders.Add , , "线程优先极", 2000 ''''
    morelvw.ColumnHeaders.Add , , "引用数", 1000 ''
    morelvw.LabelEdit = lvwManual
    morelvw.FullRowSelect = True
    morelvw.HideSelection = False
    morelvw.HideColumnHeaders = False
    morelvw.View = lvwReport
End SubSub morelisc()
    morelvw.ListItems.Clear ''''清空列表，初始化
    morelvw.ColumnHeaders.Clear ''''清空表头，初始化
    morelvw.ColumnHeaders.Add , , "项目名称", 3000 '''添加到表头第一项，有顺序的
    morelvw.ColumnHeaders.Add , , "信息", 4000
    morelvw.FullRowSelect = True
    morelvw.HideSelection = False
    morelvw.HideColumnHeaders = False

已经做好了
谢谢 jennyvenus(JennyVenus) ，虽然你给是枚举所有的进程
谢谢 zyl910，GetWindowThreadProcessID 就是我想要的Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_TERMINATE = &H1Public Function TernamiteProcessByHWND(ByVal hCloseWnd As Long) As Boolean
Dim hProcessID  As Long
Dim hProcess    As Long
On Error GoTo PROC_EXIT
    If hCloseWnd = 0 Then GoTo PROC_EXIT
    If GetWindowThreadProcessId(hCloseWnd, hProcessID) = 0 Then GoTo PROC_EXIT
    hProcess = OpenProcess(PROCESS_TERMINATE, False, hProcessID)
    If hProcess = 0 Then GoTo PROC_EXIT
    If TerminateProcess(hProcess, 0&) = 0 Then GoTo PROC_EXIT
    TernamiteProcessByHWND = True
PROC_EXIT:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
        Err.Clear
    End If
End Function

调试易

如何得到外部程序的 ProcessID?

解决方案 »