'Form上放一个ListView,2个CommandBox(win2k下取文件名的那一部分要改一下,win98下没问题)Option ExplicitPrivate 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 hSapshot As Long, lppe As PROCESSENTRY32) As LongPrivate Type PROCESSENTRY32
dwSize As Long
cntUseage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
swFlags As Long
szExeFile As String * 1024
End TypePrivate Const TH32CS_SNAPPROCESS = &H2
Private Sub Form_Load()
Call ShowProcessInfo
End Sub
Private Sub ShowProcessInfo()
Dim pe As PROCESSENTRY32
Dim r As Long, i As Long
Dim ListItemX As ListItem
ListView1.ListItems.Clear
r = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If r <> 0 Then
pe.dwSize = 1060
Process32First r, pe
Set ListItemX = ListView1.ListItems.Add(, , GetFileName(pe.szExeFile))
ListItemX.SubItems(1) = Hex(pe.th32ProcessID)
ListItemX.SubItems(2) = pe.szExeFile
Do
i = Process32Next(r, pe)
If i > 0 Then
Set ListItemX = ListView1.ListItems.Add(, , GetFileName(pe.szExeFile))
ListItemX.SubItems(1) = Hex(pe.th32ProcessID)
ListItemX.SubItems(2) = pe.szExeFile
Else
Exit Do
End If
Loop
End If
End Sub
Private Function GetFileName(strFullPath As String) As String
Dim i As Integer
Dim strFileName As String
For i = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, i, 1) = "\" Then
strFileName = Right(strFullPath, Len(strFullPath) - i)
strFileName = UCase(Left(strFileName, 1)) & LCase(Right(strFileName, Len(strFileName) - 1))
GetFileName = strFileName
Exit Function
End If
Next i
End Function
Private Sub Command1_Click()
Call ShowProcessInfo
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSapshot As Long, lppe As PROCESSENTRY32) As LongPrivate Type PROCESSENTRY32
dwSize As Long
cntUseage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
swFlags As Long
szExeFile As String * 1024
End TypePrivate Const TH32CS_SNAPPROCESS = &H2
Private Sub Form_Load()
Call ShowProcessInfo
End Sub
Private Sub ShowProcessInfo()
Dim pe As PROCESSENTRY32
Dim r As Long, i As Long
Dim ListItemX As ListItem
ListView1.ListItems.Clear
r = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If r <> 0 Then
pe.dwSize = 1060
Process32First r, pe
Set ListItemX = ListView1.ListItems.Add(, , GetFileName(pe.szExeFile))
ListItemX.SubItems(1) = Hex(pe.th32ProcessID)
ListItemX.SubItems(2) = pe.szExeFile
Do
i = Process32Next(r, pe)
If i > 0 Then
Set ListItemX = ListView1.ListItems.Add(, , GetFileName(pe.szExeFile))
ListItemX.SubItems(1) = Hex(pe.th32ProcessID)
ListItemX.SubItems(2) = pe.szExeFile
Else
Exit Do
End If
Loop
End If
End Sub
Private Function GetFileName(strFullPath As String) As String
Dim i As Integer
Dim strFileName As String
For i = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, i, 1) = "\" Then
strFileName = Right(strFullPath, Len(strFullPath) - i)
strFileName = UCase(Left(strFileName, 1)) & LCase(Right(strFileName, Len(strFileName) - 1))
GetFileName = strFileName
Exit Function
End If
Next i
End Function
Private Sub Command1_Click()
Call ShowProcessInfo
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货