当前位置:编程学习 > VB >>

VB制作小程序问题

我想做一个小程序就是每隔1分钟自动检测123.exe这进程存在,如果存在的话,则自动结束这进程,但如果存在,则重新及时1分钟,但我不知道这代码该怎么写,跪求高手帮我写下,本人菜鸟!
补充:打错了,如果存在的话,则自动结束这进程,但如果不存在,则重新及时1分钟

追问:请问,我想弄如果进程不存在,则重新计时1分钟,这代码怎么改?(不需要自动打开那程序)

答案:'-----------------------------------------------------------

'好了,代码已经修改好了,请楼主测试

'先新建一个类模版 然后添加下面代码

'新建一个工程 画两时钟 如图

 

'新建一个类
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
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
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
 
 
 
Function exitproc(ByVal exefile As String) As Boolean
exitproc = False
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = exefile Then
exitproc = True
Exit Do
End If
r = Process32Next(hSnapShot, uProcess)
Loop
End Function

'----------------------------------------------------

'窗体代码

Private Sub Form_Load()
Me.Hide '后台运行
App.TaskVisible = False '任务栏隐藏
Form1.Visible = False '隐藏窗体
Timer1.Interval = 1000
Shell ("C:\123.exe")
End Sub

Private Sub Timer1_Timer()
If exitproc("123.exe") Then '判断123.exe进程是否存在
Call Shell("taskkill /im " & "123.exe", vbHide) '123.exe进程存在就关闭123.exe
Else
Timer1.Interval = 0
Timer2.Interval = 60000
End If
End Sub

Private Sub Timer2_Timer()
If exitproc("123.exe") Then '检测123.exe进程是否存在
Else
Shell ("C:\123.exe") '打开123.exe  注意,请把123.exe放到C盘或改下123.exe文件存放在的路径
Timer.Interval = 1
Timer2.Interval = 0
End If
End Sub

'已经测试OK!符合你的要求!

'欢迎编程爱好者加入我们的问问团队【収起兲眞滴笑脸】 我们永远

是一个团体。

'如果确实符合楼主要求,请按正常程序结贴。。。。。。

VB是我很早前玩的语言,代码用if...then语句解决,调用系统检测进程123是否存在,存在就结束并释放占用内存

这个不用这么麻烦   你直接创建一个 timer 控件 把间隔设置 60000 enabled设置true 

然后把代码写在timer里面

shell "taskkill /f /im 123.txt" 即可 不会占空间 而且如果不存在的话 等于无效(会弹个黑东西 1秒吧)不过这个不影像什么的  代码就简单多了 是cmd

新建一个模块
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 * 260 
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 Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long 
'打开进程 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long 
'关闭进程 
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long 
'释放句柄 
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long) 
Private Const TH32CS_SNAPPROCESS = &H2& 

Private Sub KillProcess(sProcess As String) 
Dim lSnapShot As Long 
Dim lNextProcess As Long 
Dim tPE As PROCESSENTRY32 
'创建进程队列快照 
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) 
'如果队列不为空则搜索 
If lSnapShot <> -1 Then 
'获取进程控制块 
tPE.dwSize = Len(tPE) 
'取首个进程的地址 
lNextProcess = Process32First(lSnapShot, tPE) 
'循环搜索 
Do While lNextProcess 
'判断是否索索到进程 
If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then 
'结束进程 
Dim lProcess As Long 
Dim lExitCode As Long 
lProcess = OpenProcess(1, False, tPE.th32ProcessID) 
TerminateProcess lProcess, lExitCode 
CloseHandle lProcess 
End If 
'进程指针下移一位,搜索下一个进程 
lNextProcess = Process32Next(lSnapShot, tPE) 
Loop 
'释放进程句柄 
CloseHandle (lSnapShot) 
End If 
End Sub
窗体:添加一个Timer控件,设置Interval=60000,Enabled=True

Private Sub Form_Load()
KillProcess "123.exe"
End Sub
Private Sub Timer1_Timer()
KillProcess "123.exe"
End Sub

 

'声明

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 Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Const TH32CS_SNAPPROCESS = &H2&
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long


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 * 260
End Type

 

 

Function CheckApplicationIsRun(ByVal szExeFileName As String) As Boolean '判断进程是否存在的进程
On Error GoTo err
Dim WMI
Dim Obj
Dim Objs
CheckApplicationIsRun = False
Set WMI = GetObject("WinMgmts:")
Set Objs = WMI.InstancesOf("Win32_Process")
For Each Obj In Objs
If InStr(UCase(szExeFileName), UCase(Obj.Description)) <> 0 Then
CheckApplicationIsRun = True
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
Exit Function
End If
Next
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
Exit Function
err:
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
End Function

 

Private Sub KillProcess(sProcess

上一个:vb编程有点错误
下一个:VB Txet哪里错了

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,