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

Visual Basic 判断进程是否运行

Scar3个月前 (08-15)运维笔记84

在编写程序的时候,有时候需要判断进程,比如检测自身是否运行等等,下面的实例使用了以下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原创
分享给朋友:

相关文章

Kangle KOS版防CC滑块验证

HTTP/1.1 200 OK Content-Type: text/html; charset=utf-8 Connection: keep-a...

Kangle的Easypanel虚拟主机面板修改模板底部文件footer

Kangle的Easypanel虚拟主机面板修改模板底部文件footer

管理员目录:/vhs/kangle/nodewww/webftp/admin/view/default/common/foot.html,加在foot即可,还有login_error.html用户模板...

WHMCS 客户中心登录总是提示密码错误

WHMCS 客户中心登录总是提示密码错误

▼ WHMCS 客户注册后,可以顺利进入客户中心,但在退出后再次登录会提示用户名或密码错误 这个问题其实挺常见,但是原因却比较难发现,再加上百度上基本...

Kangle EP访问ip:3312/admin报错403、404(记香港免费空间被黑)

Kangle EP访问ip:3312/admin报错403、404(记香港免费空间被黑)

本方法经作者探索而出,非常简单实用,与网上的不同今天客户反映香港免费空间节点上不去了突然想起这台小鸡已经用了很久了 脚本、漏洞都没有跟进更新一、访问IP很显然不是我们想象中的 Kangle...

Centos 6/7 永久修改DNS(零基础版)

Centos 6/7 永久修改DNS(零基础版)

Centos 永久修改DNS1、vi /etc/sysconfig/network-scripts/ifcfg-eth0 #进入配置IP地址的文件2、按 i 键 进行编辑3、修改 DNS1=xxx.x...

发表评论

访客

看不清,换一张

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