每日更新亚洲超清精品,乱码一线二线三线新区破解欧

當(dāng)前位置：首頁 > 范文|應(yīng)用文 > IT技術(shù)專欄 > 腳本欄目

Dynamic Activity Window動態(tài)活動窗口vbs

來源：易賢網(wǎng) 閱讀：1123 次日期：2016-07-20 14:21:41

溫馨提示：易賢網(wǎng)小編為您整理了“Dynamic Activity Window動態(tài)活動窗口vbs”,方便廣大網(wǎng)友查閱！

代碼如下:

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))

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

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)

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"

End If

oWMIReg.DeleteKey hKeyRoot, sKeyToKill

End Sub

End Class

上一篇：可以查詢系統(tǒng)用戶名sid的vbs

下一篇：一個查看局域網(wǎng)在線IP的vbs腳本

易賢網(wǎng)手機網(wǎng)站地址：Dynamic Activity Window動態(tài)活動窗口vbs

由于各方面情況的不斷調(diào)整與變化，易賢網(wǎng)提供的所有考試信息和咨詢回復(fù)僅供參考，敬請考生以權(quán)威部門公布的正式信息和咨詢?yōu)闇?zhǔn)！

相關(guān)閱讀腳本欄目

Bottle框架中的裝飾器類和描述符應(yīng)用詳解10月30日

Python探索之SocketServer詳解10月30日

Python探索之實現(xiàn)一個簡單的HTTP服務(wù)器10月30日

python探索之BaseHTTPServer-實現(xiàn)Web服務(wù)器介紹10月30日

13個最常用的Python深度學(xué)習(xí)庫介紹10月30日

深入理解Python中的*重復(fù)運算符10月30日

python logging日志模塊詳解10月30日

System表空間不足的報警問題淺析10月22日

Android開發(fā)自定義TextView省略號樣式的方法10月22日

MySQL 清除表空間碎片的實例詳解10月22日

Ubuntu下MySQL安裝及配置遠程登錄教程10月22日

Python 2.x如何設(shè)置命令執(zhí)行的超時時間實例10月22日

windows 64位下redis安裝教程10月22日

Android 自定義 HorizontalScrollView 打造多圖片OOM 的橫向滑動效果10月22日

淺談Node Inspector 代理實現(xiàn)10月22日

java web開發(fā)之購物車功能實現(xiàn)示例代碼10月22日

Android開發(fā)中GridView用法示例10月22日

Django ORM框架的定時任務(wù)如何使用詳解10月22日

SpringMail使用過程中的報錯解決辦法10月22日

Android 使用自定義RecyclerView控件實現(xiàn)Gallery效果10月22日

易賢網(wǎng)移動網(wǎng)站

2025國考·省考課程試聽報名

報班類型
姓名
手機號
驗證碼