自定义进程函数.bas

来自「实现对触摸屏的监控」· BAS 代码 · 共 94 行

Attribute VB_Name = "自定义进程函数"
Option Explicit
Public Cmp_File As String
Public Sub 列举所有进程()
On Error Resume Next
Frm_main.List1.Clear
Select Case getVersion()
 
Case 1   'Windows  95/98
 
     Dim f   As Long, sname    As String
     Dim hSnap   As Long, proc    As PROCESSENTRY32
     hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
     If hSnap = hNull Then Exit Sub
     proc.dwSize = Len(proc)
     '  Iterate  through  the  processes
     f = Process32First(hSnap, proc)
     Do While f
         sname = StrZToStr(proc.szExeFile)
         Frm_main.List1.AddItem sname
         f = Process32Next(hSnap, proc)
     Loop
 
Case 2   'Windows  NT
 
     Dim cb   As Long
     Dim cbNeeded   As Long
     Dim NumElements   As Long
     Dim ProcessIDs()   As Long
     Dim cbNeeded2   As Long
     Dim NumElements2   As Long
     Dim Modules(1 To 200)     As Long
     Dim lRet   As Long
     Dim ModuleName   As String
     Dim nSize   As Long
     Dim hProcess   As Long
     Dim i   As Long
     'Get  the  array  containing  the  process  id's  for  each  process  object
     cb = 8
     cbNeeded = 96
     Do While cb <= cbNeeded
           cb = cb * 2
           ReDim ProcessIDs(cb / 4) As Long
           lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
     Loop
     NumElements = cbNeeded / 4
 
     For i = 1 To NumElements
           'Get  a  handle  to  the  Process
           hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
                 Or PROCESS_VM_READ, 0, ProcessIDs(i))
           'Got  a  Process  handle
           If hProcess <> 0 Then
                   'Get  an  array  of  the  module  handles  for  the  specified
                   'process
                   lRet = EnumProcessModules(hProcess, Modules(1), 200, _
                                                                             cbNeeded2)
                   'If  the  Module  Array  is  retrieved,  Get  the  ModuleFileName
                   If lRet <> 0 Then
                         ModuleName = Space(MAX_PATH)
                         nSize = 500
                         lRet = GetModuleFileNameExA(hProcess, Modules(1), _
                                                         ModuleName, nSize)
                         Frm_main.List1.AddItem Left(ModuleName, lRet)
                   End If
           End If
       'Close  the  handle  to  the  process
     lRet = CloseHandle(hProcess)
     Next
 
End Select

End Sub

Public Function IsRun(ByVal filename As String) As Boolean
On Error Resume Next
       Dim i   As Long
       IsRun = False
       For i = 1 To Frm_main.List1.ListCount
           If UCase(Frm_main.List1.List(i)) = UCase(filename) Then
              IsRun = True
              Exit Function
           End If
       Next
End Function

Public Sub 判断()
 On Error Resume Next
 Dim i
 If IsRun(Cmp_File) = False Then
    Call 重起计算机
 End If
End Sub