スクリーンをロックしないVBSスクリプトを作成する方法

前提条件

• Windows システム
• VBS スクリプトの実行権限があります

概要

Window システムスクリーンをロックしないには、Mouse イベントまたはキーボードを動作する必要があります。
今回紹介したいのは上記の原理で、Mouse を自動的に移動させて、スクリーンをロックしない VBS スクリプトです。

実装

下記の実装内容は一回目実行するときはスクリプトを起動し、1 分毎に Mouse を自動的に移動させて、スクリーンをロックしないようにします。
二回目実行するときはスクリプトを停止します。

• execute.vbs

Option Explicit

Dim strProcessName, WshShell, Excel
Set Excel = WScript.CreateObject("Excel.Application")
strProcessName = "wscript.exe"
' Check if the script is already running
If IsScriptRunning()  Then
    Call CloseScript()
Else
    ' If the script is not running, start the script and display info
    MsgBox "started", vbInformation, "info"
    Call Start()
End If


Function IsScriptRunning()
    Dim objWMIService, colProcess, objProcess, processCount
    processCount = 0
    ' Get the running script process
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & strProcessName & "'")

    ' Check if the script is already running
    For Each objProcess In colProcess
        If objProcess.Name = strProcessName Then
            processCount = processCount + 1
        End If
    Next
    If processCount > 1 Then
        IsScriptRunning = True
    Else
        IsScriptRunning = False
    End If
End Function


Sub Start()
    Call MoveMouse()
    Call MouseWheelEvent()
    WScript.Sleep 60000 ' 60000 milliseconds equals 1 minutes
    Call Start() ' Move the mouse again
End Sub


Sub MoveMouse()
    Dim WshShell, intScreenWidth, intScreenHeight, command
    Randomize ' Initialize the random number seed
    ' Get the screen size
    intScreenWidth = 1000 ' Get the screen width
    intScreenHeight = 1000 ' Get the screen height
    ' Generate random new position
    Dim newX, newY
    newX = Int(Rnd * intScreenWidth) ' Generate a random X coordinate
    newY = Int(Rnd * intScreenHeight) ' Generate a random Y coordinate
    command = "CALL(""user32.dll"", ""SetCursorPos"", ""JJJ"", "& newX &", "& newY &")"
    Excel.ExecuteExcel4Macro(command)
End Sub

Dim Minus
Minus = True
Sub MouseWheelEvent()
    Const MOUSEEVENTF_WHEEL = &H800 ' The wheel was rolled.
    Randomize ' Initialize the random number seed
    Dim randNum
    If Minus Then
        randNum = Int(Rnd * 300) ' Generate a random number
        Minus = False
    Else
        randNum = Int(Rnd * 300) * -1 ' Generate a random number
        Minus = True
    End If
    Call MouseEvent(MOUSEEVENTF_WHEEL, 0, 0, randNum, 0)
End sub


Sub MouseEvent(dwFlags, dx, dy, dwData, dwExtraInfo)
    Dim strFunction
    Const command = "CALL(""user32"",""mouse_event"",""JJJJJj"", $1, $2, $3, $4, $5)"
    strFunction = Replace(Replace(Replace(Replace(Replace(command, "$1", dwFlags), "$2", dx), "$3", dy), "$4", dwData), "$5", dwExtraInfo)
    Call Excel.ExecuteExcel4Macro(strFunction)
End Sub


Sub CloseScript()
    Dim objWMIService, colProcess, objProcess
    ' Get the running script process
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & strProcessName & "'")

    ' Close the script and display the closing message
    MsgBox "Stopped", vbInformation, "info"
    For Each objProcess In colProcess
        If objProcess.Name = strProcessName Then
            objProcess.Terminate()
        End If
    Next
End Sub