复制代码 代码如下:
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
华山资源网 Design By www.eoogi.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
华山资源网 Design By www.eoogi.com

稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!

昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。

这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。

而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?