vb 读取进程数据有问题

Question

用以下方法读取的进程列表显示在文本框中的错,这是为什么?
中间的分隔符"*"没了,在最后还加的几个不确定字符 
       捆扰我很久了,请各位帮忙   谢谢了!
Private Sub Command1_Click()
Dim i As Long, lPid As Long
Dim Proc As PROCESSENTRY32
Dim hSnapShot As Long
   ListView1.ListItems.Clear '清空ListView
   hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
   Proc.dwSize = Len(Proc)
   lPid = ProcessFirst(hSnapShot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据
   i = 0
   Text1.Text = ""
   Do While lPid <> 0 '当返回值非零时继续获取下一个进程
       ListView1.ListItems.Add , "a" & i, Proc.th32ProcessID 'Hex(Proc.th32ProcessID)    '将进程ID添加到ListView1第一列
       ListView1.ListItems("a" & i).SubItems(1) = Proc.szExeFile '将进程名添加到ListView1第二列
       i = i + 1
       lPid = ProcessNext(hSnapShot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据
       Text1.Text = Text1.Text & Proc.th32ProcessID & Proc.szExeFile & "*"   '出错的地方
   Loop
   CloseHandle hSnapShot '关闭进程“快照”句柄
End Sub'---------------
还有一问,我在读取操作系统信息时也有这个问题.
Private Type OSVERSIONINFO
   dwOSVersionInfoSize  As Long
   dwMajorVersion  As Long
   dwMinorVersion  As Long
   dwBuildNumber  As Long
   dwPlatformId  As Long
   szCSDVersion  As String * 128
   osName  As String
End TypeDim ver   As OSVERSIONINFO
ver.szCSDVersion
得到的ver.szCSDVersion后面也有一些乱符号,用trim()也去不掉

Answer 1

Text1.Text = Text1.Text & Proc.th32ProcessID & Trim0(Proc.szExeFile) & "*"   '出错的地方
Function Trim0(sText as String) as String
    dim iPos as long
    iPos=InStr(1, sText, vbNullChar, vbBinaryCompare)
    if iPos<>0 then
        Trim0 = Left$(sText, iPos - 1)
    Else
        Trim0=sText
    end if
end funcion

Answer 2

看这里:
http://72.14.203.104/search?q=cache:Oid6-6wMLMIJ:www.newzgc.com/bbs/showdoc.asp%3Fbid%3D10%26id%3D237%26pageno%3D1+CreateToolhelpSnapshot+vb+api+TH32CS_SNAPall&hl=zh-CN

Answer 3

晕，我帖一下吧：
Option Explicit
'======================用于查找进程和终止进程的API函数常数定义=====================
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 Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH As Integer = 260
Private 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
Const TH32CS_SNAPheaplist = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPthread = &H4
Const TH32CS_SNAPmodule = &H8
Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule'======================在WIN2000下提升本进程权限的API函数常数定义=====================
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const TOKEN_ASSIGN_PRIMARY = &H1
Const TOKEN_DUPLICATE = (&H2)
Const TOKEN_IMPERSONATE = (&H4)
Const TOKEN_QUERY = (&H8)
Const TOKEN_QUERY_SOURCE = (&H10)
Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Const TOKEN_ADJUST_GROUPS = (&H40)
Const TOKEN_ADJUST_DEFAULT = (&H80)
Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
                          TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
                          TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Private Type LUID
    lowpart As Long
    highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'======================用于查找进程的版本信息的API函数常数定义=====================
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Type MODULEENTRY32
    dwsize As Long
    th32ModuleID As Long
    th32ProcessID As Long
    GlblcntUsage As Long
    ProccntUsage As Long
    modBaseAddr As Byte
    modBaseSize As Long
    hModule As Long
    szModule As String * 256
    szExePath As String * 1024
End TypePrivate Declare Function GetFileVersionInfo Lib "Version.dll" _
   Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, _
   ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As LongPrivate Declare Function GetFileVersionInfoSize Lib "Version.dll" _
   Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As LongPrivate Declare Function VerQueryValue Lib "Version.dll" _
   Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
   lplpstrFileInfoString As Any, puLen As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Answer 4

'续上
======================用于获得进程CPU时间的API函数常数定义================ =====
Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Type FILETIME ' 8 Bytes
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type SYSTEMTIME ' 16 Bytes
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
'程序加载
Private Sub Form_Load()
    '以下 AdjustTokenPrivileges2000 此过程只对Win2000有用，用做提升进程权限
'    AdjustTokenPrivileges2000
    Me.Caption = "WINDOWS 进程管理器 — 风化专用的^_^    QQ：584327"
    Command1.Caption = "刷新"
    Command2.Caption = "终止进程"
    Command3.Caption = "退出"
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "进程名", 1600
    ListView1.ColumnHeaders.Add , , "进程ID", 1200
    ListView1.ColumnHeaders.Add , , "出版公司", 1800
    ListView1.ColumnHeaders.Add , , "版本号", 1600
    ListView1.ColumnHeaders.Add , , "路径", 3800
    ListView1.ColumnHeaders.Add , , "文件创建日期", 1900
    ListView1.ColumnHeaders.Add , , "大小", 1600
    ListView1.ColumnHeaders.Add , , "CPU", 800
    ListView1.ColumnHeaders.Add , , "CPU时间", 1600
    ListView1.View = lvwReport
    ListView1.FullRowSelect = True
    ListView1.LabelEdit = lvwManual
    Command1_Click '刷新进程列表
End SubPrivate Sub Form_Resize()
If Me.WindowState <> 1 Then
    ListView1.Width = Me.Width - 300
    ListView1.Height = Me.Height - 1600
    Command1.Move Me.Width - 4680, Me.Height - 810
    Command2.Move Command1.Left + 1560, Command1.Top
    Command3.Move Command2.Left + 1560, Command1.TopEnd If
End Sub'显示当前系统中全部进程，[刷新]按钮
Private Sub Command1_Click()
Dim i As Long, lPid As Long, FileName As String, TmpStr As String, TmpLong As Long
Dim Proc As PROCESSENTRY32
Dim hSnapshot As Long
Dim Mode As MODULEENTRY32
Dim mSnapshot As Long
Dim lInfoSize As Long, arrInfo() As Byte, lpInfoBlock As Long, arrTemp(4) As Byte
Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    ListView1.ListItems.Clear '清空ListView
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
    Proc.dwsize = Len(Proc)
    lPid = ProcessFirst(hSnapshot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据
    i = 0
    Do While lPid <> 0 '当返回值非零时继续获取下一个进程
        '----------------在结构Proc元素szExeFile中为进程名-----------
        TmpStr = Trim(Left(Proc.szExeFile, InStr(Proc.szExeFile, Chr(0)) - 1))
        TmpLong = InStr(TmpStr, "\")
        Do While TmpLong <> 0
          TmpStr = Mid(TmpStr, TmpLong + 1)
          TmpLong = InStr(TmpStr, "\")
        Loop
        ListView1.ListItems.Add , "a" & i, TmpStr  '将进程名添加到ListView1第1列
        '----------------在结构Proc元素th32ProcessID中为进程ID-----------
        ListView1.ListItems("a" & i).SubItems(1) = Proc.th32ProcessID & "(&H" & Hex(Proc.th32ProcessID) & ")"   '将进程ID添加到ListView1第2列
        
        '----------------查找进程的执行程序的路径-----------------------
        '通过模块快照，获得进程的模块快照句柄
        mSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Proc.th32ProcessID)
        If mSnapshot > 0 Then
             Mode.dwsize = Len(Mode) '初始化结构mo的大小
             TmpStr = Trim(Left(Proc.szExeFile, InStr(Proc.szExeFile, Chr(0)) - 1))
             '用该进程第1个模块的szExePath字段，作为进程的程序路径
             If Module32First(mSnapshot, Mode) And UCase(TmpStr) <> "[SYSTEM PROCESS]" Then
                 If InStr(UCase(Mode.szExePath), UCase(TmpStr)) Then  '将加载模块的路径加入ListBox
                     TmpStr = Left(Mode.szExePath, InStr(Mode.szExePath, Chr(0)) - 1)
                     If InStr(TmpStr, ":") > 2 Then TmpStr = Mid(TmpStr, InStr(TmpStr, ":") - 1)
                     '进程的执行程序的路径
                     ListView1.ListItems("a" & i).SubItems(4) = TmpStr
                 Else
                     Do While Module32Next(mSnapshot, Mode) <> 0
                          If InStr(UCase(Mode.szExePath), UCase(TmpStr)) Then  '将加载模块的路径加入ListBox
                              TmpStr = Left(Mode.szExePath, InStr(Mode.szExePath, Chr(0)) - 1)
                              If InStr(TmpStr, ":") > 2 Then TmpStr = Mid(TmpStr, InStr(TmpStr, ":") - 1)
                              '进程的执行程序的路径
                              ListView1.ListItems("a" & i).SubItems(4) = TmpStr
                          End If
                          Mode.szExePath = ""
                     Loop 'Until Module32Next(mSnapshot, Mode) = 0
                 End If
                 If ListView1.ListItems("a" & i).SubItems(4) = "" Then
                     Module32First mSnapshot, Mode
                     TmpStr = Left(Mode.szExePath, InStr(Mode.szExePath, Chr(0)) - 1)
                     If InStr(TmpStr, ":") > 2 Then TmpStr = Mid(TmpStr, InStr(TmpStr, ":") - 1)
                     '进程的执行程序的路径
                     ListView1.ListItems("a" & i).SubItems(4) = TmpStr
                 End If
             End If
             CloseHandle (mSnapshot)   '关闭模块快照句柄
        End If
        
        '-------------------------------------------------------------------
        lInfoSize = GetFileVersionInfoSize(TmpStr, 0&)
        If lInfoSize > 0 Then
             ReDim arrInfo(lInfoSize)
             If GetFileVersionInfo(TmpStr, 0&, lInfoSize, arrInfo(0)) <> 0 Then
                 If VerQueryValue(arrInfo(0), "\VarFileInfo\Translation", lpInfoBlock, lInfoSize) Then
                     CopyMemory arrTemp(0), ByVal lpInfoBlock, lInfoSize
                     TmpStr = Right("00" & Hex(arrTemp(1)), 2) & Right("00" & Hex(arrTemp(0)), 2) & _
                                Right("00" & Hex(arrTemp(3)), 2) & Right("00" & Hex(arrTemp(2)), 2)
                     ListView1.ListItems("a" & i).SubItems(2) = GetInfoBlock("CompanyName", TmpStr, arrInfo, lpInfoBlock, lInfoSize)
                     ListView1.ListItems("a" & i).SubItems(3) = GetInfoBlock("FileVersion", TmpStr, arrInfo, lpInfoBlock, lInfoSize)
                 End If
             End If
        End If
        On Error Resume Next
        Set f = fs.GetFile(ListView1.ListItems("a" & i).SubItems(4))
        ListView1.ListItems("a" & i).SubItems(6) = Format(f.Size / 1024 + 0.5, "##,##0.00") & "K(" & f.Size & ")"
        ListView1.ListItems("a" & i).SubItems(5) = f.DateCreated
        On Error GoTo 0
        
        
        
        Dim lpCreateionTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME
        Dim lpUserTime As FILETIME, CpuTime As FILETIME, SysTime As SYSTEMTIME
        
        On Error Resume Next
        TmpLong = OpenProcess(PROCESS_ALL_ACCESS, False, Proc.th32ProcessID)        GetProcessTimes TmpLong, lpCreateionTime, lpExitTime, lpKernelTime, lpUserTime
        CpuTime.dwHighDateTime = lpKernelTime.dwHighDateTime + lpUserTime.dwHighDateTime
        CpuTime.dwLowDateTime = lpKernelTime.dwLowDateTime + lpUserTime.dwLowDateTime
        FileTimeToSystemTime CpuTime, SysTime
        ListView1.ListItems.Item("a" & i).SubItems(8) = (SysTime.wHour & ":" & SysTime.wMinute & ":" & SysTime.wSecond)
        On Error GoTo 0        
        i = i + 1
        lPid = ProcessNext(hSnapshot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据
    Loop
    CloseHandle hSnapshot '关闭进程“快照”句柄
End Sub

Answer 5

'续上'获得
Private Function GetInfoBlock(ByVal inStringName As String, StrL As String, aInfo() As Byte, lpInfoBlock As Long, lInfoSize As Long) As String
    Dim strFileInfoString As String
    GetInfoBlock = ""
    strFileInfoString = String(128, 0)
    If VerQueryValue(aInfo(0), "\StringFileInfo\" & StrL & _
        "\" & inStringName, lpInfoBlock, lInfoSize) > 0 Then
        CopyMemory ByVal strFileInfoString, ByVal lpInfoBlock, 128&
        GetInfoBlock = Mid(strFileInfoString, 1, InStr(strFileInfoString, vbNullChar) - 1)
    End If
End Function
'终止指定进程
Private Sub Command2_Click()
Dim lPHand As Long, TMBack As Long
    If ListView1.SelectedItem.Text <> "" Then
        If MsgBox("确实要结束进程[" & ListView1.SelectedItem.Text & "-" & ListView1.SelectedItem.SubItems(1) & "]吗？", vbYesNo) = vbYes Then
             lPHand = Val(ListView1.SelectedItem.SubItems(1))
             lPHand = OpenProcess(1&, True, lPHand)  '获取进程句柄
             TMBack = TerminateProcess(lPHand, 0&)   '关闭进程
             If TMBack <> 0 Then
               MsgBox "进程[" & ListView1.SelectedItem.Text & "]已经被终止！"
             Else
               MsgBox "进程[" & ListView1.SelectedItem.Text & "]不能被终止！"
             End If
             CloseHandle lPHand
             Command1_Click '刷新进程列表
        End If
    End If
End Sub'退出
Private Sub Command3_Click()
    Unload Me
End Sub'这个函数用于在WIN2000系统中，本进程提升权限
Sub AdjustTokenPrivileges2000()
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Dim lp As Long
    hdlProcessHandle = GetCurrentProcess()
    lp = OpenProcessToken(hdlProcessHandle, TOKEN_ALL_ACCESS, hdlTokenHandle)
    lp = LookupPrivilegeValue("", "SeDebugPrivilege", tmpLuid)
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    lp = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End Sub