[電腦討論]

列舉/結束 Process

  1. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2. '   Program by Kelp
  3. '
  4. '   建立日期    2007/06/02
  5. '   改版日期    2007/08/19
  6. '
  7. '   說明
  8. '       GetProcesses        取得所有Process名稱及ID     傳回值為String
  9. '       GetWindowsProcess   取得視窗標題及ProcessID     傳回值為String
  10. '       KillProcessById     藉由ProcessID關閉該Process  引數為Long
  11. '
  12. '   改版內容
  13. '       增加列舉有視窗之Process函數
  14. '       列舉時具有排序功能
  15. '
  16. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  17. Option Explicit

  18. 'PROCESSES
  19. Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  20. Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  21. Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  22. Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  23. Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  24. Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

  25. Public Coll As Collection
  26. Public WindowsProc As String
  27. Private ProcessesNum As Integer

  28. Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
  29. Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
  30. Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
  31. Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  32. Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  33. Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

  34. Public Const TH32CS_SNAPPROCESS = &H2
  35. Public Const TH32CS_SNAPheaplist = &H1
  36. Public Const TH32CS_SNAPthread = &H4
  37. Public Const TH32CS_SNAPmodule = &H8
  38. Public Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
  39. Public Const MAX_PATH As Integer = 260

  40. Public Type PROCESSENTRY32
  41.     dwSize As Long
  42.     cntUsage As Long
  43.     th32ProcessID As Long
  44.     th32DefaultHeapID As Long
  45.     th32ModuleID As Long
  46.     cntThreads As Long
  47.     th32ParentProcessID As Long
  48.     pcPriClassBase As Long
  49.     dwFlags As Long
  50.     szExeFile As String * MAX_PATH
  51. End Type

  52. Public Type ProcessData
  53.     ProcessName As String
  54.     ProcessID As Long
  55. End Type

  56. Public Pro() As ProcessData
  57. Dim FirstLoop As Boolean
  58.    
  59. Public Function GetProcesses() As String
  60.     Dim ret
  61.     Dim TheLoopingProcess
  62.     Dim proc As PROCESSENTRY32
  63.     Dim snap As Long
  64.     Dim STemp As String
  65.     Dim STemp2 As String
  66.     Dim ILoop As Integer
  67.     Dim ILoop2 As Integer
  68.     Dim WordValue As Long
  69.    
  70.     ReDim Pro(0) As ProcessData
  71.     snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)    'get snapshot handle
  72.     proc.dwSize = Len(proc)
  73.     TheLoopingProcess = ProcessFirst(snap, proc)        'first process and return value

  74.     FirstLoop = True
  75.     GetProcesses = "[ID]" + vbTab + "[Process]"
  76.     While TheLoopingProcess <> 0      'next process
  77.         If proc.th32ProcessID <> 0 Then
  78.             ILoop = ILoop + 1
  79.             STemp = Left(proc.szExeFile, InStr(proc.szExeFile, Chr(0)) - 1)
  80.             STemp2 = Right(STemp, 4)
  81.             If Replace(STemp2, ".exe", "", , , vbTextCompare) = "" Then
  82.                 STemp = Mid(STemp, 1, Len(STemp) - 4)
  83.             End If
  84.             If FirstLoop Then
  85.                 Pro(0).ProcessID = proc.th32ProcessID
  86.                 Pro(0).ProcessName = STemp
  87.                 FirstLoop = False
  88.             Else
  89.                 ReDim Preserve Pro(UBound(Pro) + 1) As ProcessData
  90.                 Pro(UBound(Pro)).ProcessID = proc.th32ProcessID
  91.                 Pro(UBound(Pro)).ProcessName = STemp
  92.             End If
  93.         End If
  94.         proc.szExeFile = ""
  95.         TheLoopingProcess = ProcessNext(snap, proc)
  96.     Wend
  97.     SortProcess
  98.     For ILoop2 = 0 To UBound(Pro)
  99.         GetProcesses = GetProcesses & vbCrLf & Pro(ILoop2).ProcessID & vbTab & Pro(ILoop2).ProcessName
  100.     Next ILoop2
  101.     GetProcesses = GetProcesses + vbCrLf + "Total :" + Str(ILoop)
  102.     CloseHandle snap
  103. End Function

  104. Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
  105.     Dim STemp As String, pid As Long
  106.    
  107.     If GetParent(hwnd) = 0 Then
  108.         '讀取 hWnd 的視窗標題
  109.         STemp = String(80, 0)
  110.         GetWindowText hwnd, STemp, 80
  111.         STemp = Left(STemp, InStr(STemp, Chr(0)) - 1)
  112.         GetWindowThreadProcessId hwnd, pid
  113.         '當沒有標題的hWnd之pid被加入Coll的Collection時,
  114.         '若pid重覆會有錯,我們不管它
  115.         On Error Resume Next
  116.         If Len(STemp) <> 0 Then
  117.             If IsWindowVisible(hwnd) Then
  118.                 ProcessesNum = ProcessesNum + 1
  119.                 STemp = Left(STemp, InStr(STemp, Chr(0)) - 1)
  120.                 If FirstLoop Then
  121.                     Pro(0).ProcessID = pid
  122.                     Pro(0).ProcessName = STemp
  123.                     FirstLoop = False
  124.                 Else
  125.                     ReDim Preserve Pro(UBound(Pro) + 1) As ProcessData
  126.                     Pro(UBound(Pro)).ProcessID = pid
  127.                     Pro(UBound(Pro)).ProcessName = STemp
  128.                 End If
  129.             End If
  130.         End If
  131.     End If
  132.     EnumWindowsProc = True ' 表示繼續列舉 hWnd
  133. End Function

  134. Public Sub SortProcess()    '程序排列,採用泡沫排序法。
  135.     Dim PTemp As ProcessData
  136.     Dim ILoop As Integer
  137.     Dim ILoop2 As Integer
  138.     Dim ILoop3 As Integer
  139.     Dim Same As Boolean
  140.     Dim Changed As Boolean
  141.    
  142.     For ILoop = 1 To UBound(Pro)
  143.         Changed = False
  144.         For ILoop2 = 0 To UBound(Pro) - 1
  145.             If Len(Pro(ILoop2).ProcessName) < Len(Pro(ILoop2 + 1).ProcessName) Then
  146.                 For ILoop3 = 1 To Len(Pro(ILoop2).ProcessName)
  147.                     If Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2 + 1).ProcessName, ILoop3, 1)))), 2)) < Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2).ProcessName, ILoop3, 1)))), 2)) Then
  148.                         '下方資料較小,進行交換。
  149.                         PTemp.ProcessName = Pro(ILoop2).ProcessName
  150.                         PTemp.ProcessID = Pro(ILoop2).ProcessID
  151.                         Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
  152.                         Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
  153.                         Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
  154.                         Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
  155.                         Changed = True
  156.                         Exit For
  157.                     ElseIf Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2 + 1).ProcessName, ILoop3, 1)))), 2)) > Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2).ProcessName, ILoop3, 1)))), 2)) Then
  158.                         '下方資料較大,直接跳出。
  159.                         Exit For
  160.                     End If
  161.                 Next ILoop3
  162.             Else
  163.                 Same = True
  164.                 For ILoop3 = 1 To Len(Pro(ILoop2 + 1).ProcessName)
  165.                     If Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2 + 1).ProcessName, ILoop3, 1)))), 2)) < Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2).ProcessName, ILoop3, 1)))), 2)) Then
  166.                         '下方資料較小,進行交換。
  167.                         PTemp.ProcessName = Pro(ILoop2).ProcessName
  168.                         PTemp.ProcessID = Pro(ILoop2).ProcessID
  169.                         Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
  170.                         Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
  171.                         Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
  172.                         Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
  173.                         Changed = True
  174.                         Same = False
  175.                         Exit For
  176.                     ElseIf Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2 + 1).ProcessName, ILoop3, 1)))), 2)) > Val(Mid(Str(Asc(UCase(Mid(Pro(ILoop2).ProcessName, ILoop3, 1)))), 2)) Then
  177.                         '下方資料較大,直接跳出。
  178.                         Same = False
  179.                         Exit For
  180.                     End If
  181.                 Next ILoop3
  182.                 If Same Then
  183.                     '資料一樣但下方資料長度較短,進行交換。
  184.                     PTemp.ProcessName = Pro(ILoop2).ProcessName
  185.                     PTemp.ProcessID = Pro(ILoop2).ProcessID
  186.                     Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
  187.                     Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
  188.                     Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
  189.                     Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
  190.                     Changed = True
  191.                 End If
  192.             End If
  193.         Next ILoop2
  194.         If Not Changed Then
  195.             '第二層洄圈完全沒進行過交換,排序直接結束。
  196.             Exit Sub
  197.         End If
  198.     Next ILoop
  199. End Sub

  200. Public Sub KillProcessById(p_lngProcessId As Long)
  201.     Dim lnghProcess As Long
  202.     Dim lngReturn As Long
  203.    
  204.     lnghProcess = OpenProcess(1&, -1&, p_lngProcessId)
  205.     lngReturn = TerminateProcess(lnghProcess, 0&)
  206. End Sub

  207. Public Function GetWindowsProcess() As String
  208.     Dim ILoop As Integer
  209.    
  210.     FirstLoop = True
  211.     WindowsProc = "[ID]" + vbTab + "[Process]"
  212.     ProcessesNum = 0
  213.     ReDim Pro(0) As ProcessData
  214.     EnumWindows AddressOf EnumWindowsProc, 0&
  215.     SortProcess
  216.     For ILoop = 0 To UBound(Pro)
  217.         WindowsProc = WindowsProc & vbCrLf & Pro(ILoop).ProcessID & vbTab & Pro(ILoop).ProcessName
  218.     Next ILoop
  219.     GetWindowsProcess = WindowsProc + vbCrLf + "Total :" + Str(ProcessesNum)
  220. End Function
複製代碼

[ 本帖最後由 degit 於 2008-7-19 00:27 編輯 ]
喜歡這篇文章嗎?
回覆 0
您需要登入後才可以回帖 登入 | 註冊會員

本版積分規則 回覆 15 個字以上可拿獎勵,
規則詳見此

精選熱門商品

提示訊息
go_top