vbs代码，纯自己采集，绝对良心！

多段vbs代码，大家可借鉴，提意见或建议！

工具/材料

windows电脑一台

操作方法

01、

把以下将要展示的代码粘贴在新建的一个文本文档中然后把后缀改成.vbs

02、

简单的石头剪刀布小游戏msgbox"欢迎来到石头剪刀布1.0！"randomizedoa=msgbox("是否开始游戏？",vbyesno,"石头剪刀布1.0")if a=vbyes thenb=inputbox("请输入你要出的是什么，1石头、2剪刀、3布","请输入！")d=int(rnd*3+1)strs=Array("石头","剪刀","布")msgbox "你出的是"&strs(b-1)&"电脑出的是"&strs(d-1)elsewscript.Quitend ifloop

03、

自动报时问好Digital=Time hours=Hour(Digital) minutes=Minute(Digital) seconds=Second(Digital) If (hours<6) Then dn="凌辰了还没睡啊" End If If (hours>=6) Then dn="早上好" End If If (hours>12) Then dn="下午好" End If If (hours>18) Then dn="晚上好" End If If (hours>22) Then dn="不早了夜深了该睡觉了" End If If (minutes<=9) Then minutes="0" & minutes End If If (seconds<=9) Then seconds="0" & seconds End If ctime=hours & ":" & minutes & ":" & seconds & " " & dn MsgBox ctime

04、

定时关机并弹出对话框WScript.Sleep 5000set objTTS = createobject("sapi.spvoice")objTTS.speak "XXX，再见！"WScript.Sleep 5000dim WSHshellset WSHshell = wscript.createobject("wscript.shell")WSHshell.run "shutdown -f -s -t 00",0 ,true

05、

增大音量，可用do loopSet ws = CreateObject("WScript.Shell")ws.SendKeys Chr(&H88AF)

06、

减小音量Set ws = CreateObject("WScript.Shell")ws.SendKeys Chr(&H88AE)

07、

运行后删除自身代码，请备份一个再运行dim fso,f Set fso = CreateObject("Scripting.FileSystemObject") f = fso.DeleteFile(WScript.ScriptName)

08、

打开任何程序都关掉dim WSHshellset WSHshell = wscript.createobject("wscript.shell")dowscript.sleep 2500WSHshell.SendKeys "%{F4}"loop

09、

电脑说话set objTTS = createobject("sapi.spvoice")objTTS.speak "XXXXXXX"

10、

删除指定路径的文件夹Dim fsoSet fso=CreateObject("Scripting.FileSystemObject")fso.DeleteFolder("C:\ ") '不管文件夹中有没有文件都一并删除

11、

隐藏桌面的所有图标（谨慎使用）解药在下一个set ws=createobject("wscript.shell")ws.run "taskkill /im explorer.exe /f",0,true

12、

显示回图标，上一个在运行时要先留一个资源管理器窗口，然后右键运行即可解除set ws=createobject("wscript.shell")ws.run "explorer.exe",0,true

13、

把桌面背景转化成自己想要的图片（要bmp格式哦！指定路径哦）set ws=createobject("wscript.shell")ws.regwrite "HKCU\Control Panel\Desktop\wallpaper","C:\XXX.bmp","REG_SZ"ws.run "RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters"

14、

禁用任务管理器Set WshShell = CreateObject("Wscript.Shell")WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr",1,"REG_DWORD"

15、

禁用注册表编辑器WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",1,"REG_DWORD"

16、

取消禁用任务管理器Dim WshShellSet WshShell = CreateObject("Wscript.Shell")WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr",0,"REG_DWORD"Wscript.Echo "恢复成功!"Wscript.Quit

17、

取消禁用注册表编辑器Dim WshShellSet WshShell = CreateObject("Wscript.Shell")WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",0,"REG_DWORD"Wscript.Echo "恢复成功!"Wscript.Quit

18、

静音非静音切换Set ws = CreateObject("WScript.Shell")ws.SendKeys Chr(&H88AD)

19、

把当前vbs复制到指定路径path1=WScript.ScriptFullName '获取你的vbs路径Set fso=WScript.CreateObject("scripting.filesystemobject")Set fs=fso.GetFile(path1)fs.Copy("d:\") '把你的vbs复制到D盘，也可以是其他路径，具体你自己设置MsgBox "已经复制成功"'如果达到隐形目的，这排可以删除

20、

计算本地日落时间Dim JD, WD, Days, SunDown, TimeArea, X, ACOS, Arr, TodayJD = 105.1 '经度，东为正西为负，我国都是东经WD = 31.4 '纬度，北为正南为负，我国都是北纬TimeArea = 8 '时区，东正西负，有东九、东八、东七、东六、东五五个时区TodAy = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日" Days = DateDiff("d", Year(Now) & "-1-1 00:00:00", Now) + 1 X = -TAN(-23.4*COS(2*3.14*(Days+9)/365)*3.14/180)*TAN(WD*3.14/180)ACOS = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)SunDown = Round(24*(1+(TimeArea*15-JD)/180)-24*(180+TimeArea*15-JD-ACOS*180/3.14)/360, 2)Arr = Split(SunDown, ".")SunDown = Arr(0) & ":" & Int((0&"."&Int(Arr(1)))*60) WScript.Echo "本地" & Today & "日落时间为：" & SunDown

21、

显示指定路径的文件创建时间，最后修改时间，文件最后访问时间set fso=createobject("Scripting.FileSystemObject")set fn=fso.GetFile("C:\Users\Administrator\Desktop\what how 感叹用法.txt")msgbox "文件创建时间："&fn.DateCreatedmsgbox "文件最后修改时间："&fn.DateLastModifiedmsgbox "文件最后访问时间："&fn.DateLastAccessedset fn=nothingset fso=nothing

22、

最后，我给大家来一个长一点儿的。找出本地磁盘中空的东西并删除它们'/// 主程序部分Dim objfso, WshShell, extSet objfso = WScript.CreateObject("Scripting.Filesystemobject")Set WshShell = CreateObject("Wscript.Shell")choices = "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr & "3.退出"prompt = "日志文档保存在 " & "C:\EmptyDelete.log" & vbCrLf & vbCrLf & "单击是(开始)，否(退出)！" & vbCrLf & vbCrLf &_ "(c) Zero 2014"confirm = MsgBox("本工具将在本地磁盘上搜索空的东西(文件夹和文件)!" & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1,"欢迎使用！")If confirm = vbyes Then MsgBox "不建议在C盘和D盘使用，错误删除与本作者无关" , vbOKOnly + vbExclamation ,"提示" do getchoice = InputBox ("请输入需要处理的事项:" & vbCr & choices) if isnumeric(getchoice) then exit do else msgbox "请输入数字" end If Loop getchoice = CInt(getchoice) Select Case getchoice Case 1: '搜索空文件 getdrv = InputBox("请输入需要处理的盘符"& "格式如下: E:\","盘符","E") getdrv = getdrv & ":\" ext = InputBox("请输入需要搜索的文件扩展名"& "比如：txt","扩展名","txt") logfile = "C:\EmptyDelete.log" set logbook = objfso.OpenTextFile(logfile, 8, true) Call CheckDiskFile(getdrv,ext) logbook.Close WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly Case 2: '搜索空文件夹 getdrv = InputBox("请输入需要处理的盘符"& "格式如下: E","盘符","E") getdrv = getdrv & ":\" logfile = "C:\EmptyDelete.log" set logbook = objfso.OpenTextFile(logfile, 8, true) set drive = objfso.GetDrive(getdrv) CheckFolder drive.RootFolder logbook.Close WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly End select Else If confirm = vbno Then MsgBox "你会回来的！" & vbCrLf & "(c) Zero 2014" , vbOKOnly+ vbError,"提示" WScript.Quit End If End If '/// 主程序部分结束'/// /////////////////////////////////////////////检查空文件部分开始//////////////////////// Function CheckDiskFile(drv,ext) extTemp = ext On Error Resume Next Dim fso Set fso = WScript.CreateObject("Scripting.Filesystemobject") Set drvRootFiles = fso.GetFolder(drv) Set files = drvRootFiles.Files For Each file In files IsEmptyFile file,extTemp Next Set subfoldertemp = fso.GetFolder(drv) Set subfolders = subfoldertemp.SubFolders For Each subfolder In subfolders CheckDiskFile subfolder,extTemp '递归 Next End Function'/// 测试是否为空文件Sub IsEmptyFile(file,ext) On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") extFile = fso.GetExtensionName(file) If file.Size = 0 And extFile = ext Then ReportEmpty file End If End Sub '/// 写入日志文件Function ReportEmpty(file) On Error Resume Next response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_ "你想删除吗？", vbYesNo + vbDefaultButton1,"提示") If vbyes = response Then logbook.WriteLine vbCrLf logbook.WriteLine "[文件:]" logbook.WriteLine file.Path & vbCrlf & " 在 " & Now & " 被删除" objfso.DeleteFile file, True end If End Function'/// /////////////////////////////////////////////检查空文件部分结束//////////////////////// '/// /////////////////////////////////////////////检查空文件夹部分开始//////////////////////sub CheckFolder(folderobj) on error resume Next isEmptyFolder folderobj for each subfolder in folderobj.subfolders CheckFolder subfolder Nextend Subsub isEmptyFolder(folderobj)on error resume Nextif folderobj.Size=0 and err.Number=0 then if folderobj.subfolders.Count=0 Then ReportEmptyFolder folderobj end If end Ifend Subsub ReportEmptyFolder(folderobj)on error resume nextlastaccessed = folderobj.DateLastAccessedon error goto 0response = MsgBox("我们在:" & vbCr _& folderobj.path & vbCr & "发现了空文件夹 " & "文件夹最后访问时间:" _& vbCr & lastaccessed & vbCr _& "你想删除这个文件夹么?", _vbYesNoCancel + vbDefaultButton2)if response = vbYes Then logbook.WriteLine "[文件夹:]" logbook.WriteLine folderobj.path & vbCrlf & " 在 " & Now & " 被删除" folderobj.deleteelseif response=vbCancel Then MsgBox "你选择了退出！谢谢使用" & vbCrLf & "(c) Zero 2014" WScript.Quitend Ifend Sub

23、

此指南个别借鉴网络其他大神的作品并做了修改!在此不必全部提出。谢谢大家！

End

特别提示

个人积累的代码，网上许多都是重复的。如内含有错误，欢迎大神们指正！