当前位置: 首页 > 图文教程 > 脚本技术 > VBScript > Dynamic Activity Window动态活动窗口vbs

VBScript
VBS中SendKeys的基本应用
VBScript教程 第十四课在VBScript中使用对象
VBScript教程 第十三课 VBScript与窗体
VBScript教程 第十二课VBScript页面的简单样例
VBScript教程 第十一课深入VBScript
VBScript教程 第十课 VBScript编码约定
VBScript教程 第九课VBScript过程
VBScript教程 第八课 使用循环语句
VBScript教程 第七课使用条件语句
VBScript教程 第六课VBScript运算符
VBscript教程 第五课 VBScript常数
VBScript教程 第四课VBScript变量
VBScript教程 第三课VBScript数据类型
VBScript教程 第二课在HTML页面中添加VBscript代码
VBScript教程 第一课什么是VBScript
VBScript的入门学习资料
VBScript语法速查及实例说明
MsgBox函数语言参考
VBS教程：正则表达式简介 -后向引用
VBS教程：正则表达式简介 -选择与编组

No. « 1 2 3 4 »

技术文章搜索

关键字

VBScript 中的 Dynamic Activity Window动态活动窗口vbs

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-09-11   浏览: 77 ::
收藏到网摘: n/a

复制代码 代码如下:

Option Explicit
Dim oBar
Set oBar = New ProgressBar
oBar.StartBar "This is a test."
WScript.Sleep (3000)
oBar.SetLine "So is this."
WScript.Sleep (3000)
oBar.CloseBar
Class ProgressBar
Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile, sInitialTempBuild
Public Sub StartBar(sMessageToDisplay)
Dim sInitialTemp, i
ExecuteGlobal "Dim oShell, oFSO, oEnv"
Set oShell = CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEnv = oShell.Environment("Process")
For i = 1 To 16
sInitialTempBuild = sInitialTempBuild & Chr(fRand(97,122))
Next
sInitialTemp = oFSO.GetDriveName(oEnv("TEMP")) & "\" & sInitialTempBuild & "\" & oFSO.GetFileName(fGetTempName)
sProgressBarHTAFile = Left(sInitialTemp,(Len(sInitialTemp)-4)) & ".hta"
sProgressBarRunFile = Left(sProgressBarHTAFile, Len(sProgressBarHTAFile)-4) & ".run"
sProgressBarSleepFile = Left(sProgressBarHTAFile, Len(sProgressBarHTAFile)-4) & "sleep.vbs"
Set oBarCat = CreateObject("Scripting.Dictionary")
oBarCat.Add oBarCat.Count, "<html>"
oBarCat.Add oBarCat.Count, "<head>"
oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>"
oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
oBarCat.Add oBarCat.Count, " ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SCROLL=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SINGLEINSTANCE=" & Chr(34) & "YES" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " CAPTION=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " BORDER=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " BORDERSTYLE=" & Chr(34) & "NORMAL" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SYSMENU=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SHOWINTASKBAR=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " />"
oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2, sStatusBarAsciiText, sPID, iCID, sStatusMsg"
oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ":iCID = 10"
oBarCat.Add oBarCat.Count, "Sub Window_Onload"
oBarCat.Add oBarCat.Count, " window.resizeTo 320,250"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " iTimer1 = window.setInterval(" & Chr(34) & "Do_Refresh" & Chr(34) & ",175)"
oBarCat.Add oBarCat.Count, " iTimer2 = window.setInterval(" & Chr(34) & "Do_Nothing" & Chr(34) & ",500)"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Nothing"
oBarCat.Add oBarCat.Count, " If CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ") Then"
oBarCat.Add oBarCat.Count, " Dim oWMIService, cItems, oItem"
oBarCat.Add oBarCat.Count, " Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " For Each oItem in cItems"
oBarCat.Add oBarCat.Count, " If oItem.CommandLine = document.Location.pathname Then"
oBarCat.Add oBarCat.Count, " oShell.AppActivate oItem.Handle"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, " Next"
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", True "
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer1)"
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer2)"
oBarCat.Add oBarCat.Count, " self.Close"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Refresh"
oBarCat.Add oBarCat.Count, " Select Case iCID"
oBarCat.Add oBarCat.Count, " Case 10"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText =" & Chr(34) & "ooooo" & Chr(34) & ":iCID = 0"
oBarCat.Add oBarCat.Count, " Case 0"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " Case 1"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "ooono" & Chr(34) & ":iCID = 2"
oBarCat.Add oBarCat.Count, " Case 2"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 3"
oBarCat.Add oBarCat.Count, " Case 3"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "onooo" & Chr(34) & ":iCID = 4"
oBarCat.Add oBarCat.Count, " Case 4"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "noooo" & Chr(34) & ":iCID = 5"
oBarCat.Add oBarCat.Count, " Case 5"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "onooo" & Chr(34) & ":iCID = 6"
oBarCat.Add oBarCat.Count, " Case 6"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 7"
oBarCat.Add oBarCat.Count, " Case 7"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "ooono" & Chr(34) & ":iCID = 8"
oBarCat.Add oBarCat.Count, " Case 8"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) & "oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " End Select "
oBarCat.Add oBarCat.Count, " Stats.innerHTML = sStatusBarAsciiText"
oBarCat.Add oBarCat.Count, " On Error Resume Next"
oBarCat.Add oBarCat.Count, " oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " iRegErr = Err.Number"
oBarCat.Add oBarCat.Count, " On Error Goto 0"
oBarCat.Add oBarCat.Count, " If iRegErr = 0 then"
oBarCat.Add oBarCat.Count, " sStatusMsg = Replace(oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & "), VbCrLf," & Chr(34) & "<br>" & Chr(34) & ") "
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " End if"
oBarCat.Add oBarCat.Count, " MyMsg.innerHTML = sStatusMsg"
oBarCat.Add oBarCat.Count, " End Sub"
oBarCat.Add oBarCat.Count, "</SCRIPT>"
oBarCat.Add oBarCat.Count, "<style>"
oBarCat.Add oBarCat.Count, "body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}"
oBarCat.Add oBarCat.Count, "body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#9999FF', EndColorStr='#FFFFFF')}"
oBarCat.Add oBarCat.Count, ".pix {width: 1px; height 1px;}"
oBarCat.Add oBarCat.Count, "</style>"
oBarCat.Add oBarCat.Count, "</head>"
oBarCat.Add oBarCat.Count, "<body>"
oBarCat.Add oBarCat.Count, "<center>"
oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">"
oBarCat.Add oBarCat.Count, " <tr><td>"
oBarCat.Add oBarCat.Count, " <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>"
oBarCat.Add oBarCat.Count, " <br><center>"
oBarCat.Add oBarCat.Count, " <span id= " & Chr(34) & "Stats" & Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></span>"
oBarCat.Add oBarCat.Count, " </center><br><br>"
oBarCat.Add oBarCat.Count, " </fieldset>"
oBarCat.Add oBarCat.Count, " </td></tr>"
oBarCat.Add oBarCat.Count, "</table>"
oBarCat.Add oBarCat.Count, "<span id= " & Chr(34) & "MyMsg" & Chr(34) & " style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
oBarCat.Add oBarCat.Count, "</body>"
oBarCat.Add oBarCat.Count, "</html>"
subWriteFile sProgressBarHTAFile, Join(oBarCat.Items,VbCrLf)
oShell.RegWrite "HKLM\SYSTEM\ProgressBar\MSG", sMessageToDisplay, "REG_SZ"
oShell.Run sProgressBarHTAFile, 1, False
End Sub
Public Sub CloseBar()
fKillFile sProgressBarRunFile
Dim sProgressBarHTAFileKiller
subKillRegKey "HKLM\SYSTEM\ProgressBar","DELETE"
sProgressBarHTAFileKiller = oFSO.GetDriveName(oEnv("TEMP")) & "\htakiller.vbs"
subWriteFile sProgressBarHTAFileKiller, "On Error Resume Next"
subWriteFile sProgressBarHTAFileKiller, "wscript.sleep(10000)"
subWriteFile sProgressBarHTAFileKiller, "Set oFSO = CreateObject(""Scripting.FileSystemObject"")"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFile & Chr(34) & ", True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) & oFSO.GetDriveName(oEnv("TEMP")) & "\" & sInitialTempBuild & Chr(34) & ", True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True"
oShell.Run "%comspec% /c cscript.exe " & sProgressBarHTAFileKiller, 0, False
End Sub
Public Sub SetLine(sNewText)
oShell.RegWrite "HKLM\SYSTEM\ProgressBar\MSG", sNewText, "REG_SZ"
End Sub
Private Function fGetTempName()
Dim iFilenameCharacters, iHighestASCiiValue, iLowestASCiiValue
Dim iCharASCiiValue, sTmpFileName, oTempNameDic
Set oTempNameDic = CreateObject("Scripting.Dictionary")
iFilenameCharacters = 8
iHighestASCiiValue = 126
iLowestASCiiValue = 46
sTmpFileName = ""
Randomize
Do
iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue)
Select Case True
Case iCharASCiiValue = 47
Case iCharASCiiValue > 57 And iCharASCiiValue < 95
Case iCharASCiiValue = 96
Case iCharASCiiValue > 122 And iCharASCiiValue < 126
Case Else
oTempNameDic.Add oTempNameDic.Count,Chr(iCharASCiiValue)
End Select
Loop While oTempNameDic.Count < iFilenameCharacters
fGetTempName = oEnv("TEMP") & "\" & Join(oTempNameDic.Items,"") & ".tmp"
oTempNameDic.RemoveAll
End Function
Private Function fKillFile(sFileToKill)
Dim iErr, sErr
Select Case True
Case InStr(sFileToKill, "*") <> 0
If oFSO.FolderExists(oFSO.GetParentFolderName(sFileToKill)) Then
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
If iErr = 53 Then iErr = 0
End If
Case oFSO.FileExists(sFileToKill)
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
End Select
Select Case iErr
Case 0
fKillFile = 0
Case Else
fKillFile = sErr
End Select
End Function
Private Function fRand(iLowerLimit,iUpperLimit)
ExecuteGlobal "Dim bRandomized"
If bRandomized <> True Then Randomize
bRandomized = True
fRand = Int((iUpperLimit - iLowerLimit + 1)*Rnd() + iLowerLimit)
End Function
Private Sub subWriteFile(sFileToWrite, sTextToWrite)
Dim oFileToWrite
subCreateFile sFileToWrite
Set oFileToWrite = oFSO.OpenTextFile(sFileToWrite,8)
oFileToWrite.WriteLine sTextToWrite
oFileToWrite.Close
End Sub
Private Sub subCreateFile(sFileToCreate)
subCreateFolder oFSO.GetParentFolderName(sFileToCreate)
If Not oFSO.FileExists(sFileToCreate) Then oFSO.CreateTextFile(sFileToCreate)
End Sub
Private Sub subCreateFolder(sFolderPathToCreate)
If Trim(sFolderPathToCreate) <> "" Then
If oFSO.FolderExists(sFolderPathToCreate) Then
Exit Sub
Else
subCreateFolder(oFSO.GetParentFolderName(sFolderPathToCreate))
End If
oFSO.CreateFolder(sFolderPathToCreate)
End If
End Sub
Private Sub subKillRegKey(ByVal sKeyToDelete, sDeleteConfirmation)
Dim aSubKeys, sSubKey, iSubkeyCheck, sKeyToKill, iElement
Dim aKeyPathSubSection, hKeyRoot, oWMIReg, sKeyRoot
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
If sDeleteConfirmation <> "DELETE" Then Exit Sub
aKeyPathSubSection = Split(sKeyToDelete, "\")
Select Case UCase(aKeyPathSubSection(0))
Case "HKEY_CLASSES_ROOT", "HKCR"
hKeyRoot = HKEY_CLASSES_ROOT
sKeyRoot = "HKEY_CLASSES_ROOT"
Case "HKEY_CURRENT_USER", "HKCU"
hKeyRoot = HKEY_CURRENT_USER
sKeyRoot = "HKEY_CURRENT_USER"
Case "HKEY_LOCAL_MACHINE", "HKLM"
hKeyRoot = HKEY_LOCAL_MACHINE
sKeyRoot = "HKEY_LOCAL_MACHINE"
Case "HKEY_USERS", "HKU"
hKeyRoot = HKEY_USERS
sKeyRoot = "HKEY_USERS"
Case "HKEY_CURRENT_CONFIG"
hKeyRoot = HKEY_CURRENT_CONFIG
sKeyRoot = "HKEY_CURRENT_CONFIG"
Case Else
subKillRegKey = 1
Exit Sub
End Select
For iElement = 1 To UBound(aKeyPathSubSection)
sKeyToKill = sKeyToKill & "\" & aKeyPathSubSection(iElement)
Next
If Left(sKeyToKill,1) = "\" Then sKeyToKill = Right(sKeyToKill, Len(sKeyToKill)-1)
On Error Resume Next
Set oWMIReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
iSubkeyCheck = oWMIReg.EnumKey(hKeyRoot, sKeyToKill, aSubKeys)
If iSubkeyCheck = 0 And IsArray(aSubKeys) Then
For Each sSubKey In aSubKeys
If Err.Number <> 0 Then
Err.Clear
Exit Sub
End If
subKillRegKey sKeyRoot & "\" & sKeyToKill & "\" & sSubKey, "DELETE"
Next
End If
oWMIReg.DeleteKey hKeyRoot, sKeyToKill
End Sub
End Class