'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