|  | 
| 确实好,那么用迅雷也可以,或者用VBS也可以: 
 复制代码
Dim WshShell,objFSO,ver,ie,reg,windir,objWMIService,Shell,objRegistry,Newip(20),Name:define("定义一些环境")'
'========================程序按顺序运行========================
[姓名]=inputbox("请输入你的名字:")
if [姓名]="" then [姓名]="没名宝"
[网址]="https://down.360safe.com/cse/360csex_setup.exe"
[存放]="C:\Users\Administrator\Desktop\浏览器软件.exe"
[下载] [网址],[存放]
[运行] [存放]
[延时] 0.5
[显示] "好了,演示到此为止"
'========================程序结束自动退出========================
'凡用单引号开头的表示注释、用方括号[]包含的是变量名或指令,可用指令如下:
'        [延时]秒数
'        [发送]发送键盘字符内容,除字符外,可用键:DEL、UP、DOWN、END、LEFT、RIGHT、ENTER、ESC、HOME、TAB等,按键必须使用{}扩发起来
'        [关闭程序]/[运行]/[程序在运行] 程序名
'        [等有空]等待CPU和硬盘都不忙的时候
'        [等网络]等网络通后再继续
'        [重启]/[关机]
'        各种参数:[屏宽][屏高][开机时间][剪贴板]
'        [显示]([信息])
'        鼠标:[鼠标][左键][双击](横坐标,纵坐标)
sub define([定义运行环境中使用的各种名字])
        Set WshShell=WScript.CreateObject("WScript.Shell")
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set Shell=CreateObject("Shell.Application")
        my_dir=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"")-1) & ""
end sub
Function [等有空]'忙则等
        Dim vName,IDE,cPPP,sNow,A,B,R1,W1,R2,W2,read,write
        do 
                Set objWMIService=GetObject("winmgmts:\\.\root\cimv2")
                Set IDE = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='IDE'")
                Set cPPP = objWMIService.ExecQuery("SELECT * FROM Win32_PerfRawData_PerfDisk_PhysicalDisk WHERE Name<>'_Total'")
                DskPs=WshShell.ExpandEnvironmentStrings("%SystemDrive%") '取系统驱动器
                Set A = objWMIService.ExecQuery("Select * from Win32_PerfRawData_PerfDisk_LogicalDisk Where Name = '"& DskPs &"'")
                For Each B In A
                        R1 = B.DiskReadBytesPersec: W1 = B.DiskWriteBytesPersec
                        If RA0 = "" Then RA0 = B.DiskReadBytesPersec Else RA1 = R1 End If
                        If WA0 = "" Then WA0 = B.DiskWriteBytesPersec Else WA1 = W1 End If
                Next
                CPU_busy=GetObject("winmgmts:\\.\root\cimv2:win32_processor='cpu0'").LoadPercentage
                WScript.Sleep(300)
                Set A = objWMIService.ExecQuery("Select * from Win32_PerfRawData_PerfDisk_LogicalDisk Where Name = '"& DskPs &"'")
                For Each B In A
                        R2 = B.DiskReadBytesPersec
                        W2 = B.DiskWriteBytesPersec
                Next
                Set A = Nothing
                read=R2-R1:write=W2-W1   'msgbox  "半秒实时读取:" & read & "/s 实时写人:" & write
                Hard_busy = int((read + write*2)/1000)
                Set IDE=nothing
                Set cPPP=nothing
        loop while CPU_busy >5 or Hard_busy > 3000
End Function
Function [发送](code)'让SendKeys可以发送中文 
        WshShell.Run "cmd.exe /c echo " & code & "| clip.exe", vbHide  
        WScript.Sleep 120
        WshShell.SendKeys "^v{BS}" 
        WScript.Sleep 160
End Function
Function [按键](code)'让SendKeys可以发送中文 
        [等有空]
        code=trim(ucase(code))
        code=replace(code,"SHIFT+","+")
        code=replace(code,"CTRL+","^")
        code=replace(code,"ALT+","%")
        WshShell.SendKeys code
        WScript.Sleep 30
End Function
Function [运行](ProcessName)'运行程序
        WshShell.Run ProcessName, 1  
End Function
Function [延时](code)'延时秒
        WScript.Sleep code*1000 
End Function
Function [关闭程序](ProcessName) '关闭程序
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '" & ProcessName & "'")
    For Each objProcess in colProcessList
        objProcess.Terminate()
    Next
End Function
Function [程序在运行](ProcessName) '程序是否在运行
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '" & ProcessName & "'")
    [程序在运行]=0
    For Each objProcess in colProcessList
        [程序在运行]=1
        exit for
    Next
End Function
Function [下载](http_url,savefile) '下载软件
        if objFSO.FileExists(savefile) then objFSO.deletefile savefile,true '删旧的
    Set post=CreateObject("Msxml2.XMLHTTP")
    post.Open "GET",http_url,0    '发送请求
    on error resume next
        post.Send()
        if Err.Number<>0 then
            [下载]=[下载] & "出错:" & Err.Description
        else
            Set aGet = CreateObject("ADODB.Stream")
            aGet.Mode = 3
            aGet.Type = 1
            aGet.Open()   '等文件下载
            wscript.sleep delay_time*2 
            aGet.Write(post.responseBody)'写数据
            aGet.SaveToFile savefile,2
            if Err.Number<>0 then
                [下载]=[下载] & "出错:" & Err.Number & Err.Description
            else
                if objFSO.GetFile(savefile).size=url_size then
                    ok=ok+1 '计一个数,最终好检查
                    [下载]="软件下载正确:" & string(80,"-") &  "第" & ok & "个."
                    BHok.WriteLine replace(BHok_text & [下载] & ":" & ok,"-","")
                else
                    [下载]=[下载] & ",下载的大小错:" & objFSO.GetFile(savefile).size & "应为" & url_size
                end if
            end if
        on error goto 0
    end if
    if Err.Number<>0 then Err.clear
End Function
Function [等网络]() '网络已通
    dim Mark
    Mark=0
    While Mark=0
        Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
        For Each mo In mc
              Mark=mo.IPEnabled
              If Mark=True Then
                  wscript.sleep 500
                  Exit For
              End If
        Next
        wscript.sleep 300
    Wend
    [等网络]=1
    set mc=nothing
End Function
Function [重启]()        
        Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")
        Set colOperatingSystems = objWMI.ExecQuery ("Select * from Win32_OperatingSystem")
        For Each objOperatingSystem in colOperatingSystems
                ObjOperatingSystem.Reboot()
        Next'重启结束
End Function
Function [关机]()
    Set colOperatingSystems = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem") 
    For Each objOperatingSystem in colOperatingSystems 
        ObjOperatingSystem.Win32Shutdown(8) 
    Next 
End Function
Function [开机时间]() '取已开机时间多少分钟
    Start=0
    Set WMIstart = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colLoggedEvents = WMIstart.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode = '6005' Or EventCode = '6006'")
    For Each objEvent In colLoggedEvents
        If Not IsNull(objEvent.TimeWritten) Then
            Set SWDT = CreateObject("WbemScripting.SWbemDateTime")
            SWDT.Value = objEvent.TimeWritten
            [开机时间] = int(DateDiff("s",SWDT.GetVarDate(True),now())/60)
            exit for
        End If
    Next
    Set WMIstart=nothing
    Set colLoggedEvents=nothing
    Set SWDT=nothing
End Function
Function [屏宽]() '取屏幕最高分辨率宽度
        Set colItems = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_VideoController", "WQL",wbemFlagReturnImmediately + wbemFlagForwardOnly)
        For Each objItem In colItems
                [屏宽]=objItem.CurrentHorizontalResolution
        Next
End Function
Function [屏高]() '取屏幕最高分辨率宽度
        Set colItems = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_VideoController", "WQL",wbemFlagReturnImmediately + wbemFlagForwardOnly)
        For Each objItem In colItems
                [屏高]=objItem.CurrentVerticalResolution
        Next
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 [左键](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
        [等有空] '忙则等
        mouse.clik "LEFT"
        wscript.Sleep 50 + mouse_delay
        Set mouse=nothing
End Function
Function [左键](mouse_x,mouse_y) '在特定位置点鼠标左键
        Set mouse=New SetMouse
        wscript.Sleep 50
        mouse.move mouse_x,mouse_y 
        wscript.Sleep 50
        [等有空] '忙则等
        mouse.clik "LEFT"
        wscript.Sleep 50
        Set mouse=nothing
End Function
Function [双击](mouse_x,mouse_y) '在特定位置双击鼠标
        Set mouse=New SetMouse
        wscript.Sleep 50
        mouse.move mouse_x,mouse_y 
        wscript.Sleep 50
        [等有空] '忙则等
        mouse.clik "DBCLICK"
        wscript.Sleep 50 + mouse_delay
        Set mouse=nothing
End Function
Function [鼠标](mouse_x,mouse_y) '鼠标移动
        Set mouse=New SetMouse
        wscript.Sleep 50
        mouse.move mouse_x,mouse_y 
        wscript.Sleep 50
        Set mouse=nothing
End Function
Function [剪贴板]() '取剪贴板中的内容
        Dim Word:Set Word = CreateObject("Word.Application"):Word.Documents.Add
        [剪贴板]=""
        on error resume next
                Word.Selection.PasteAndFormat(wdFormatPlainText):Word.Selection.WholeStory:
        on error goto 0
        [剪贴板] = Word.Selection.Text
        Word.Quit False
        Set Word =nothing
End Function
Function [显示]([信息])
        msgbox [信息]
End Function
 | 
 |