中国DOS联盟

' vvv Trace的flag参数
Const WAIT_ALL_CLOSE = 1 ' 等待所有指定窗口关闭
Const WAIT_ONE_OPEN = 2 ' 等待指定的任意一个窗口打开并显示
' 以上必选
Const KEYS_NORMAL = 4 ' 正常发送按键
Const KEYS_AS_COMMAND = 8 ' 将keys参数作为命令,用shell.run的方式执行(不显示)
Const KEYS_AS_STATEMENTS = 16 ' 使用Execute执行keys的内容
Const KEYS_AS_TEXT = 32 ' 作为字符串,通过剪贴版,复制到程序中
Const SILENT_MODE = 64 ' 安静模式,不弹出提示框
' ^^^ Trace的flag参数

' vvv Trace的flag参数
Const NORMAL = 0 ' 正常模式
Const SILENT = 1 ' 安静模式,不弹出提示框
' ^^^ Wait的flag参数

' 一个用于自动控制安装程序进行一键式/批量安装的类
' 作者:sonic_andy 创建日期:2007-8-19
' 使用方法:
Dim obj '声明一个变量
Set obj = new CAutoTrace '创建一个CAutoTrace类型的对象
Call obj.Trace(Array("a","b"),Array("记事本","Hello"),5,WAIT_ONE_OPEN+KEYS_NORMAL) ' 调用obj对象的方法/过程
' ...
Set obj = Nothing ' 释放对象
Class CAutoTrace
Private mShell ' shell对象
Private mIE ' ie对象
Private mWnd ' ie对象的window窗口
Private mCount ' 总的等待次数
' 获得shell对象
Property Get Shell()
Set Shell = mShell
End Property
' 获得粘贴板对象
Property Get ClipBoard()
Set ClipBoard = mWnd.clipboarddata
End Property
' 获得ie窗口对象
Property Get IEWnd()
Set IEWnd = wnd
End Property
' 获得ie对象
Property Get IE()
Set IE = mIE
End Property
' 类的初始化函数
Sub Class_Initialize()
Set mShell = CreateObject("wscript.Shell")
Set mIE = CreateObject("internetexplorer.application")
Call mIE.navigate("about:blank")
Set mWnd = mIE.Document.parentwindow
mCount = 0
End Sub
' 类的销毁函数
Sub Class_Terminate()
Call mIE.quit()
Set mIE = Nothing
Set mShell = Nothing
End Sub
' 自动跟踪函数
' 本函数会自动发送命令,并等待窗口显示/消失,调用过程中会有提示
' 简单来说就是先向程序发送一系列的按键,然后等待某个窗口显示/消失
' 并且在等待的过程中会有提示.
' 参数keys 类型: 字符串数组 表示需要发送的按键,可以包含多个按键
' {ENTER}表示回车 %表示ALT ^表示CTRL +表示SHIFT
' {F1}表示F1,a表示字符'a',以此类推
' 参数titles 类型: 字符串数组 指定窗口的名称,可以包含多个名称
' 参数sec 类型: 整型变量 表示每次检测间隔的时间
' 参数flag 类型: 整型变量 制定跟踪操作的流程,说明见文件头
' 使用方法: Call obj.Trace(Array("a","b"),Array("记事本","Hello"),5,WAIT_ONE_OPEN)
' 以上语句实现的功能: 不断向当前激活的窗口中发送a,b字符,
' 一直到出现"记事本"或者"Hello"标题的界面
Public Sub Trace(keys,titles,sec,flag)
Dim strkey,strtitle,strflag,strflag1,i,j
Do
' 增加计数
mCount = mCount + 1
' 根据flag处理keys参数
strkey = ""
For i=0 To UBound(keys)
If flag And KEYS_NORMAL Then ' 正常发送按键
Call mShell.sendkeys(keys(i),true)
strflag1 = "已发送按键: " & vbcrlf
strkey = strkey & vbcrlf & """" & keys(i) & """ "
ElseIf flag And KEYS_AS_COMMAND Then ' 作为命令发送
Call mShell.run(keys(i),0)
strflag1 = "已执行以下命令: "
strkey = vbcrlf & strkey & keys(i)
ElseIf flag And KEYS_AS_STATEMENTS Then ' 作为语句执行
execute keys(i)
strflag1 = "已执行以下语句: "
strkey = vbcrlf & strkey & keys(i)
ElseIf flag And KEYS_AS_TEXT Then ' 作为字符串发送
Dim temp
temp = mWnd.clipboarddata.getdata("text")
Call mWnd.clipboarddata.setdata("text",keys(i))
Call mShell.sendkeys("^v",true)
If Not IsNull(temp) Then Call mWnd.clipboarddata.setdata("text",temp)
strflag1 = "已发送以下文本: "
strkey = vbcrlf & strkey & keys(i)
End If
Next
' 根据flag处理显示的内容
If flag And WAIT_ONE_OPEN Then
strflag = "之一显示:"
ElseIf flag And WAIT_ALL_CLOSE Then
strflag = "全部关闭:"
End If
' 窗口标题转换为每行一个的字符串用于显示
strtitle = Join(titles,vbcrlf)
' 显示提示内容,sec秒后自动关闭
If flag And SILENT_MODE Then
Call wscript.sleep(sec*1000)
Else
Select Case mShell.popup(strflag1 & vbcrlf & _
"------------" & _
strkey & vbcrlf & _
"------------" & vbcrlf & _
"等待以下窗口" & strflag & vbcrlf & _
"------------" & vbcrlf & _
strtitle & vbcrlf & _
"------------" & vbcrlf & _
"需等待时间: " & sec & vbcrlf & _
"总等待次数: " & mCount & vbcrlf & _
"立即跳过,退出脚本.", _
sec,"等待",1)
Case 1: Exit Do ' 确定
Case 2: Call Wscript.quit() ' 取消
End Select
End If
' 此处判断是否达到了返回的条件
' 根据flag来确定判断方式
j = 0
For i=0 To UBound(titles)
If flag And WAIT_ONE_OPEN Then ' 等待任意窗口显示
If mShell.appactivate(titles(i)) Then Exit Sub
ElseIf flag And WAIT_ALL_CLOSE Then ' 等待所有窗口关闭
If Not mShell.appactivate(titles(i)) Then j = j+1
If j=UBound(titles)+1 Then Exit Sub
End If
Next
Loop While True
End Sub

' 等待窗口函数
' 本函数等待窗口显示,过程中会有提示
' 返回值 类型:布尔值 如果超时则返回false,检测到就返回true
' 参数title 类型:字符串 需要等待的窗口标题
' 参数sec 类型:(长)整型 每次检测的间隔时间(秒)
' 参数timeout 类型:(长)整型 等待多长时间超时返回(秒)
' 参数flag 类型:(长)整型 模式标志,可以控制函数的执行流程,说明见文件头部
Public Function Wait(title,sec,timeout,flag)
Dim subcount
subcount = 0
Do
subcount = subcount + 1
If subcount*sec > timeout Then ' 超时
Wait = False
Exit Function
End If
If flag And SILENT Then
Call wscript.sleep(sec * 1000)
Else
Select Case mShell.popup("等待以下窗口显示" & vbcrlf & _
title & vbcrlf & _
"重试间隔: " & sec & " 秒 超时限制: " & timeout & " 秒" & vbcrlf & _
"已经等待: " & subcount*sec & " 秒" & vbcrlf & _
"立即检测,退出脚本.", _
sec,"等待",1+64)
Case 2: Call Wscript.quit() ' 取消
End Select
End If
Loop While Not mShell.appactivate(title)
Wait = True
End Function
End Class

[ Last edited by sonicandy on 2007-9-2 at 09:40 PM ]

哥们，能否说说用途，能实现 软件自动安装 ?

运行有错误...