网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料：

　

标题 Dynamic Activity Window动态活动窗口vbs
内容
    代码如下:
    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><legendcenter" & 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) & "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) & "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
随便看

　

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/16 15:16:33