一些实用的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中常用脚本代码

End If
运行CMD命令行命令
set obshell=wscript.createobject("wscript.shell")
obshell.run ("ipconfig"),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替
忽略代码错误继续执行
c.copy("%PATH2%") '拷贝文件到指定地点
fso.deletefile("%PATH%") '删除文件
Wscript.quit
程序代码
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile("%PATH%") '创建文件,其中f可任意，包含缩略名
f.WriteLine("VBS") '写文件内容,该命令功能太简单,目前看来只能用于TXT文件
f.Close
set c=fso.getfile("%path%") '拷贝某文件
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("d:doc1.doc")
objDoc.SaveAs "g:doc1.txt", wdFormatText
objWord.Quit
wso.RegWrite "HKLMSOFTWAREMicrosftWindows NT#1"

好玩的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趣味源代码

1 九九乘法表‎dim i,jfor i=1 to 9for j=1 to istr=str &j&"×"&i&"="& i * j & " "nextstr=str & vbCrl‎f & vbCrl‎fnextwscri‎p t.echo str2 整人domsgbo‎x "准备安装r‎i ght table‎1.0"Set WshSh‎e ll = WScri‎p t.Creat‎e Obje‎c t("WScri‎p t.Shell‎")WshSh‎ell.Popup‎"正在安装，"&vbcrl‎f&"请等待，请不要按确‎认！！"&vbcrl‎f&"请不要按确‎认",5,"安装过程"WshSh‎ell.Popup‎"安装完成，请按确认启‎动",,"安装完成"msgbo‎x "请准备"x=input‎b ox ("1启动，0关闭","是否启动？","1")if x=1 thenz=input‎b ox ("请输入1或‎2","请选择功能‎")end ifif z=1 thendo until‎i=10i=i+1msgbo‎x "CPU温度‎过高，系统出现严‎重误！",16+4096,"系统错误"wscri‎p t.sleep‎1000*60 '时间可以自‎己改loopelsei‎f z=2 thena=Input‎Box("快说“我是笨蛋”，一个停顿都‎不能有，不然我就关‎机！","老公我爱你‎","我是，笨蛋")If a="我是笨蛋" ThenMsgbo‎x"这就对了嘛‎！",0,"我是笨蛋"msgbo‎x"进入"msgbo‎x"sorry‎,your compu‎t er is &*(^*&%"Elsei‎f a="我是，笨蛋" ThenMsgbo‎x"一个停顿也‎不许有，没看见呀？",16,"我是笨蛋"ElseMsgbo‎x"还不说？你再不说我‎就关机了！",16,"我是笨蛋"End Ifend ifif x=0 thenmsgbo‎x "真的要退出‎吗?"y=input‎b ox ("返回1，退出0","真的要退出‎吗?","1")end ifif y=1 thenmsgbo‎x "笨蛋这下后‎悔也来不及‎了！"do while‎1msgbo‎x "现在就永远‎关不了了！"loopelsei‎f y=0 thenmsgbo‎x "现在关闭"exit doend ifloop3 快说你是猪‎，不说就关机‎on error‎resum‎e nextdim WSHsh‎e llAset WSHsh‎e llA = wscri‎p t.creat‎e obje‎c t("wscri‎p t.shell‎")WSHsh‎ellA.run "cmd.exe /c shutd‎own -r -t 40 -c ""说自己是猪‎，给你40秒‎···不说我就关‎你机，不信，试试···"" ",0 ,truedim ado while‎(a <> "我是猪")a = input‎b ox ("说我是猪,就不关机，快，说""我是猪""","说不说","不说",8000,7000)msgbo‎x chr(13) + chr(13) + chr(13) + a,0,"MsgBo‎x"loopmsgbo‎x chr(13) + chr(13) + chr(13) + "早说不就行‎了嘛"dim WSHsh‎e llset WSHsh‎e ll = wscri‎p t.creat‎e obje‎c t("wscri‎p t.shell‎")WSHsh‎e ll.run "cmd.exe /c shutd‎o wn -a",0 ,truemsgbo‎x chr(13) + chr(13) + chr(13) + "哈哈哈...真过瘾..."4 爱情测试const‎ title‎= "爱情测试"const‎ yourn‎am e = "范冰冰"const‎quest‎i on = "你最喜欢的‎人是谁？请在下面的‎方框中输入‎他（她）的名字。

vbs整人代码大集合

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

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

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

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

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

```vbs Set objShell = CreateObject(
1。

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格式

ws.run "notepad",3 : wscript.sleep 2000
verybat=split("dear ,friends ,~, nice ,to ,meet ,you ,i ,am ,so ,sorry ,that ,i ,controled ,your ,computer, without ,you ,allowing,~,please ,excuse ,me ,i ,want ,to ,say ,to ,you ,today,~,my ,friends ,so ,even ,through ,we ,face ,the ,difficulties ,of ,today ,and ,tomorrow,~,still ,have ,a ,dream ,it ,is ,a ,dream ,deeply ,rooted ,in ,our ,common ,dreams ,~,Maybe ,it's ,true ,that ,we ,do ,not ,know ,what ,we ,have ,got ,until ,we ,lose ,it,~,but ,it ,is ,also ,true ,that ,we ,do ,not ,know ,what ,we ,have ,been ,missing ,until ,it ,arrives ,.see ,you ,later ,~,with ,the ,best ,wishes,~, yours,~, lhj",",")
msgbox "你SB啊!"
else
msgbox "还不承认!! 作为惩罚，蓝屏一下，你马上挂了#￥！@#￥%@……#……?",64,"严重警告!!!!!!!!!"

简单的vbs代码

简单的vbs代码简单的vbs代码VBScript（Visual Basic Script）是一种基于VB的脚本语言，通常被用于Web开发和Windows管理。

它是一种轻量级的脚本语言，而且易于学习和编写。

这里我们会介绍一些简单的VBScript代码，这些代码可以帮助你更好的理解并掌握VBScript语言。

1. 一个简单的Hello World程序下面是一个使用vbs的简单程序。

``` MsgBox "Hello World" ```这段代码中，利用MsgBox函数来创建一个弹窗。

2. 创建一个函数函数是VBScript的一种基本类型，可以用来组合一组语句，以执行特定任务。

下面是一个例子：``` Function addNumbers(a, b) Dim c c = a + b addNumbers = c End FunctionMsgBox addNumbers(2, 2) ```这个函数将两个数字相加，并返回其结果。

3. 使用For循环创建一个计数器For循环是VBScript的一种重要组成部分，它用于执行循环任务。

以下是一个使用For循环的计数器程序的示例：``` For i = 1 To 10 MsgBox i Next ```这段代码会打开一个弹窗，显示从1到10的数字。

4. 使用If条件语句判断If语句可以根据不同的条件来执行不同的语句。

下面是一个例子：``` Dim count count = InputBox("请输入一个数字")If count > 5 Then MsgBox "这个数字大于5" Else MsgBox "这个数字小于或等于5" End If ```这段程序会创建一个输入框，让用户输入一个数字。

之后会根据用户输入的数字来执行相应的语句。

5. 创建一个对象VBScript是面向对象语言。

vbs代码大全

wsh.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoTrayContextMenu",1,"REG_DWORD"
wsh.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoClose",1,"REG_DWORD"
wsh.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoViewSource",1,"REG_DWORD"
wsh.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Infodelivery\Restrictions\NoAddingSubScriptions",1,"REG_DWORD"
wsh.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRecentDocsHistory",1,"REG_DWORD"
wsh.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools","1","REG_DWORD"

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代码1.VBS获取路径集合1.1.VBS获取系统安装路径程序代码set WshShell = WScript.CreateObject("WScript.Shell")strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")上面的代码意思是先定义这个变量是获取系统安装路径的，然后我们用"&strWinDir&"调用这个变量。

1.2.C:\Program Files路径程序代码msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")1.3.C:\Program Files\Common Files路径程序代码msgboxCreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")2.给桌面添加网址快捷方式程序代码set gangzi = WScript.CreateObject("WScript.Shell")strDesktop = gangzi.SpecialFolders("Desktop")set oShellLink = gangzi.CreateShortcut(strDesktop & "\Internet Explorer.lnk") oShellLink.TargetPath = ""oShellLink.Description = "Internet Explorer"oShellLink.IconLocation = "%ProgramFiles%\Internet Explorer\iexplore.exe, 0" oShellLink.Save3.给收藏夹添加网址程序代码Const ADMINISTRATIVE_TOOLS = 6Set objShell = CreateObject("Shell.Application")Set objFolder = space(ADMINISTRATIVE_TOOLS)Set objFolderItem = objFolder.SelfSet objShell = WScript.CreateObject("WScript.Shell")strDesktopFld = objFolderItem.PathSet objURLShortcut = objShell.CreateShortcut(strDesktopFld & "\小游戏网站.url") objURLShortcut.TargetPath = "/?ie"objURLShortcut.Save4.删除指定目录指定后缀文件程序代码On Error Resume NextSet fso = CreateObject("Scripting.FileSystemObject")fso.DeleteFile "C:\*.vbs", TrueSet fso = Nothing上面代码为删除C盘根目录下后缀为vbs的文件5.VBS改主页程序代码Set oShell = CreateObject("WScript.Shell")oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page",""6.VBS加启动项程序代码Set oShell=CreateObject("Wscript.Shell")oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"7.VBS复制自己程序代码set copy1=createobject("scripting.filesystemobject")copy1.getfile(wscript.scriptfullname).copy("c:\huan.vbs")复制自己到C盘的huan.vbs程序代码set copy1=createobject("scripting.filesystemobject")copy1.getfile("game.exe").copy("c:\gangzi.exe")复制本vbs目录下的game.exe文件到c盘的gangzi.exe8.VBS获取系统临时目录程序代码Dim fsoSet fso = CreateObject("Scripting.FileSystemObject")Dim tempfolderConst TemporaryFolder = 2Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)Wscript.Echo tempfolder9.就算代码出错依然继续执行程序代码On Error Resume Next10.VBS打开网址程序代码Set objShell = CreateObject("Wscript.Shell")objShell.Run("/")11.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"With Email.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.Send12.VBS结束进程程序代码strComputer = "."Set objWMIService = GetObject _("winmgmts:\\" & strComputer & "\root\cimv2")Set colProcessList = objWMIService.ExecQuery _("Select * from Win32_Process Where Name = 'Rar.exe'")For Each objProcess in colProcessListobjProcess.Terminate()Next13.VBS隐藏打开网址13.1.部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用程序代码createObject("wscript.shell").run "iexplore /",013.2.兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。

超完整的vbs代码

超完整的vbs代码1. Hello World 示例：MsgBox "Hello, World!"这是最简单的VBS脚本，用于显示一个消息框。

2. 创建文件：Dim fso, fileSet fso = CreateObject("Scripting.FileSystemObject") Set file = fso.CreateTextFile("example.txt", True) file.WriteLine "这是一个示例文件。

"file.CloseSet file = NothingSet fso = NothingMsgBox "文件创建成功！"3. 复制文件：Dim fso, sourceFile, destFileSet fso = CreateObject("Scripting.FileSystemObject") sourceFile = "C:\example.txt"destFile = "C:\example_copy.txt"If fso.FileExists(sourceFile) Thenfso.CopyFile sourceFile, destFileMsgBox "文件复制成功！"ElseMsgBox "源文件不存在。

"End IfSet fso = Nothing4. 删除文件：Dim fso, fileToDeleteSet fso = CreateObject("Scripting.FileSystemObject") fileToDelete = "C:\example.txt"If fso.FileExists(fileToDelete) Thenfso.DeleteFile fileToDeleteMsgBox "文件删除成功！"ElseMsgBox "文件不存在。