vbs代码,纯自己采集,绝对良心!

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

工具/材料

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 “HKCUControl PanelDesktopwallpaper”,”C:XXX.bmp”,”REG_SZ”
    ws.run “RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters”

  • 14

    禁用任务管理器

    Set WshShell = CreateObject(“Wscript.Shell”)
    WshShell.RegWrite “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableTaskMgr”,1,”REG_DWORD”

  • 15

    禁用注册表编辑器

    WshShell.RegWrite “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableRegistryTools”,1,”REG_DWORD”

  • 16

    取消禁用任务管理器

    Dim WshShell
    Set WshShell = CreateObject(“Wscript.Shell”)
    WshShell.RegWrite “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableTaskMgr”,0,”REG_DWORD”
    Wscript.Echo “恢复成功!”
    Wscript.Quit

  • 17

    取消禁用注册表编辑器

    Dim WshShell
    Set WshShell = CreateObject(“Wscript.Shell”)
    WshShell.RegWrite “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableRegistryTools”,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:UsersAdministratorDesktopwhat 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

特别提示

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

未经允许不得转载:特殊符号大全 » vbs代码,纯自己采集,绝对良心!