vbs代码 vbs代码大全及含义 vbs代码教程

  vbs代码 vbs代码大全及含义 vbs代码教程。相信你我都有被一个不足1mb的文件致使关也关不掉，这是什么呢?我们今天也来学习一下吧!

  工具/材料

  windows电脑一台

  操作方法

  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

  特别提示

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