Kelp-Space 是記錄一些生活雜事的Blog' Program by Kelp
' 建立日期 2007/06/02
' 改版日期 2007/08/19
' 說明
' GetProcesses 取得所有Process名稱及ID 傳回值為String
' GetWindowsProcess 取得視窗標題及ProcessID 傳回值為String
' KillProcessById 藉由ProcessID關閉該Process 引數為Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
複製程式碼(copy to clipboard)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Program by Kelp
'
' 建立日期 2007/06/02
' 改版日期 2007/08/19
'
' 說明
' GetProcesses 取得所有Process名稱及ID 傳回值為String
' GetWindowsProcess 取得視窗標題及ProcessID 傳回值為String
' KillProcessById 藉由ProcessID關閉該Process 引數為Long
'
' 改版內容
' 增加列舉有視窗之Process函數
' 列舉時具有排序功能
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'PROCESSES
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Coll As Collection
Public WindowsProc As String
Private ProcessesNum As Integer
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function terminateprocess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPheaplist = &H1
Public Const TH32CS_SNAPthread = &H4
Public Const TH32CS_SNAPmodule = &H8
Public Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
Public Const MAX_PATH As Integer = 260
Public 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 * MAX_PATH
End Type
Public Type ProcessData
ProcessName As String
ProcessID As Long
End Type
Public Pro() As ProcessData
Dim FirstLoop As Boolean
Public Function GetProcesses() As String
Dim ret
Dim TheLoopingProcess
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim STemp As String
Dim STemp2 As String
Dim ILoop As Integer
Dim ILoop2 As Integer
Dim WordValue As Long
ReDim Pro(0) As ProcessData
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) 'get snapshot handle
proc.dwSize = Len(proc)
TheLoopingProcess = ProcessFirst(snap, proc) 'first process and return value
FirstLoop = True
GetProcesses = "[ID]" + vbTab + "[Process]"
While TheLoopingProcess <> 0 'next process
If proc.th32ProcessID <> 0 Then
ILoop = ILoop + 1
STemp = Left(proc.szExeFile, InStr(proc.szExeFile, Chr(0)) - 1)
STemp2 = Right(STemp, 4)
If Replace(STemp2, ".exe", "", , , vbTextCompare) = "" Then
STemp = Mid(STemp, 1, Len(STemp) - 4)
End If
If FirstLoop Then
Pro(0).ProcessID = proc.th32ProcessID
Pro(0).ProcessName = STemp
FirstLoop = False
Else
ReDim Preserve Pro(UBound(Pro) + 1) As ProcessData
Pro(UBound(Pro)).ProcessID = proc.th32ProcessID
Pro(UBound(Pro)).ProcessName = STemp
End If
End If
proc.szExeFile = ""
TheLoopingProcess = ProcessNext(snap, proc)
Wend
SortProcess
For ILoop2 = 0 To UBound(Pro)
GetProcesses = GetProcesses & vbCrLf & Pro(ILoop2).ProcessID & vbTab & Pro(ILoop2).ProcessName
Next ILoop2
GetProcesses = GetProcesses + vbCrLf + "Total :" + Str(ILoop)
CloseHandle snap
End Function
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim STemp As String, pid As Long
If GetParent(hwnd) = 0 Then
'讀取 hWnd 的視窗標題
STemp = String(80, 0)
GetWindowText hwnd, STemp, 80
STemp = Left(STemp, InStr(STemp, Chr(0)) - 1)
GetWindowThreadProcessId hwnd, pid
'當沒有標題的hWnd之pid被加入Coll的Collection時，
'若pid重覆會有錯，我們不管它
On Error Resume Next
If Len(STemp) <> 0 Then
If IsWindowVisible(hwnd) Then
ProcessesNum = ProcessesNum + 1
STemp = Left(STemp, InStr(STemp, Chr(0)) - 1)
If FirstLoop Then
Pro(0).ProcessID = pid
Pro(0).ProcessName = STemp
FirstLoop = False
Else
ReDim Preserve Pro(UBound(Pro) + 1) As ProcessData
Pro(UBound(Pro)).ProcessID = pid
Pro(UBound(Pro)).ProcessName = STemp
End If
End If
End If
End If
EnumWindowsProc = True ' 表示繼續列舉 hWnd
End Function
Public Sub SortProcess() '程序排列，採用泡沫排序法。
Dim PTemp As ProcessData
Dim ILoop As Integer
Dim ILoop2 As Integer
Dim ILoop3 As Integer
Dim Same As Boolean
Dim Changed As Boolean
For ILoop = 1 To UBound(Pro)
Changed = False
For ILoop2 = 0 To UBound(Pro) - 1
If Len(Pro(ILoop2).ProcessName) < Len(Pro(ILoop2 + 1).ProcessName) Then
For ILoop3 = 1 To Len(Pro(ILoop2).ProcessName)
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
'下方資料較小，進行交換。
PTemp.ProcessName = Pro(ILoop2).ProcessName
PTemp.ProcessID = Pro(ILoop2).ProcessID
Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
Changed = True
Exit For
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
'下方資料較大，直接跳出。
Exit For
End If
Next ILoop3
Else
Same = True
For ILoop3 = 1 To Len(Pro(ILoop2 + 1).ProcessName)
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
'下方資料較小，進行交換。
PTemp.ProcessName = Pro(ILoop2).ProcessName
PTemp.ProcessID = Pro(ILoop2).ProcessID
Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
Changed = True
Same = False
Exit For
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
'下方資料較大，直接跳出。
Same = False
Exit For
End If
Next ILoop3
If Same Then
'資料一樣但下方資料長度較短，進行交換。
PTemp.ProcessName = Pro(ILoop2).ProcessName
PTemp.ProcessID = Pro(ILoop2).ProcessID
Pro(ILoop2).ProcessName = Pro(ILoop2 + 1).ProcessName
Pro(ILoop2).ProcessID = Pro(ILoop2 + 1).ProcessID
Pro(ILoop2 + 1).ProcessName = PTemp.ProcessName
Pro(ILoop2 + 1).ProcessID = PTemp.ProcessID
Changed = True
End If
End If
Next ILoop2
If Not Changed Then
'第二層洄圈完全沒進行過交換，排序直接結束。
Exit Sub
End If
Next ILoop
End Sub
Public Sub KillProcessById(p_lngProcessId As Long)
Dim lnghProcess As Long
Dim lngReturn As Long
lnghProcess = OpenProcess(1&, -1&, p_lngProcessId)
lngReturn = terminateprocess(lnghProcess, 0&)
End Sub
Public Function GetWindowsProcess() As String
Dim ILoop As Integer
FirstLoop = True
WindowsProc = "[ID]" + vbTab + "[Process]"
ProcessesNum = 0
ReDim Pro(0) As ProcessData
EnumWindows AddressOf EnumWindowsProc, 0&
SortProcess
For ILoop = 0 To UBound(Pro)
WindowsProc = WindowsProc & vbCrLf & Pro(ILoop).ProcessID & vbTab & Pro(ILoop).ProcessName
Next ILoop
GetWindowsProcess = WindowsProc + vbCrLf + "Total :" + Str(ProcessesNum)
End Function
沒有留言:
張貼留言