操作方式
- 01
把以下将要展示的代码粘贴在新建的一个文本文档中
然后把后缀改当作.vbs - 02
简单的石头铰剪布小游戏
msgbox"接待来到石头铰剪布1.0！"
randomize
do
a=msgbox("是否起头游戏？",vbyesno,"石头铰剪布1.0")
if a=vbyes then
b=inputbox("请输入您要出的是什么，1石头、2铰剪、3布","请输入！")
d=int(rnd*3+1)
strs=Array("石头","铰剪","布")
msgbox"您出的是"&strs(b-1)&"电脑出的是"&strs(d-1)
else
wscript.Quit
end if
loop - 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 5000
set objTTS = createobject("sapi.spvoice")
objTTS.speak"XXX，再会！"
WScript.Sleep 5000
dim WSHshell
set WSHshell = wscript.createobject("wscript.shell")
WSHshell.run"shutdown -f -s -t 00",0 ,true - 05
增大音量，可用do loop
Set 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 WSHshell
set WSHshell = wscript.createobject("wscript.shell")
do
wscript.sleep 2500
WSHshell.SendKeys"%{F4}"
loop - 09
电脑措辞
set objTTS = createobject("sapi.spvoice")
objTTS.speak"XXXXXXX" - 10
删除指定路径的文件夹
Dim fso
Set 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 WshShell
Set 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 WshShell
Set 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, Today
JD = 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.DateCreated
msgbox"文件最后点窜时候："&fn.DateLastModified
msgbox"文件最后拜候时候："&fn.DateLastAccessed
set fn=nothing
set fso=nothing - 22
最后，我给大师来一个长一点儿的。
找出当地磁盘中空的工具并删除它们
'/// 本家儿程序部门
Dim objfso, WshShell, ext
Set 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
Next
end Sub
sub isEmptyFolder(folderobj)
on error resume Next
if folderobj.Size=0 and err.Number=0 then
if folderobj.subfolders.Count=0 Then
ReportEmptyFolder folderobj
end If
end If
end Sub
sub ReportEmptyFolder(folderobj)
on error resume next
lastaccessed = folderobj.DateLastAccessed
on error goto 0
response = MsgBox("我们在:" & vbCr _
& folderobj.path & vbCr &"发现了空文件夹" &"文件夹最后拜候时候:" _
& vbCr & lastaccessed & vbCr _
&"您想删除这个文件夹么?", _
vbYesNoCancel + vbDefaultButton2)
if response = vbYes Then
logbook.WriteLine"[文件夹:]"
logbook.WriteLine folderobj.path & vbCrlf &" 在" & Now &" 被删除"
folderobj.delete
elseif response=vbCancel Then
MsgBox"您选择了退出！感谢利用" & vbCrLf &"(c) Zero 2014"
WScript.Quit
end If
end Sub - 23
此指南个体借鉴收集其他大神的作品并做了点窜!
在此不必全数提出。
感谢大师！ - End
出格提醒
小我堆集的代码，网上很多都是反复的。如内含有错误，接待大神们斧正！
