VB制作小程序问题 - 站长资源库

答案：'-----------------------------------------------------------

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

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

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

'新建一个类
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哪里错了

更多图片编程知识: