[技术讨论] VBS 发送按键实例

yu2n

驱动安装时，老是提示驱动没有签名，是否继续，很烦。
那么这样做就行了。

' KeyCode - 按键代码：
' Shift +       *Ctrl ^     *Alt %     *BACKSPACE {BACKSPACE}, {BS}, or {BKSP}      *BREAK {BREAK}
' CAPS LOCK {CAPSLOCK}      *DEL or DELETE {DELETE} or {DEL}     *DOWN ARROW {DOWN}     *END {END}
' ENTER {ENTER}or ~     *ESC {ESC}     *HELP {HELP}   *HOME {HOME}   *INS or INSERT {INSERT} or {INS}
' LEFT ARROW {LEFT}     *NUM LOCK {NUMLOCK}    *PAGE DOWN {PGDN}     *PAGE UP {PGUP}    *PRINT SCREEN {PRTSC}
' RIGHT ARROW {RIGHT}   *SCROLL LOCK {SCROLLLOCK}      *TAB {TAB}    *UP ARROW {UP}     *F1 {F1}   *F16 {F16}
' 实例：切换输入法（模拟同时按下：Shift、Ctrl键）"+(^)" ；重启电脑（模拟按下：Ctrl + Esc、u、r键）: "^{ESC}ur" 。
' 同时按键：在按 e和 c的同时按 SHIFT 键: "+(ec)" ；在按 e时只按 c（而不按 SHIFT）: "+ec" 。
' 重复按键：按 10 次 "x": "{x 10}"。按键和数字间有空格。
' 特殊字符：发送 “+”、“^” 特殊的控制按键："{+}"、"{^}"
' 注意：只可以发送重复按一个键的按键。例如，可以发送 10次 "x"，但不可发送 10次 "Ctrl+x"。  
' 注意：不能向应用程序发送 PRINT SCREEN键{PRTSC}。

' 安装时忽略未签名的驱动程序
Call DriverSigningIagree()
' 安装时提示未签名的驱动程序
Call DriverSigningWarning()

' 安装时忽略未签名的驱动程序
Sub DriverSigningIagree()
    Set wso = WScript.CreateObject("WScript.Shell")
    Sleep 200
    Call RunNotWait( "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2" )
    Do While i < 35    ' 在 7 秒内执行，35*200 = 7*1000
        i = i + 1
        If (AppActivate("系统属性") = True) Or (AppActivate("系統內容") = True) Then
            Sleep 100
            SendKeys "%S"
            Sleep 100
            If (AppActivate("驱动程序签名选项") = True) Or AppActivate("驅動程式碼簽署選項") = True Then
                Sleep 100
                SendKeys "%I"
                Sleep 100
                SendKeys "{ENTER}"
                Sleep 100
                SendKeys "{ESC}"
                Exit Do
            Else
                SendKeys "{ESC}"
            End If
        End If
        Sleep 200
    Loop
    Set wso = Nothing
End Sub

' 安装时提示未签名的驱动程序
Sub DriverSigningWarning()
    Set wso = WScript.CreateObject("WScript.Shell")
    Sleep 200
    Call RunNotWait( "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2" )
    Do While i < 35    ' 在 7 秒内执行，35*200 = 7*1000
        i = i + 1
        If (AppActivate("系统属性") = True) Or (AppActivate("系統內容") = True) Then
            Sleep 100
            SendKeys "%S"
            Sleep 100
            If (AppActivate("驱动程序签名选项") = True) Or AppActivate("驅動程式碼簽署選項") = True Then
                Sleep 100
                SendKeys "%W"
                Sleep 100
                SendKeys "{ENTER}"
                Sleep 100
                SendKeys "{ESC}"
                Exit Do
            Else
                SendKeys "{ESC}"
            End If
        End If
        Sleep 200
    Loop
    Set wso = Nothing
End Sub




'===========================================================================================
'小函数
Sub Sleep( sTime )
    WScript.Sleep sTime
End Sub
Sub SendKeys( strKey )
    Set wso = CreateObject("WScript.Shell")
    wso.SendKeys strKey
    Set wso = Nothing
End Sub
Function AppActivate( strWindowTitle )
    Set wso = CreateObject("WScript.Shell")
    AppActivate = wso.AppActivate( strWindowTitle )
    Set wso = Nothing
End Function

'执行程序
Sub Run( strCmd )
    'On Error Resume Next
    Set wso = CreateObject("WScript.Shell")
    wso.Run strCmd, 1, True
    Set wso = Nothing
End Sub
Sub RunNotWait( strCmd )
    'On Error Resume Next
    Set wso = CreateObject("WScript.Shell")
    wso.Run strCmd, 1, False
    Set wso = Nothing
End Sub
Sub RunHide( strCmd )
    'On Error Resume Next
    Set wso = CreateObject("WScript.Shell")
    wso.Run strCmd, 0, True
    Set wso = Nothing
End Sub
Sub RunHideNotWait( strCmd )
    'On Error Resume Next
    Set wso = CreateObject("WScript.Shell")
    wso.Run strCmd, 0, False
    Set wso = Nothing
End Sub

zgh7878788

如果焦点不在驱动安装上面怎么办（有人用了电脑）？可以考虑用后台发送么?

czjt1234

这个纯粹是前台发送的