|
用VBS写这个东西,必须查询进程的CPU占用率,由于播放时CPU占用会大一些,所以,你可以判断CPU较低的时候就是跳出弹窗的时候。
- while CPU_busy >5: wscript.sleep 5000:Wend '如果CPU忙或者硬盘忙则等待
- ......
- Function CPU_busy() 'CPU使用率
- dim objProc
- Set objProc = GetObject("winmgmts:\\.\root\cimv2:win32_processor='cpu0'")
- CPU_busy=objProc.LoadPercentage 'CPU使用率
- Set objProc = nothing
- End Function
- Class SetMouse
- private S
- private xls, wbk, module1
- private reg_key, xls_code, x, y
- Private Sub Class_Initialize()
- Set xls = CreateObject("Excel.Application")
- Set S = CreateObject("wscript.Shell")
- reg_key = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM" 'vbs 完全控制excel
- reg_key = Replace(reg_key, "$", xls.Version)
- S.RegWrite reg_key, 1, "REG_DWORD"
- xls_code = _
- "Private Type POINTAPI : X As Long : Y As Long : End Type" & vbCrLf & _
- "Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
- "Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long" & vbCrLf & _
- "Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" " _
- & "(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _
- "Public Function getx() As Long" & vbCrLf & "Dim pt As POINTAPI : GetCursorPos pt : getx = pt.X" & vbCrLf & _
- "End Function" & vbCrLf & "Public Function gety() As Long" & vbCrLf & _
- "Dim pt As POINTAPI: GetCursorPos pt : gety = pt.Y" & vbCrLf & "End Function"
- Set wbk = xls.Workbooks.Add:Set module1 = wbk.VBProject.VBComponents.Add(1):module1.CodeModule.AddFromString xls_code
- End Sub
- '关闭
- Private Sub Class_Terminate
- on error resume next
- xls.DisplayAlerts = False:wbk.Close:xls.Quit
- on error goto 0
- End Sub
- '可调用过程
- Public Sub getpos( x, y):x = xls.Run("getx"):y = xls.Run("gety"):End Sub
- Public Sub move(x,y):wscript.Sleep 50:xls.Run "SetCursorPos", x, y:wscript.Sleep 300:End Sub
- Public Sub wheel_y(y) '鼠标滚轮上或下滚动y距离
- 'for wheel=1 to (y/10)
- wscript.Sleep 30
- 'xls.Run "mouse_event", &H800, 0, 0, (y/10), 0
- xls.Run "mouse_event", &H800, 0, 0, y, 0
- wscript.Sleep 30
- 'next
- wscript.Sleep 300
- End Sub
- Public Sub wheel_x(x) '鼠标滚轮上或下滚动x距离
- 'for wheel=1 to (x/10)
- wscript.Sleep 30
- xls.Run "mouse_event", &H800, 0, 0, x, 0
- wscript.Sleep 30
- 'next
- wscript.Sleep 300
- End Sub
- Public Sub clik(keydown)
- wscript.Sleep 80
- Select Case UCase(keydown)
- Case "LEFT"'点左键
- xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
- Case "RIGHT"'点右键
- xls.Run "mouse_event", &H8 + &H10, 0, 0, 0, 0
- Case "MIDDLE"'点中键
- xls.Run "mouse_event", &H20 + &H40, 0, 0, 0, 0
- Case "LDOWN"'按下左键
- xls.Run "mouse_event", &H2, 0, 0, 0, 0
- Case "RDOWN"'按下右键
- xls.Run "mouse_event", &H8, 0, 0, 0, 0
- Case "MDOWN"'按下中键
- xls.Run "mouse_event", &H20, 0, 0, 0, 0
- Case "LUP"'弹起左键
- xls.Run "mouse_event", &H4, 0, 0, 0, 0
- Case "RUP"'弹起右键
- xls.Run "mouse_event", &H10, 0, 0, 0, 0
- Case "MUP"'弹起中键
- xls.Run "mouse_event", &H40, 0, 0, 0, 0
- Case "DBCLICK"'双击
- xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
- xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
- End Select
- wscript.Sleep 300
- End Sub
- End Class
- Function clik_left(str) '在特定位置点鼠标左键
- dim mouse_x,mouse_y,mouse_delay,clik_arg
- str=split(str,",")
- mouse_delay=0
- for clik_arg=0 To UBound(str)-LBound(str)
- if clik_arg=0 then mouse_x=str(0)
- if clik_arg=1 then mouse_y=str(1)
- if clik_arg=2 then mouse_delay=str(2)
- next
- Set mouse=New SetMouse
- wscript.Sleep 50
- mouse.move mouse_x,mouse_y
- wscript.Sleep 50
- while CPU_busy >4 or Hard_busy >10240: wscript.sleep 200:Wend '忙则等
- mouse.clik "LEFT"
- wscript.Sleep 50 + mouse_delay
- Set mouse=nothing
- End Function
复制代码 |
|