|
确实好,那么用迅雷也可以,或者用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
复制代码 |
|