电脑默认一段时间会关闭监视器或者硬盘,即便设置电源都选择从不也好像不太好使,导致远程的时候时常出问题,比如qq自动远程协助没反应。于是我想到用vb写一个小工具不停的移动鼠标,让电脑以为一直有人在使用,这样就不会锁屏或者待机了。
原理就是使用windows的api函数移动鼠标,本案例是基于clswindow开发的,这个是vb下的一个框架,主要是用于控制第三方程序的。主要代码:
Private Sub Command1_Click()
Dim w As New clsWindow
Randomize
Do
x1 = Screen.Width / 15 * Rnd
y1 = Screen.Height / 15 * Rnd
w.SetCursor x1, y1 '随机移动到屏幕内任意一个点
w.Wait 5000 '等待5秒钟
Loop
End Sub
花样搞多点,随机画圆、画线啥的:
Option Explicit
Dim isDraw As Boolean
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
isDraw = True
Dim w As New clsWindow
Dim i%
Randomize
Do While isDraw
If Int(Rnd * 100) Mod 2 = 0 Then
drawACircle
Else
DrawALine
End If
w.Wait Val(Text1.Text) * 1000 '等待N秒钟
Loop
Command1.Enabled = True
Command2.Enabled = False
End Sub
'随机画个圆
Private Sub drawACircle()
Dim w As New clsWindow
Dim x As Double, y As Double
Dim sW&, sH&
Dim k As Single
Dim R As Double
sW = Screen.Width \ 15
sH = Screen.Height \ 15
Const pi As Single = 3.14159
Randomize
x = (sW - 300) * Rnd + 300
y = (sH - 500) * Rnd + 500
R = sH * Rnd + sH / 4
Me.Caption = R
Do While k < 2 * pi
w.SetCursor Cos(k) * R / 4 + x, Sin(k) * R / 4 + y, , , 5
k = k + pi / 180
DoEvents
Loop
End Sub
'随机画根线
Private Sub DrawALine()
Dim w As New clsWindow
Dim x1&, y1&, xPad&, yPad&, lngWidth&, i&, intRndType%, intRndType2%
Dim sW&, sH&
sW = Screen.Width \ 15
sH = Screen.Height \ 15
Randomize
x1 = sW * Rnd
y1 = sH * Rnd
xPad = IIf(x1 > sW / 2, -1, 1)
yPad = IIf(y1 > sH / 2, -1, 1)
lngWidth = sH * Rnd / 2 + sH / 4
intRndType = Int(Rnd * 2)
intRndType2 = Int(Rnd * 2)
For i = 1 To lngWidth
If intRndType = 0 Then
If intRndType2 = 0 Then
x1 = x1 + xPad
Else
y1 = y1 + yPad
End If
Else
x1 = x1 + xPad
y1 = y1 + yPad
End If
w.SetCursor x1, y1
w.Wait 5
Next
End Sub
Private Sub Command2_Click()
isDraw = False
End Sub
clswindow使用手册:https://www.kancloud.cn/sysdzw/clswindow/1514782
如果不懂vb或者不懂编程的小伙伴可以直接到下面的github下载,里面的exe是编译好的,可直接运行。
完整工程打包下载:https://github.com/sysdzw/PreventLockScreen/