当前位置:首页 > 运维笔记 > 正文内容

Visual Basic 判断进程是否运行

Scar5个月前 (08-15)运维笔记147

在编写程序的时候,有时候需要判断进程,比如检测自身是否运行等等,下面的实例使用了以下4个API:  

❤ CreateToolhelp32Snapshot(ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long


❤ Process32First  (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long


❤ Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long


❤ CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


   如果你不明白具体的使用方法,可以自己Google、Baidu

   

代码如下:


'=============================================
'模块 Process.bas
'转载请注明出处:www.2wxk.com
'代码仅供参考,如有不对请找博主(点击评论)!
'=============================================
Option Explicit
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 * 1024
End Type
Private 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Public Function FindProcess(ByVal ProcessName As String) As Long
    Dim strdata As String
    Dim my As PROCESSENTRY32
    Dim l As Long
    Dim l1 As Long
    Dim mName As String
    Dim i As Integer, pid As Long
    l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If l Then
       my.dwSize = 1060
       If (Process32First(l, my)) Then
          Do
              i = InStr(1, my.szExeFile, Chr(0))
              mName = LCase(left(my.szExeFile, i - 1))
              If mName = LCase(ProcessName) Then
                 pid = my.th32ProcessID
                 FindProcess = pid
                 Exit Function
              End If
          Loop Until (Process32Next(l, my) < 1)
       End If
       l1 = CloseHandle(l)
    End If
   FindProcess = 0
End Function
 
'=====================
'调用函数
'=====================
Private Sub Command1_Click()
   If FindProcess("notepad.exe") <> 0 Then '检测 notepad.exe 进程是否存在
       Msgbox "记事本已经运行了!"
   Else
       Msgbox "记事本没有运行!"    End If
End Sub
 
'本代码于作者 2015-12-12 17:30 Windows7 旗舰版测试通过。
 
 
'前几天优化代码,用太多函数没用而且占用空间,于是就突发奇想,一个进程都有PID,那就做一个PID检测程序,如果PID不等于0,那么进程就存在,否则就不存在,说好就开始动手。于是在网络上找到这个代码:
 
Public Function GetProcessPid(ProcessName As String) As Long    Dim pid    As Long    Dim pname    As String    Dim a As String    a = Trim(LCase(Text1))    Dim my    As PROCESSENTRY32    Dim l    As Long    Dim l1    As Long    Dim flag    As Boolean    Dim mName    As String    Dim i    As Integer
   l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)    If l Then       my.dwSize = 1060    End If    If (Process32First(l, my)) Then     '遍历第一个进程       Do           i = InStr(1, my.szExeFile, Chr(0)) '返回chr(0)在各个进程中出现的位置           mName = LCase(Left(my.szExeFile, i - 1)) '返回小写的(返回i-1的前n个字符,即正确的名称)           If mName = a Then               pid = my.th32ProcessID                                      End If       Loop Until (Process32Next(l, my) < 1)    End IfEnd Function
 
'调用:getprocesspid(进程名),返回PID。


扫描二维码至手机访问

扫描二维码推送至手机访问。

版权声明:本文由小卡博客发布,如需转载请注明出处。

转载请注明出处:https://www.2wxk.com/post/5.html

标签: vb原创
分享给朋友:

相关文章

宝塔一键挂载数据盘

1.有些人买服务器官方并带了数据盘有些朋友却不知道怎么使用,下面我教大家如何挂载2.我们可以看到磁盘这是官方自带20GB数据3.BT-Panel Linux自动磁盘挂载工具Centos系统请...

宝塔8.23最新pma重大漏洞自查教程

宝塔在今天曝出一个很严重的漏洞,至于是什么我就不用多说了,听说有gov网站也惨遭毒手,堪称今年最大网络安全事故。 先上解决方案:安全组关闭888端口,或升级面板 自查教程如下:‘pma’连接日志格...

CentOS 小樱开源repo镜像源

~~~~~~~~~~萌萌的分割线~~~~~~~~~~~认准官网:http://mirrors.itzmx.com/archlinux使用帮助:http://bbs.itzmx.com/forum.ph...

记录一下某CentOS6.9镜像的玄学问题

记录一下某CentOS6.9镜像的玄学问题

如题 一使用yum就翻车初步判断是镜像问题下面就直接搬运了:1. 查看centos7.2系统本身所安装的yum依赖包[root@zf-test-web01-4 ~]# rpm -q...

Kangle的autocert项目可对接实现ep自动化申请证书

最近逛gitee发现keengo大佬开了个新坑先上传送门:https://gitee.com/keengo/autocert看了一下安装教程和使用说明也是非常简单实用的安装教程   ...

发表评论

访客

看不清,换一张

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。