Option Explicit
Private WithEvents Timer1 As Timer
Private wsh As Object
Private objWnd As Object
Private Const ObjHour As Integer = 1
Private Const ObjMinute As Integer = 59
Private Const ObjSecond As Integer = 0
Private LastSwitchTime As Date ' 记录上次切换时间
'显示窗口
Private Sub Form_Load()
'On Error Resume Next
'Set wsh = CreateObject("WScript
.Shell")
'屏蔽显示窗口代码
'Set objWnd = wsh
.Exec("mshta
.exe ""about:<title>页面自动程序</title><body bgcolor=white><center><h1>运行中</h1><p>系统每1分钟自动按一次F11和Tab键,防止桌面自动锁屏
.<br> @@@@@
关闭窗口停止运行程序@@@@@</p></center><script>window
.resizeTo(800,400);window
.moveTo((screen
.width-800)/2,(screen
.height-400)/2);</script>""")
'If Err
.Number <> 0 Then
'MsgBox "错误创建窗口: " & Err
.Description
'Exit Sub
'End If
Set Timer1 = Controls
.Add("vb
.timer", "Timer1")
Timer1
.Interval = 1000 ' 1秒检测一次
Timer1
.Enabled = True ' 初始状态启用定时器
OpenBrowserUrls
End Sub
'增加按钮
Private Sub cmdStart_Click()
Timer1
.Enabled = True ' 启动定时器
cmdStart
.Enabled = False ' 禁用启动按钮
cmdStop
.Enabled = True ' 启用停止按钮
' 可选：添加启动时需要执行的初始化代码
OpenBrowserUrls ' 如果需要启动时打开浏览器
End Sub
Private Sub cmdStop_Click()
Timer1
.Enabled = False ' 停止定时器
cmdStart
.Enabled = True ' 启用启动按钮
cmdStop
.Enabled = False ' 禁用停止按钮
' 可选：添加停止时需要执行的清理代码
End Sub
Private Sub OpenBrowserUrls()
Dim browserPath As String
Dim urls(1 To 4) As String ' 4个URL
browserPath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge
.exe"
urls(1) = "http://192
.168
.10
.81/decision/view/form?viewlet=%25E5%2588%25B6%25E9%2580%25A02%25E9%2583%25A8%252F%25E7%25AC%25AC3%25E5%2588%25B6%25E9%2580%25A0%25E7%25A7%2591%252F%25E7%25AE%25A1%25E7%2590%2586%25E6%259D%25BF%252F%25E6%2580%25BB%25E8%25A3%2585%25E7%25BB%2584%25E7%25AE%25A1%25E7%2590%2586%25E6%259D%25BF%252F%25E7%25AC%25AC3%25E5%2588%25B6%25E9%2580%25A0%25E7%25A7%2591%25E6%2595%25B0%25E5%25AD%2597%25E5%258C%2596%25E5%258F%25AF%25E8%25A7%2586%25E7%2594%25BB%25E9%259D%25A2
.frm&ref_t=design&ref_c=c1f4da3a-8211-44b6-94c4-3a88c1251739" '3科数字化页面
urls(2) = "http://192
.168
.154
.11:4000/gridWebAndon/revoAssembly_Allparts" '#12线装配安东
urls(3) = "http://192
.168
.10
.81/decision/view/form?viewlet=%25E5%2588%25B6%25E9%2580%25A02%25E9%2583%25A8%252F%25E7%25AC%25AC3%25E5%2588%25B6%25E9%2580%25A0%25E7%25A7%2591%252F%25E7%25AC%25AC3%25E5%2588%25B6%25E9%2580%25A0%25E7%25A7%2591%25E4%25BA%25BA%25E5%2591%2598%25E7%25AE%25A1%25E7%2590%2586%25E6%259D%25BF%252F%25E7%25AC%25AC3%25E5%2588%25B6%25E9%2580%25A0%25E7%25A7%2591%25E4%25BA%25BA%25E5%2591%2598%25E7%25AE%25A1%25E7%2590%2586%25E6%259D%25BF
.frm&ref_t=design&ref_c=aa9c72db-5215-48d4-b36f-a5841c
32c7c6" '人员管理板
urls(4) = "http://192
.168
.154
.11:5000/gridWebAndon/revoAllparts" '#12线加工安东
Dim i As Integer
For i = 1 To 4
' 打开浏览器窗口
wsh
.Run Chr(34) & browserPath & Chr(34) & " " & Chr(34) & urls(i) & Chr(34)
DoEvents
' 等待页面加载
Sleep 2000
' 确保窗口激活后再发送F11
wsh
.AppActivate "Microsoft Edge"
Sleep 500 ' 短暂延迟确保激活完成
wsh
.SendKeys "{F11}"
Next i
' 额外确保最后一个窗口全屏
wsh
.AppActivate "Microsoft Edge"
Sleep 500
wsh
.SendKeys "{F11}"
LastSwitchTime = Now ' 初始化切换时间
End Sub
Private Sub Timer1_Timer()
Dim CurHour As Integer
Dim CurMinute As Integer
Dim CurSecond As Integer
CurHour = Hour(Now)
CurMinute = Minute(Now)
CurSecond = Second(Now)
' 检查是否到达关机时间
If CurHour = ObjHour And CurMinute >= ObjMinute Then
'wsh
.Run "cmd
.exe /c shutdown -s -f" ' 原关机命令已禁用
Exit Sub
End If
' 每1分钟切换一次标签页
If DateDiff("n", LastSwitchTime, Now) >= 1 Then
wsh
.AppActivate "Microsoft Edge"
Sleep 500 ' 确保窗口激活
wsh
.SendKeys "^{TAB}" ' Ctrl+Tab切换标签页
LastSwitchTime = Now
End If
End Sub
Private Sub Sleep(ms As Long)
Dim endTime As Date
endTime = DateAdd("s", ms / 1000, Now)
Do While Now < endTime
DoEvents
Loop
End Sub
启动程序报错
本文介绍了解决Windows系统中drwtsn32.exe错误的方法，包括禁用Dr.Watson调试程序、删除user.dmp文件以及修改注册表设置。
扫一扫
223
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
