GetPID

来源:互联网 发布:淘宝首页怎么设计 编辑:程序博客网 时间:2024/04/27 15:54

Option Explicit

Const MAX_PATH = 260
Const TH32CS_SNAPPROCESS = 2&

Private Type PROCESSENTRY32
    lSize            As Long
    lUsage           As Long
    lProcessId       As Long
    lDefaultHeapId   As Long
    lModuleId        As Long
    lThreads         As Long
    lParentProcessId As Long
    lPriClassBase    As Long
    lFlags           As Long
    sExeFile         As String * MAX_PATH
End Type

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" _
    Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, _
    ByVal lProcessId As Long) As Long
   
Private Declare Function ProcessFirst Lib "kernel32" _
    Alias "Process32First" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
   
Private Declare Function ProcessNext Lib "kernel32" _
    Alias "Process32Next" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
Private Sub Form_Load()
Dim sExeName   As String
Dim sPid       As String
Dim sParentPid As String
Dim lSnapShot  As Long
Dim r          As Long
Dim uProcess   As PROCESSENTRY32

lSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> 0 Then
    With MSFLEXGRID1
    .Clear
    .Rows = 1
    .Cols = 4
'    .FixedCols = 1
'    .FixedRows = 0
    .TextMatrix(0, 0) = "Module Name"
    .TextMatrix(0, 1) = "Process Id"
    .TextMatrix(0, 2) = "Parent" & vbCrLf & "Process"
    .TextMatrix(0, 3) = "Threads"
    .RowHeight(0) = 400
    .ColWidth(0) = 4200
    .ColWidth(1) = 950
    .ColWidth(2) = 950
    .ColWidth(3) = 775
    .ColAlignment(0) = flexAlignLeftBottom
    .ColAlignment(1) = flexAlignLeftBottom
    .ColAlignment(2) = flexAlignLeftBottom
    .ColAlignment(3) = flexAlignLeftBottom
   
    uProcess.lSize = Len(uProcess)
    r = ProcessFirst(lSnapShot, uProcess)

    Do While r
        sExeName = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
        sPid = Hex$(uProcess.lProcessId)
        sParentPid = Hex$(uProcess.lParentProcessId)
        .AddItem sExeName & vbTab & sPid & vbTab & _
                sParentPid & vbTab & CStr(uProcess.lThreads)
        r = ProcessNext(lSnapShot, uProcess)
    Loop
    CloseHandle (lSnapShot)
    End With
End If
End Sub