VBScript脚本进度通知

时间：2013-08-13 17:59:39

标签： vbscript

我是一个VBScript新手，编写一个将解析大型输入文件的脚本，可能需要几分钟的运行时间才能完成处理。在这漫长的处理时间内，我需要一种方法来提醒用户脚本正在运行而没有错误。我的第一个想法是为处理的每1000条记录提供一个msgbox（例如“脚本到目前为止已经成功处理了1000条记录。”）还没有完全破解编码增量器的正确方法，该增量器将有条件地每隔N条记录一次msgbox（或者确定是否有更好的方法来实现我的最终目标）。有什么想法吗？

7 个答案:

答案 0 :(得分：7)

如果您在控制台窗口中运行脚本（通过cscript.exe），那么您可以直接在窗口/输出中显示一个虚拟进度条，如下所示：

console window progress bar

首先在VBS文件中声明以下函数：

Function printi(txt)
    WScript.StdOut.Write txt
End Function    

Function printr(txt)
    back(Len(txt))
    printi txt
End Function

Function back(n)
    Dim i
    For i = 1 To n
        printi chr(08)
    Next
End Function   

Function percent(x, y, d)
    percent = FormatNumber((x / y) * 100, d) & "%"
End Function

Function progress(x, y)
    Dim intLen, strPer, intPer, intProg, intCont
    intLen  = 22
    strPer  = percent(x, y, 1)
    intPer  = FormatNumber(Replace(strPer, "%", ""), 0)
    intProg = intLen * (intPer / 100)
    intCont = intLen - intProg
    printr String(intProg, ChrW(9608)) & String(intCont, ChrW(9618)) & " " & strPer
End Function

Function ForceConsole()
    Set oWSH = CreateObject("WScript.Shell")
    vbsInterpreter = "cscript.exe"

    If InStr(LCase(WScript.FullName), vbsInterpreter) = 0 Then
        oWSH.Run vbsInterpreter & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34)
        WScript.Quit
    End If
End Function

然后在脚本的顶部使用以下示例：

ForceConsole()

For i = 1 To 100
    progress(i, 100)
Next

答案 1 :(得分：4)

除非您想要惹恼用户，否则不要使用弹出消息。将代码包裹在HTA中，显示this page中的进度指示器，例如：

<html>
<head>
<title>Sample</title>
<hta:application
  applicationname="Sample"
  scroll="no"
  singleinstance="yes"
  windowstate="normal"
>

<script language="vbscript">
Sub Window_onLoad
  'your code here
End Sub
</script>

<style type="text/css">
* {
  font-size: 1px;
  margin: 1px;
}
div {
  position: absolute;
  left: 40%;
  top: 50%;
}
marquee {
  border: 1px solid;
  height: 15px;
  width: 200px;
}
marquee span {
  height: 11px;
  width: 8px;
  background: Highlight;
  float: left;
}
.handle-0 { filter: alpha(opacity=20); -moz-opacity: 0.20; }
.handle-1 { filter: alpha(opacity=40); -moz-opacity: 0.40; }
.handle-2 { filter: alpha(opacity=60); -moz-opacity: 0.6; }
.handle-3 { filter: alpha(opacity=80); -moz-opacity: 0.8; }
.handle-4 { filter: alpha(opacity=100); -moz-opacity: 1; }
</style>
</head>

<body>
<div>
<marquee direction="right" scrollamount="8" scrolldelay="100">
  <span class="handle-0"></span>
  <span class="handle-1"></span>
  <span class="handle-2"></span>
  <span class="handle-3"></span>
  <span class="handle-4"></span>
</marquee>
</div>
</body>
</html>

如果您想提供更多动态信息，您可以将例如这样的段落添加到正文中：

</div>
<p id="sline" style="visibility:hidden;">Processed 
<span id="rcount"></span>&nbsp;Records.</p>
</body>
</html>

并每1000条记录更新一次：

...
If numRows Mod 1000 = 0 Then
  If sline.style.visibility = "hidden" Then sline.style.visibility = "visible"
  rcount.innerText = numRows
End If
...

答案 2 :(得分：2)

在这种情况下，我想使用WshShell.Popup方法提供有关当前进度的信息。

这是一个例子：

Dim WshShell, i
Set WshShell = CreateObject("WScript.Shell")

For i = 1 To 500
    'Do Something
    If i Mod 100 = 0 Then 'inform for every 100 process 
        WshShell.Popup i & " items processed", 1, "Progress" ' show message box for a second and close
    End If
Next

答案 3 :(得分：1)

一个 HTML.HTA 文件，类似于下面使用的文件（由 VBS 脚本在临时目录中创建并启动）可用于通过使用 "g " 字符。

enter image description here

HTML.HTA 从临时文本文件中动态读取，从第一行获取提示，从第二行获取进度条的长度。 HTML 转义序列可以添加到这两行。

Option Explicit

Dim fso,wsh,temppath,tempname,temphta,fhta,z,result,info,progress,aFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = wscript.CreateObject("wscript.Shell")

temppath = fso.GetSpecialFolder(2).ShortPath & "\"
tempname = fso.GetTempName
temphta = tempname & ".hta"

Call CreateHTAFile

'CREATE THE INFO FILE
'********************
Set fhta = fso.OpenTextFile(temppath & tempname,2,True)
    fhta.WriteLine "<i>Loading..."
    fhta.WriteLine "g"
    fhta.Close

'START THE HTML.HTA
'******************
wsh.run (temppath & temphta),0,false


'PUT YOUR PROCESSES HERE THAT UPDATE THE PROGRESS BAR VIA THE UPDATE SUB
'***********************************************************************
Randomize

for z= 1 to 20
    Update "<i>Loading files...",replace(space(z), " ", "g")
    wscript.sleep(int(rnd*500) + 1)
next

for z= 1 to 20
    Update "<i>Checking disks...",replace(space(z), " ", "g")
    wscript.sleep(int(rnd*500) + 1)
next

for z= 1 to 20
    Update "<i>Looking at pictures of your wife!", "<b><font style=""color:yellow; font-family:Wingdings;"">" & replace(space(z), " ", "J")
    wscript.sleep(int(rnd*500) + 1)
next


'KILL THE HTML SESSION BY GIVING IT A SINGLE "X"
'***********************************************
Update "x",""


'TIDY-UP
'*******
do while fso.FileExists(temppath & temphta)
    Set aFile = fso.GetFile(temppath & temphta)
    aFile.Delete
loop

wscript.sleep(200)

do while fso.FileExists(temppath & tempname)
    Set aFile = fso.GetFile(temppath & tempname)
    aFile.Delete
loop


wscript.quit



'***********************************
Sub Update(info,progress)

    Set fhta = fso.OpenTextFile(temppath & tempname,2)
        fhta.WriteLine info
        fhta.WriteLine progress
        fhta.Close
End Sub

'***********************************
Sub CreateHTAFile

    Set fhta = fso.OpenTextFile(temppath & temphta,2,True)

    fhta.WriteLine "<html>"
    fhta.WriteLine "<body bgcolor=red style=""overflow:hidden;"">"
    fhta.WriteLine "<div style=""color:aqua; font-family:Arial;""  id=""info""></div>"
    fhta.WriteLine "<div style=""color:yellow; font-family:Webdings;""  id=""progressbar""></div>"
    fhta.WriteLine ""
    fhta.WriteLine "<script language=""VBScript"">"
    fhta.WriteLine ""
    fhta.WriteLine "Sub Update"
    fhta.WriteLine ""
    fhta.WriteLine "    On Error Resume Next"
    fhta.WriteLine ""
    fhta.WriteLine "    Dim objFSO, infoFile, progressbarFile"
    fhta.WriteLine ""
    fhta.WriteLine "    Set objFSO = CreateObject(""Scripting.FileSystemObject"")"
    fhta.WriteLine ""
    fhta.WriteLine "    Set infoFile = objFSO.OpenTextFile( """ & temppath & tempname & """,1,1)"
    fhta.WriteLine ""
    fhta.WriteLine "    document.getElementById(""info"").innerHTML = infoFile.ReadLine"
    fhta.WriteLine "    document.getElementById(""progressbar"").innerHTML = infoFile.ReadLine"
    fhta.WriteLine ""
    fhta.WriteLine "    width = 420 : height = 80"
    fhta.WriteLine "    window.resizeTo width, height"
    fhta.WriteLine "    window.moveTo screen.availWidth\2 - width\2, screen.availHeight\2 - height\2"
    fhta.WriteLine ""
    fhta.WriteLine "    if LCase(document.getElementById(""info"").innerHTML) =""x"" then"
    fhta.WriteLine "        Window.Close"
    fhta.WriteLine "    end if"
    fhta.WriteLine ""
    fhta.WriteLine "    window.setTimeout ""Update()"", 100, ""VBScript"""
    fhta.WriteLine ""
    fhta.WriteLine "    If Err.Number <> 0 Then"
    fhta.WriteLine "        Window.Close"
    fhta.WriteLine "    End If"
    fhta.WriteLine ""
    fhta.WriteLine "End Sub"
    fhta.WriteLine ""
    fhta.WriteLine "Sub Window_OnLoad"
    fhta.WriteLine "    window.resizeTo 0, 0"
    fhta.WriteLine "    window.setTimeout ""Update()"", 100, ""VBScript"""
    fhta.WriteLine "End Sub"
    fhta.WriteLine ""
    fhta.WriteLine "</script>"
    fhta.WriteLine ""
    fhta.WriteLine "<hta:application id=""oHTA"""
    fhta.WriteLine "        border=""none"""
    fhta.WriteLine "        innerborder=""yes"""
    fhta.WriteLine "        caption=""no"""
    fhta.WriteLine "        sysmenu=""no"""
    fhta.WriteLine "        maximizebutton=""no"""
    fhta.WriteLine "        minimizebutton=""no"""
    fhta.WriteLine "        scroll=""no"""
    fhta.WriteLine "        scrollflat=""yes"""
    fhta.WriteLine "        singleinstance=""yes"""
    fhta.WriteLine "        showintaskbar=""no"""
    fhta.WriteLine "        contextmenu=""no"""
    fhta.WriteLine "        selection=""no"""
    fhta.WriteLine "/>"
    fhta.WriteLine "</html>"

    fhta.close

End Sub
'***********************************

但是，我通常使用 HTML-HTA 来使用这个 base64 编码的 gif 显示菊花轮时钟：

Daisy-wheel.gif

Option Explicit

Dim fso,wsh,temphtml,temppath,fhta,objWMIService,objProcess,strComputer,colProcesses
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = wscript.CreateObject("wscript.Shell")

Call Clock

    wscript.sleep(5000) '...REPLACE THIS WITH YOUR LENGTHY PROCESS

Call KillClock(temphtml)

wscript.quit

'***********************************
Sub Clock
    temppath = fso.GetSpecialFolder(2).ShortPath & "\"
    temphtml = fso.GetTempName & ".hta"
    Set fhta = fso.OpenTextFile(temppath & temphtml,2,True)

    Call CreateHTA
    wsh.run (temppath & temphtml),0,false
End Sub
'***********************************
Sub KillClock(FileName)
    On Error Resume Next
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
    For Each objProcess in colProcesses
        If InStr(objProcess.CommandLine,FileName) > 0 Then
                objProcess.Terminate(0) 
        End If
    Next

    wsh.run ("cmd /c del " & temppath & temphtml),0,false

End Sub
'***********************************
Sub CreateHTA
    fhta.WriteLine "<html>"
    fhta.WriteLine "<script language=""VBScript"">"
    fhta.WriteLine "window.resizeTo 0, 0"
    fhta.WriteLine "Sub Window_OnLoad"
    fhta.WriteLine "width = 75 : height = 75"
    fhta.WriteLine "window.resizeTo width, height"
    fhta.WriteLine "window.moveTo screen.availWidth\2 - width\2, screen.availHeight\2 - height\2"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.WriteLine "<hta:application id=""oHTA""" 
    fhta.WriteLine "border=""none""" 
    fhta.WriteLine "caption=""no""" 
    fhta.WriteLine "contextmenu=""no""" 
    fhta.WriteLine "innerborder=""yes""" 
    fhta.WriteLine "scroll=""no""" 
    fhta.WriteLine "showintaskbar=""no""" 
    fhta.WriteLine "/>"
    fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhPAA8APcfAAAAACQAAEgAAGwAAJAAALQAANgAAPwAAAAkACQkAEgkAGwkAJAkALQkANgkAPwkAABIACRIAEhIAGxIAJBIALRIANhIAPxIAABsACRsAEhsAGxsAJBsALRsANhsAPxsAACQACSQAEiQAGyQAJCQALSQANiQAPyQAAC0ACS0AEi0AGy0AJC0ALS0ANi0APy0AADYACTYAEjYAGzYAJDYALTYANjYAPzYAAD8ACT8AEj8AGz8AJD8ALT8ANj8APz8AAAAVSQAVUgAVWwAVZAAVbQAVdgAVfwAVQAkVSQkVUgkVWwkVZAkVbQkVdgkVfwkVQBIVSRIVUhIVWxIVZBIVbRIVdhIVfxIVQBsVSRsVUhsVWxsVZBsVbRsVdhsVfxsVQCQVSSQVUiQVWyQVZCQVbSQVdiQVfyQVQC0VSS0VUi0VWy0VZC0VbS0Vdi0Vfy0VQDYVSTYVUjYVWzYVZDYVbTYVdjYVfzYVQD8VST8VUj8VWz8VZD8VbT8Vdj8Vfz8VQAAqiQAqkgAqmwAqpAAqrQAqtgAqvwAqgAkqiQkqkgkqmwkqpAkqrQkqtgkqvwkqgBIqiRIqkhIqmxIqpBIqrRIqthIqvxIqgBsqiRsqkhsqmxsqpBsqrRsqthsqvxsqgCQqiSQqkiQqmyQqpCQqrSQqtiQqvyQqgC0qiS0qki0qmy0qpC0qrS0qti0qvy0qgDYqiTYqkjYqmzYqpDYqrTYqtjYqvzYqgD8qiT8qkj8qmz8qpD8qrT8qtj8qvz8qgAA/yQA/0gA/2wA/5AA/7QA/9gA//wA/wAk/yQk/0gk/2wk/5Ak/7Qk/9gk//wk/wBI/yRI/0hI/2xI/5BI/7RI/9hI//xI/wBs/yRs/0hs/2xs/5Bs/7Rs/9hs//xs/wCQ/ySQ/0iQ/2yQ/5CQ/7SQ/9iQ//yQ/wC0/yS0/0i0/2y0/5C0/7S0/9i0//y0/wDY/yTY/0jY/2zY/5DY/7TY/9jY//zY/wD8/yT8/0j8/2z8/5D8/7T8/9j8//z8/yH/C05FVFNDQVBFMi4wAwEAAAAh+QQEBwAfACwAAAAAPAA8AAAI/wD/CRxIsKDBgwLtIVzIsKHDg60itnpIseJDe61IkWql0KLHjwJtkSKTcSLIkxRLjjR50J6tjigPvnyJMKLGiDW3bCEDM+ZAlxhtIRRJciNCnZt2+jTYambPgRk1GjVIRueWpEsL2mq3VahBkRnbtPt6VYrOsVkHzuzKdONNg1aTbklbkGNTl1pXToV61SpauiGBcqwbtQ1LgVb7AtbKFShBlXv/Vd1kdstTwC67eg2p93DiTaQWf+XKlSVklkitMjR82OCvmQxtOYWakaRJWzqlJG09sE2CJBK28B7IFTZCjEFZXu6LFKKEJFKeSyGD8BdpW01pMn152SCpvq1tRf9P8hu47oVONW/+ub6hvS2hCW75/bw+9IZdGwdtH5MM/STAkWdWd1+5dBdQ/HnUinT/JSCFFMMtJFhQxcUkRYBS0CdFfB9lFhSBFj2n4SYgUtSYdjGR4uCDf/nkUosWbigaXRHOaONHv4gWEWut8CjReh7KJmRTFdKVAABIJqkkkgnEJ9uHHJ2IHGASLGklkxwh11Vm1+FFlxRXLvnbRC9xVKaWW1IZ5pIQBobdWicOZuSRdAJQZwIOlnjjnnxmlWCfFBm31GuAnfmnRb+8eGhF2H24KEWJPinnRzOd2FhMkV7HnUeGaqbnQ5GaWZyX+HlqZk85epRqQnA+qaehoz6v9dKqDeVIa0iN2SUbQ2ZueZmi9txakK0oEoTgmQRyKahWvcJk6z+rRrqrTF0eiiB6yg6U6LYE5UeqQdcy9GqXj2nZbXEwivbkskH2JFtxj/qkK1fdUkgrgu18WyiwBSFoj6yjxguSdY0WK5Cul+VnsJ9rJTxhge8KrCBywxmYGbWz0eVUhJku/I+ik/r54XGn/rnup5z+e2ijNX7sMZ8NSwxouVnOnPK0Nlu0KV0BAQAh+QQFBwABACwAAAAAPAA8AAAI/wADCBxIsKDBgwL/IVzIsKHDg/9s2VP4sKJFh7/sSbRF8aLHjwH+tdI4EaRJixkD2GrV0eCvf79OInz56yVChSTtzWzFs6XMhAIlzrQ3kuPBX6RItSJl62fBlO1CQmwlkeVBnklHOjXYVOdRnSSvkiKzNObWgRqjai0oUqNVgr+WKlV6Fm47oQHMDsxY1KctpWSUeq1LsJVKgwqrtoyblS7hgrbuSt0L1uhAuYHfPj5oTy/JyB1XzqW6uSDJkYN/3aXaETPPwU9rwmTYefbBqk3zCvzcjiJPsoKPttqyiaxPgrhhQx482K/crAhJbZleXPnAiFq9Hve49LVBMtOJT/8nZR1t1QBe9Q7E+/AfmdxBpW8SL97wQrAD70a1bdLryvAAjvfQRp9FZplM8ok33yakfESVfuhpBhJ4ARJn30fJHSaTPQpa+NNp5YEUHlOEwffTFo6VpuKKLFq03VakHdaULTQep9FVm0kgxY489rjjFhcGFUA7RBGV34snJZGAkksm4GQSEiQhBRn/UGSgeUayt1WUUiQgBZRSKimFjuSht5F+uaEW5FZd7uhlmzpKKQUpOAmkVWToBWDYjXXpyKOfX445ZVQtFmooYUh6RFZpa5pkCwAJbGGiUzU6JQEAmCZR5lZF/tQGpqAmIMFaF8X12Z0n/ZIAqKxG2uhCfKXShRalUkDKaqZbhGiaUHdt9FNrq94K6agDSsYnQRol+pRPmwR7qxSTIifQXccid6eyNkXLobOQSkEoYkNGuyupecFk7nq7IdROl6BK8ZA9umqZEEcHBmVsdEtKkWtD6hlUpGEdxVqvVjEitJSuFV1Y3kj9povwTxsZaB2hx/naMGHkLldvhOE+3N+Vk+1l7KQEMrziq2amZeNKYT12pbjsvajTfozCO5VK7Vysp6+IyrucniH7O5KyH92IJGk+78bzoQUBzDSGGz/tkM1Se6SzSQEBACH5BAUHAAEALAEAAQA7ADsAAAj/AAMIHEiwoEGDtuzZOsiwocOHECNKnEixokWIvyTag/jvIseMBxPaamerI0OF/0B6ZNjK5EGSCRn+E2nP5UqDrRQeVGgvJ0OROVXeJNjuYc6FNgX+Giky6dCFPWsaVDhyY8F/VElaHUrw39FWJQ3C/Kk1LFeEPBcSjNlu60CeAWKefTkygFuvOgsyTeh2bsG0LtX6JKiQZDuhfpUWBRv3Lc21aaXKFOhUoC21DX+1PWoyYavGlnsyrSywFSmwiKdiDhm371/PcBGaJtXmdOWNJAMUdZj3IU2npILPPt0Qc2zVFOUONN2KTPDajBumNbzQrEebwk9rb/U5ItjCducy/3dOyjl31w5tDdat/OLz7afRQ6SqU/7Ef+S1W/domDRF7qe1dFZ7Q8WXWGKrHahgRSBl9MtGCQ4YAGNgVfhaa58VldtG9l20xYebfCjiFiFuQYpaG32WVl1aJUaiiCHGKCJxb+WUoWW6pXYTjCPyuEVLsImUW2kdejiijCWa2B2OdtH0mF9kbELKJlGa+CEpSha54JZc+qWjRRlFONR6QyUgBSkD8rTkUElIIYEUAl4ElGhiVpRAEne6uUUA/v0U2UK7rSSFFGbe2aYU4UV0WU/L9bbjoIWa+SYZfT7IFHiJUlaRHZhhmYQEbeYpxZ7S+WRjQjZ9ydAvEgBA6kCkuMyZxKd5bmHfpaiqVidBv2wAwK8JoGmQrJ+Oelt4x/G6nn+/SPHrr1K4tpGsUpBR5H6EZauUPQ+qREoCzyZARkNbjEpKn/5dZtiFBrX6bBK76jaUQtENFBNKsD7766sL5rSRUyoWtIW+Sax5oHoh4YYTuMDaenBUBDapU1Kk6Busgp+N5BSgoBHmLrRaTgSUdOqi92248VaUFp8Jq1hZEu8afNODR51UXZ2tJHCnBIGmuatmuklmUKwXd4ncZUZfBDSZSVeEbdMaYZVYQAAAIfkEBQcAAQAsAQABADoAOwAACP8AAwgcSLCgwYO27Nk6yLChw4cQI0qcOLEVxYsYBy5c+PBfxoj2Gv5qF5Hjx4O/7LWyF/KgwpYMUyY0eXLgv422PBr8ZTEAzYIk2+Ws6XLlL4MKEzZUKBAm0YK2lBYcKTLAyp5PoQZ1KZVr06wFne4k6bPgTaEkdYIVmBKrWp9MxQYIKXQtxX9YDbZaaO+t3Zst26k1+TPhyp8G/x1taOuXX5sWoxIMmVDuy4aAHT8eqJJtw3YqNwv0WDfAY8czbZU+aPEyQ46iCeKNqTJk7b4uFaLlu1g2RbFtFR5WKBrwzMv2etc8a/hl5dimfVrc65xoaqGqn0v8x/RqQugQowr/rf3948tW4EFmJ36SO9+sx9NHlD8xJ3278/Hrz6pYrvW9Akm2UQBHKbeaQAeCRQYpDDboIIMrIbgQWZOhZxcprWCoIYZkZBhZWXXZcpWE/p3UBoMndrgghB2KNZx4kl2Y4YYeQrgXdx5xN9d3feG2logiqpTdXtrtZ+SRAyn3VEpg/dNGiebldZIdUmwB1npLbrHJFluQMldGPCVFkpQZbckll15SFFx2Ad6XWCtcbmnmFmRMVBtn5S1nCylnankmgA5R9150SappVoZzmpkma7qt5xdeyUG0mBRItUJGol2KFmFXUN350BYJJCGFFFJyd2mfpCAW1mZJvbTYBrBuzLHBaFtIEaoEVia255YMihaSkgQZFuBAUgBgbAIttTJqqJQyhFc7gB4EHnlOSWAsAMgORIattm4B5T/ggskUhQMlcW22AsGZRAJSJEEGlCc1epC1xzpFiq1JSNCsXTwhSCix1ybhlC21rkupmxCdxxC92LoohQSikroWkzMdZG69BtV6a65ZueYfw+gSpCy3+y5JZkHFYmzQtu1KAe9dxy0csH/21Mqlqh/l2FDKDTPU6Mt2pRwqkhmREWoCHBNtJ5dSLKq0nXMh7FBAAAAh+QQFBwABACwAAAAAOwA8AAAI/wADCBxIsKDBg7/s/TrIsKHDhxDtQZxIsaJAWwJbSbTIsaPAhQEwehw58Nc/h/ZstQvZcCFIkg1tnTxoy5Y9jSgDbITJUKRBm0AbruSJUOLOnzdtFvVJtGArlTVnElQ69GcAjUybCkxZtefBfzW3StV61WYrmhmPDlzZDuNLsmmz6oRqVaJSuAXN2lO7tWBCjVjxOs2YFyrTlHwFD1SJmCDXqQHatk1M0CTMlHcHgrU3FvHZhpttvp3KFaPMgxI/8wRrUWK7lAFGx55M0ZbqqWbpyl280ra9rjD/jTW90jPlgrDj/pPdEehZlZEFjo0p2TlZrL1TToeYO2Rbnnbb7v/2+Px4RayNtQIf+S8wXOaK48ufT3bhcpamFe9NqLC/5QAn+fZUVebxBJR41VX3z15UHXgVV/CNBJRhmFV4UVUUAlVgczc11iFgnM0l0mSAQYeXcx3WJF56Os0VUmNuwbWZdjohJtF29OWoo0ebaRWWj5g1ZQsppNw2UkIP4sRTK2S0UiRMerU4XkVDOklkkVM+pNdZGzr0y5CktBEmkU1mWVJSD77ok5kOtXelk1Zy9yJOmWWUACkcjeZkk0TCeRx02B20BQAAJGDmP39ssQmeBJ20J5N9MucgjU4RaikZDpGxxaZbMNSKlUy2guNFyf0kgaWF7iRBAKsORMYmiirMOt6nRb7m0GkHkYIqAIwKlEQCUkghEkacbmEkQStGeGsCqApLkBS/SkEQKbFuQQqbIw1q6Z3PAgssZLFKQcqoMLXCrKVbHCVFAkkEy1QrnMKKLUdSoJrEsRJEi1wAsG5KSpcVtYFqAp0WtO7Bcm3aL171WpoEX+u2K21B//QLa69E2XJuoRgPJEW+wMplS7HpamXPucBS5u3EBlF78bwTbXHwsQId3O54rxYJ8ERV7tUQyAU3pBG58X2cRMk7VhQsy0nzLNCTTZ+HV0AAACH5BAUHAAEALAAAAAA7ADwAAAj/AAMIHEiwoMGD/xIeXMiwocOHtto9nEix4sBW9mxZ3Mhx4L+OIDvaytgqgL2F/36lDInw18lfC3+1G6nx4UeWBmsuzBhA4smD9kqaxGmwVUSdBGXSRGgL40iYRAeOxOgQ48+cAYRGzTnT4D+qSAkG1Qh1q8CjJ68OzDhT7dm2tm6aXUu1oNKedtsKdLv1n86wGccS9MtzLsK1QE1encq3Y1mGY7vuPar169SoJ8keDjw0gMt/9uROHdkQqq2wHrU2ftvU3uPEexlK1HtYamavpCmultq5IecApOO+5ljWJWOMRm1qDJo1qGu5ITnTpD0xME22Ua+XnAl6I0/muzfO/3QaGiTo6ZivR/1YeGt4kX2HG55Pv/5El/g9zz8NnH9cpCRFhlZE9qWVm1p+wdVVZMC915FWXc0kkVhG+aTVUfTVxNhp6sXWWWDWzQWVc6TZc9VNCaWo4oqGqRgAi9DZJ2NBTfU1ly1bJCHBVr/Ix5EtpEiRAAAAOPiQcUY21IqQRDaJU0oGtlcRjkM2SWQCW7Bk3IBJekaKBFY2mcQWXXpFmFEkPlUVmGECgKVWjnk0WpS7kZFEmwlIQcpiUmRZkUqDTXfaTKgNxGSTCSSxCWpJ5AnnQT22QkobXkmXUVwHHQrAmCYapKOOCQz0GEx+SUoKKaid51xdBpEhRaNbsODq0RZ55ulnAGTkmqtUpJAh6aMeWefaQq200s5uEiShrBQEbbHJFtB6RIqkZJDSUIovgiSFkBL0eRUZ0D5LEJDTTmsfKYkmsS2cz4ZbWSvV/lomRbZIkawECWxSELjtqmXPtPECSxStn24RlrPQGjyYqb8atmSe6u65b7hbTCgqwKcWGhKtQvYJbLvOokYuvAKD9Mu26jJ7EL/Q8hXUqZJqzNE/23Z7a0EIOytwUzDPq6SzZKwGbsKNfVVstn2RFuNApCC8KEoK+Vjf0FugOiNHkj5r7dUbGS0r1xRha1ZAAAAh+QQFBwABACwAAAAAOwA7AAAI/wADCBxIsKDBgwHsIVzIsKHDhbYUPpxIseGvhK0qatxY0FYrexE5iiR4EeGvdhj/jVwZQOXBf7baRbTlkCbLgTBBgjx4MkBMlwVh4ryJ01bMkAZhykyIEKRMiUQHejSJ0l4roAMvtpoZtWg7nSUJelQIVaxVpl2lBkBpsGfZrE8jhu36zypYgkoDZDzINq3BnW9nkj0Y069Bmxmh/tu6tKjhhYsHSwVs06fTiXMX/sJqcO9QyQR3mgT81uxHuS9PX2W4mOEv0JX/Vv4IkSJnga8HemYoWLBPrLcdBj/qszFDpx5pGo0tMixxtQ9d2j0tWqTEjBE/2gvOOmF2oipVV/8f+f3xTZ1RmYPvWtq8+/d+W5GRIoE+/foSEkjRnzZzy8r/XGTPfgAUaOCBBUqRlk6C0UadUQQiKKGCXf3yEWM02XWUPQMmIOGEC/pmnHGkbJFEEgmgqGKKCfAHn0C+DUTWjBzW2J5hCnH34nvq7eiQhVtQ6ONDv9gS5H67jdQaS7aQIsV+SUiQRHoxVvRLiVLqp5+QLMnUmH8LtRKkllIk8SQpPVppGXEg6QjjJvSZmSJ9m+C1EWe0eQkjREFmaaYEeuFFBhkVBRiUb7SF+eSc9ZHylpibbNFGQyoFeJtOefL2ZJRSkLKaWCVuISopAhkawGa4wWRUey4ZZVxB9gS5ucVaCIm5RaSb2GThVq2UFKCXtuiInrBJihWpqJt41gopZJBCalEgGVWTSP+EGimhUnnqKV5jPWWeLWQcWyeopLSBZmirRuQmtaGOWtCyy56LE1lbpbmSrbge5qynb6lq17oaXSmqqC115GmzzNXl3Y3kIXurevEu+1JI6ka12K2iFpsQGfGql9OGXbVy7LP6luvoxE+B2Zy2aTa5b5r2vGavdTO3Aq/GQQG8oMloDfnjzT5TxGBXAQEAIfkEBQcAAQAsAAAAADsAOwAACP8AAwgcSLCgwYMBbNmzh7Chw4cQDTIM8CuixYsP/yVkOBGjx48gQ4pk2MqeLYe/OopEqLJgSYEtXVJcafBXu4QI/9m6+ZLlyZg0AwAlqPBhyVYagw7U2W5nRYRNY+pUWFRpQZMBbh7EyrLVzpNWBzKMCnZpq6wsCSYNK9DWzqxrxWZ9KtZrU7YF/5V0O1OgXntnfQ61SLfhV60DbfUs2DQwSocbACSQUNYg2Mp1Bxc+GJdoEgCgAWzZDPMo14GFbbo93fDuQVtJEoSWTGpzSqqDhX51/DpqQ3sSZodOwFuoR8wBdALG6nUwKSmyhQOgvLKj8rOAYRr/vUkCEOkJtiD/x6hcMUfF2yG22hIbfO6HVKN6FUjaKHThpIKa7Pj+9/PQSVi1l1K2dAdAcSuNJ1I7W1j1T2d4RSjhhJZtsYUUG2AoxUBSSNAhhW0xpFBKFT0nQRJSoIiiFCwmcWKEPE1E1V4LkZHiiZMlEFsCCdyI134BYEejYzZCl6KLKuIYYFh6fbXcW4udJcWFLLLoYZUS7odbVTiJddKXbXUJol9jlpmTmSAl1SCaFmlEioWb5EfTP6rNGQAZW2xi4ZpKNZbmWXvCuQUZK9FpnIz9+WULnnk2amF6ITFl3k0jPvTLm47CKWdYJi2GGGeY6tnoJga1gmBDdBoq1n7YUYWQLZjuwEkqZoqRQoaCBf2iqlphejWgRGToqaeYZpFCSivHLkXmVQ7t5yyowRIKYULHkpGsX79kqytBgP1kWJiCoYrssZtSpGVcgX26FaTHVXutX6ZhBiSF/xhLbmVatlOYXmhxyZapZCBbXJO+FeSWumFdSq6pEq02nkmuMSmwtQj+VVKiCduLLGczTpvQTRHr10rA5RJ1HlBa4lXru3k1dypMTkocJKpf+avWT/WJ9I89HusWM5sRlcca0KimTHTQ8yoVEAAh+QQFBwABACwAAAAAOwA7AAAI/wADCBxIsKDBgwF+BfiHsKHDhxALKoxIsaLFAO0uatw40BbHjwJ/tdmwpdXEgv9stbPVyt7DfydBCrSVBAAACRkP2rJlz6NDjwxldkxgE8CWh+1iHmwllKAtokWZalSokmfTgVKKApDic2DKlSsRSk14VSApqDZJ6XTZkGfLsgO3aJXAtuPKVkG9esyptGkrtEYNVq270Kq9sXAFytWKeGZPggpbVQUJs23WolIKHm7Yk7DBvAfbSJFCpiEprQnULmxcsCpoiSERbpIgJQHp1wHsLbZJl+xC318xOmTYGaFuKUkkJLHd5jUZtEm6IuQp3euvnMIR/pqdJHmS2kcLyv9N4tm49gAeJbOtPrDVFinKbSdIHl5gq00XpVMNKxC7Q1Kj1YacbZmVd9FXKg102D8GCgaggPMpt4FMGVGXG2sUvVebd/WBhBhuFbk32ndXdcaeRvaQAZ9qQvnXlD34JSbjjDTWiFIrZJBCRo47krGFjz7ClVJuhlllS0r//OPeJls02aQkWzDJZIdC/XJYT0x5RF1OSjoppZNeUimTkj2F1c6V6h1JCilgRunmlGLKVJ1HV05my5oBbALnlFIKKdWWVVHH1mMBvGVfmScK5ZJnDdroaG6PcqRkG5Ee2Eora2JYqU6Y5ojnmIAm+hKmpGCKI6ZNVZgRoREpqWOnpErM9iJGbvUEIkEpmZppplbNONlPa7ZRao6sWanRa1uid2Vfq5W6ZqmGetXTkRDlxWx/FhroKhmmQirRWztB9EuvayUo6qWlkosrovaUV9lAd0Fk4kc7rcRqSp3FRKeoAjF4a0TGsmoXS4RhWaiN1PFEmJKCQraqjcQRKdGVDb1lz7Uf4WsYSm4ZN1mjHBm708XllmuvkIA2mFOD7JaFoMBetWShWBJfldLMOtH6EMgcddaoxaI+xu9GDF5LnKYE8exoUptupHTTHT1dUUAAACH5BAUHAAEALAEAAAA7ADsAAAj/AAMIHEiwoEGDtmy1snWwocOHEB+SkbJFSquIGDNqlJIAQJItGkOKLGirIwAAUkaqJPgr4a9/B0ueBJDAIcwAN1cW/FWRor2D9kx6tInzl86DUqRISBlzJsqGRgO0Y3iUpZQkCZLGTDKzpsF/tqZWbSgBK8WcAmWeTNLQXlhbP8cObJU0QRIJBoPOxLszwEK3cg1yvLqFalqnbAv+/NkqbuCBdbOSIqiW5s63Yh8TnJhksGG9J5kKzLn4KNqDZbOCPDwz8cC4F3W2THia4OCssUFbHh3Wr72oB2sT/Edqi3FShg1i7SwFZivmWgUCLv31JVzgBf+R2bSFO5lW2AXS/x0soR3RqZnzDgwbXvp248YDkAJvcOlkjY55u/1pPkD+gsV1B98WyOWUnEpg7RfAWwo61Ipx3HF3nC3CjbTYXwkBFpE9ZAwoIYEHinShf401JlI7xX24CRljpedfVQJu8d9Izu0X4kgBBmbjY7bcN5aGms2o2ZBEPpRgQkgmudCQv/xkFFhQjiZdK6R8R8qVWGap2T9LLmSePbElRyWV85VJZRvzDcmQiWlRBeZvrVBp5XdkVFkmi0OaOBV/bvoHJpmAllmmZk3CFVtjCr0ZIkNwNfrikPb8Zs8/P8ElUHtFZtpQhZqGBGRVnCLYqJAq/RQqRpQa+qlsb+G0EliGWs16o4gXgXlpSLBOhWhjpGpUqKJTnTrar6PCJaxG5rl5UagJmqhodpjaFF6juroVbEONvuUoSb0e9FJtNmY2q7UJtTNpXp8Z+dKCNzr2pkPUuhqToskJ9+aq82JK6bqbYtjfpaMaVOtDDHUL0ZGIEmTrpwXPmqdbsa337EBcvnusShmySXGjESumUKcXJXSQi5Q5S2TFfj1KGbno2upwp2nBjO2eN1L178hFVorvQDRjCzGh/hWMrXi9WkrkpJy+K/NKqi6tknkXO02SZgEBACH5BAUHAAEALAEAAAA6ADsAAAj/AAMIHEiwoEGD/wLY+3WwocOHEBv+arWFFKmIGDNq3CJFghSNIEMalCIliQSRKAcm/PcrYUMpCZKQdPjLli2GKQ22IkOKjK2DtmAKbdgmSQIpW37mVElmy5ZNFw+WPNrQlgQACQAkibpU4CanTpUWFErV4BYAaLG26jqQzNevXAnClPmxoK2saZOwJQiW41qCQU0m2TIyrdq9bb86DeByoGCPBdvgRVsXscCnmEfGnEkwSdqY7SwPJNV3i72BrUpKMEmQjGEAhEUPfOuUjNyYkAXa8pz3tEiWLB1SdPoVtVCZA89+jkuwcWOCrVqRamXr+cBfionrngp9staGLBcG/9fZ0yJ1614xb/l7UDnaBOxV/rL3s50t382lS29jsQ36prFB1ApeAV4XAHX22UMdUNKZZ9F0z0mHX0SkJBCagdSdpuB96Ol2YE/7TdcKTijh9899rZwWGn0TVhXdgzuJ2GFGJ9IXmi0JihURfSHCiNh9QLaokX7TsaVhivd1tV98OeGYpGxQRinllFL+Y+WVwC1kz4xdzefllvMFwNA/9NlEHYI28Sibkwqe5qRCArGoEItJtqmjaCgqiBCQCqWYYZ6yLZhiAHnq+FOZLPqJomgn5mifQPYlyJiGdLJIH5cp/aQpnIROSuWnoCKGaaikWuYSjpbJadmTez3KGEgM2bNp352ZlnkjfUOiFuRe+NkpZFVvSkmnfUgudNAvoUm6l0skxgnko8raheujQp76KkRh/hokkg3ZyGdDkWpk00N8XgqUPb86SxB+QTbLZLenkbmUn3btqhOtwk64li3v6raisDa5Ch26dxZa3ZT99onqugoFi6eHB/2Z7qBR0vuQwKSq2dBfrOqE66oBRGuQkwkPJHJOCX0bsboH+dZxl5xW1WbJcZaKWqc2i4txzhKlm1NAAAAh+QQFBwABACwBAAAAOwA8AAAI/wADCBxIsKDBg/Z+2TvIsKHDhw3/2WoVoNVCiBgzYvxFagsZUm00ihxpcMuWTVJIkVw5cpNJkw5/BfjHkqGtibZoHjTpUuVBWye3tJJZs2ArUqRaUTzo8uXBX1uSSJAiZWnRgUmRttJZkOfJg2SkJJCSRIqtqwSPtiFFxirBplt8FqSaZKwUtARtaU16tmvQnWID4yX46yjSpAbhbipoS2xdKVsG5wWZlMzFgV7JdB1rV7LRwyC5BlA8l6xYuZ4FqtVK0GtkgfaiJuhck6Zog3tb9bUFV27YsVIb/rppi6jBXxKRM7R3tC3iil4XB2gsVaqkp6RmA5CiGaEt5jmNT/82TKovwcucqR5vJRaA+7E2LX63KPN2q4/mG5Iim8Bgqy0JuCfgdsvNZ89NB95WkYINbSHFZUAFOKB7KUVkYADg5cRgRn3Z89uEACQhFEYHlvjdTRtmRIoEEg44lkUZ0QReO7bQmB9JZAAAxIRJkHKZSCdieONKLYa4xY8rnYjkSu28V9VgBw42FWqpXWXPklVmKZJtM1X5z5dgfjkTlwMpNN2ZEwXQTpWF4TQdRUt9Z1yNZ1FEo4lYFsXclfIt1A6eSgqEIJyCVhmlQHdOtKeM0zFX0Yl05smSQnRiqOZAQQZAlHklNjqkZIcOJKmWpJbqWYqmQiTRVqBK1ideNzXUWlRhjVKEqkaVdkmSiXe6VdOeA9F460AS7QmjRcNipGSQrEL03XQ2LmScckXRaRGNS234LKKwiSdkshxe+amoNVp6ZkELpRnuuI8mapOl2yIEY0LCFQtbgY42JC5EJfqq4IHYsnsurGsW5K5Bo+IVqq5CPvvjgRbZaiqNBf2CrXcdmlruTwtDay24IukGHsIY+orpoQmzpOi4F/pX0cierdkpY8A6pGiq/gH8qUIyM3yVxSbGN7NBgZ6ak76CwricRDgbdHDTHKoZL9T8Nuot1VVLFhAAOw=="" style=""position:absolute;left:5;top:5;"">"
    fhta.WriteLine "</html>"

End Sub
'***********************************

答案 4 :(得分：1)

尽管 HTA 解决方案是有效的，但将窗口保持在顶部可能会很痛苦。 当我需要抓取 VBS 并真正让它跳舞时，我使用 VBS+Powershell+C# 脚本。然后我可以直接将状态消息“飞溅”到屏幕的左上角：

enter image description here

这是 Powershell+C# 脚本：

Add-Type -TypeDefinition @'

using System;
using System.Drawing;
using System.IO;
using System.Threading;
using System.Windows.Forms;
using System.Runtime.InteropServices;

    public static class Progress
        {
        public static int previouswidth_ = 0;
        public static int previousprogressBarYOffset_ = 0;
        public static Boolean previousshowProgressBar_ = true;

        public static void Monitor(string filename_)
        {
            while(true)
            {
                try{
                    using (FileStream fs = new FileStream(@filename_, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
                    {   //...FileStream > StreamReader SO WE DON'T LOCK THE FILE
                        using (StreamReader streamReader = new StreamReader(fs))
                        {
                            string info_ =  streamReader.ReadLine();
                            streamReader.Close();

                            if(info_.Length<=0)
                            {
                                try{ File.Delete(@filename_);}catch{} //AN EMPTY FILE WILL END THE SESSION SO IT WILL BE DELETED
                                SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero);
                                System.Environment.Exit(1);
                            }


                            if( info_.Trim().Substring(0,1) =="-") //A SINGLE - OR -/0 CLEARS THE SCREEN
                            {
                                SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero);
                                //Thread.Sleep(500);
                            }
                            else
                            {
                                Splash(info_);
                            }
                        }
                    }                   
                }
                catch
                {   //...OR CLOSE IF THE FILE IS DELETED
                    SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero);
                    System.Environment.Exit(1);
                }

                Thread.Sleep(100);
            }
        }

        public static void Splash(string infoMSG_)
        {
            try
            {

            Boolean showProgressBar_ = true;

            string progressMSG_ = "";
            string denominator_ = "";

            try{ progressMSG_ =  new String('g',int.Parse(infoMSG_.Split(' ')[0].Split('/')[0])); } catch{ progressMSG_ = ""; }

            try{ denominator_ = new String('g',int.Parse(infoMSG_.Split(' ')[0].Split('/')[1])); }catch{} 

            if(denominator_=="" || denominator_.Length==0) showProgressBar_ = false;

            if(showProgressBar_ != previousshowProgressBar_) SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero); //Thread.Sleep(500);
            previousshowProgressBar_= showProgressBar_;

            try{ infoMSG_ = infoMSG_.Substring(infoMSG_.IndexOf(' ',infoMSG_.IndexOf(' '))+1,infoMSG_.Length-infoMSG_.IndexOf(' ')-1); } catch{ infoMSG_ = ""; }

            int progressBarYOffset_ = 40;

            if( infoMSG_.Length <=0)
            {
                progressBarYOffset_ = 0;
                //IF THE IMAGE DECREASES IN WIDTH, REDRAW THE SCREEN BEFORE DISPLAYING THE SHORTER IMAGE
                //...THE PAUSE RELIEVES THE FLASH EFFECT
                if(progressBarYOffset_ < previousprogressBarYOffset_) SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero); //Thread.Sleep(500);
            }

            previousprogressBarYOffset_ = progressBarYOffset_;

            // YOU CAN CENTRE THE DISPLAY, BUT IT'S MORE WORK AND THE TOP-LEFT DISPLAY
            // IS LESS ANNOYING AND IS HANDY FOR GENERAL ALERTS
            //int x_ = Screen.PrimaryScreen.WorkingArea.Width;
            //int y_ = Screen.PrimaryScreen.WorkingArea.Height;

            //DETERMINE HOW WIDE THE WINDOW SHOULD BE
            var zero = new Bitmap(1, 1);
            Graphics g_ = Graphics.FromImage(zero);
                Font stringFont = new Font( "Webdings", 14 );       
            SizeF stringSize = new SizeF();
            stringSize = g_.MeasureString(denominator_, stringFont);
            int bmpWIDTH_ = (int)(stringSize.Width)+20;

            stringFont = new Font( "Arial", 18, FontStyle.Italic );

            try{stringSize = g_.MeasureString(infoMSG_, stringFont);}catch{stringSize = g_.MeasureString("", stringFont);}

            int infoMSGWIDTH_ = (int)(stringSize.Width)+20;
            if(!showProgressBar_) { bmpWIDTH_ = infoMSGWIDTH_; }
            else { if(infoMSGWIDTH_ >= bmpWIDTH_) bmpWIDTH_ = infoMSGWIDTH_; }

            if( bmpWIDTH_==20 ) bmpWIDTH_=0; //IF WE ONLY HAVE THE OFFSET THEN REMOVE IT

            int bmpHEIGHT_ = 40;

            //IF WE SWITCH BACK TO <=20 AFTER MORE THEN REPAINT THE SCREEN TO CLEAR THE LAST IMAGE (AND ADD A PAUSE TO REDUCE THE FLASH EFFECT)
            if( bmpWIDTH_ < previouswidth_ && previouswidth_ != 0 /*I.E NOT STARTUP*/) SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero); //Thread.Sleep(500);
            previouswidth_ = bmpWIDTH_;

            //CREATE THE INFO BAR BITMAP
            var BMP = new Bitmap(bmpWIDTH_, bmpHEIGHT_);
            Graphics g = Graphics.FromImage(BMP);
            g.Clear(Color.Red);
            StringFormat drawFormat = new StringFormat();
            drawFormat.FormatFlags = StringFormatFlags.DirectionVertical;
            Font font = new Font("Arial", 18, FontStyle.Italic);

            try{ g.DrawString(infoMSG_,font,new SolidBrush(Color.White),8,10);
            } catch{}

            //DISPLAY IT
                IntPtr hbm = BMP.GetHbitmap();
                IntPtr sdc = GetDC(IntPtr.Zero);
                IntPtr hdc = CreateCompatibleDC(sdc);
                SelectObject(hdc,hbm);
            BitBlt(sdc, 0, 0, BMP.Width, BMP.Height, hdc, 0, 0, SRCCOPY);

            if(showProgressBar_)
            {
                //CREATE THE PROGRESS BAR BITMAP
                g.Clear(Color.Red);
                font = new Font("Webdings", 14, FontStyle.Regular);
                g.DrawString(progressMSG_,font,new SolidBrush(System.Drawing.Color.Yellow),10,7);

                //DISPLAY IT
                hbm = BMP.GetHbitmap();
                SelectObject(hdc,hbm);
                    BitBlt(sdc, 0, progressBarYOffset_, BMP.Width, BMP.Height, hdc, 0, 0, SRCCOPY);
            }

            //TIDY UP
                DeleteDC(hdc);
                ReleaseDC(IntPtr.Zero,sdc);
                DeleteObject(hbm);

            }catch{return;}
        }

            [DllImport("user32.dll", SetLastError = true)]
            private static extern IntPtr SendMessageTimeout(IntPtr hWnd, int Msg, IntPtr wParam, string lParam, uint fuFlags, uint uTimeout, IntPtr lpdwResult);
            private static readonly IntPtr HWND_BROADCAST = new IntPtr(0xffff);
            private const int WM_SETTINGCHANGE = 0x1a;
            private const int SMTO_ABORTIFHUNG = 0x0002;

        [System.Runtime.InteropServices.DllImport("user32.dll")]
        public static extern IntPtr GetDC(IntPtr hwnd);

        [System.Runtime.InteropServices.DllImport("gdi32.dll")]
        public static extern IntPtr CreateCompatibleDC(IntPtr hdc);

        [System.Runtime.InteropServices.DllImport("gdi32.dll")]
        public static extern IntPtr SelectObject(IntPtr hdc, IntPtr hgdiobj);

        [System.Runtime.InteropServices.DllImport("gdi32.dll")]
        public static extern int BitBlt(IntPtr hdcDst, int xDst, int yDst, int w, int h, IntPtr hdcSrc, int xSrc, int ySrc, int rop);
        static int SRCCOPY = 0x00CC0020;

        [System.Runtime.InteropServices.DllImport("gdi32.dll")]
        public static extern int DeleteDC(IntPtr hdc);

        [System.Runtime.InteropServices.DllImport("user32.dll")]
        public static extern int ReleaseDC(IntPtr hwnd, IntPtr hdc);

        [System.Runtime.InteropServices.DllImport("gdi32.dll")]
        public static extern bool DeleteObject(IntPtr hObject);
    }

'@ -Language CSharp -ReferencedAssemblies system.drawing, system.windows.forms

[Progress]::Monitor($args[0]);

现在，我们可以在创建临时 .ps1 文件时将此逐行嵌入到 VBS 文件中。但是，如果您想使用大型 C# 脚本，这将成为另一种痛苦。

因此，我将 Powershell+C# 脚本拖放到此 VBS 文件 (Bin2Txt.vbs) 中以创建压缩的 base64 编码版本：

Dim wsh, fso
Set wsh = wscript.CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.fileSystemObject")

If WScript.Arguments.Count > 0 Then
    For each arg in WScript.Arguments  
        path_and_filename = path_and_filename & arg
    Next

    tokens = Split(path_and_filename, "\")

    infilename = tokens(UBound(tokens))

    For i=0 To UBound(tokens)-1
        path = path & tokens(i) & "\"
    Next
else
    WScript.Quit
End If

outfilename = infilename & ".txt"

tempfile = fso.GetTempName

'MAKECAB NEEDS THE TRAILING "\" REMOVED FROM path
'*****************************************************
wsh.run ("cmd /c makecab  /L """ & left(path,len(path)-1) & """ """ & WScript.Arguments(0) & """ " & tempfile ),0,True

bytes_ = readBytes(path & tempfile)

'MS PUTS A LF ( 0Ah , CHR(10) ) AFTER 72 BYTES (SPEC SAYS 76) ...SO WE'LL TAKE THEM OUT
'*****************************************************
base64_ = """" & Replace(encodeBase64(bytes_), vblf, "") & """" 

tempfile_ = fso.GetTempName & ".txt"

set objOutputFile = fso.CreateTextFile(path & outfilename, TRUE)
objOutputFile.WriteLine(base64_)

objOutputFile.Close

if fso.FileExists(path & tempfile) then
    Set aFile = fso.GetFile(path & tempfile)
    aFile.Delete
end if

wscript.quit

'*****************************************************
private function readBytes(file)
    dim inStream
    ' ADODB stream object used
    set inStream = WScript.CreateObject("ADODB.Stream")
    ' open with no arguments makes the stream an empty container
    inStream.Open
    inStream.type= 1 'TypeBinary
    inStream.LoadFromFile(file)
    readBytes = inStream.Read()
  end function
'*****************************************************
private function encodeBase64(bytes)
    dim DM, EL
    Set DM = CreateObject("Microsoft.XMLDOM")
    ' Create temporary node with Base64 data type
    Set EL = DM.createElement("tmp")
    EL.DataType = "bin.base64"
    ' Set bytes, get encoded String
    EL.NodeTypedValue = bytes
    encodeBase64 = EL.Text
  end function
'*****************************************************
private Sub writeBytes(file, bytes)
    Dim binaryStream
    Set binaryStream = CreateObject("ADODB.Stream")
    binaryStream.Type = 1 'adTypeBinary
    'Open the stream and write binary data
    binaryStream.Open
    binaryStream.Write bytes
    'Save binary data to disk
    binaryStream.SaveToFile file, 1 'adSaveCreateOverWrite
end Sub

然后将 base64 文本添加到目标 VBS 脚本（例如“Splash.vbs”）中，该脚本将其展开并运行以创建进度或状态消息：

Dim wsh, fso, PS1file_, PROGESSfile_ , Base64file_

Set wsh = wscript.CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")


'CREATE THE POWERSHELL SCRIPT IN THE TEMP DIRECTORY
    Call CreatePS1file
'CREATE THE FIRST PROGESS FILE IN THE TEMP DIRECTORY
    Call Update("1/20 Loading...")
'START THE POWERSHELL SCRIPT IN THE BACKGROUND
    'wsh.Run ( "powershell -NoLogo -Command ""& '" & PS1file_ & "' '" & PROGESSfile_ & "'""  "),0,false



'***************************************************************************
'PUT YOUR LENGTHY PROCESSES HERE, CALLING THE Update SUB AS THEY PROGRESS:


' 0/0 TO DISPLAY ONLY THE TEXT
' ----------------------------
    Update("0/0 Show a single line of text...")
    wscript.sleep(3000)

    Update("0/0 Or just show the progress bar...")
    wscript.sleep(2000)


' x/yy TO DISPLAY ONLY THE PROGRESS BAR
' -------------------------------------
    for x = 1 to 20
        Update(x & "/20")
        wscript.sleep(200)
    next


' "x/yy your message here" TO DISPLAY INFO AND PROGRESS
' -----------------------------------------------------
    for x = 0 to 20
        Update(x & "/20 Downloading files...")
        wscript.sleep(200)
    next

    for x = 0 to 20
        Update(x & "/20 Installing files and updating the registry...")
        wscript.sleep(200)
    next

    Update("0/0 Done!")
    wscript.sleep(2000)

    Update("0/0 Formatting your PC...")
    wscript.sleep(2000)

    Update("0/0 Don't worry - Only kidding!")
    wscript.sleep(2000)


'A SINGLE - OR -/0 CLEARS THE SCREEN
'-----------------------------------
    Update("-/0")
    wscript.sleep(500)


'KILL THE SPLASH APP BY FEEDING IT A BLANK FILE (THE PS1 APP WILL DELETE THE PROGRESS FILE)
'------------------------------------------------------------------------------------------
    Update("")


'***************************************************************************


'DELETE THE SPLASH APP FROM THE TEMP DIRECTORY
    if fso.FileExists(PS1file_) then
        'Set aFile = fso.GetFile(PS1file_)
        'aFile.Delete
    end if






wscript.quit


'*****************************************************
Sub Update(text_)
    Set fhta = fso.OpenTextFile(PROGESSfile_,2,True)
    fhta.WriteLine text_
    fhta.close
End Sub
'*****************************************************
Sub CreatePS1file

    tempfolder = fso.GetSpecialFolder(2).ShortPath & "\" 
    PS1filename = Split(fso.GetTempName,".")(0)
    PS1file_ = tempfolder & PS1filename & ".ps1"
    PROGESSfile_ = tempfolder & PS1filename & ".tmp"

    'FILL THE VARIABLE WITH THE BASE64 CODE AT THE BOTTOM OF THIS SCRIPT
    Call FillBase64file_    

    'GET THE COMPRESSED FILE FROM THE BASE64 TEXT
    base64_ = Base64file_
    tempfile = fso.GetSpecialFolder(2).ShortPath & "\" & fso.GetTempName
    bytes_ = decodeBase64(base64_)
    writeBytes tempfile, bytes_

    'DECOMPRESS THE FILE
    wsh.run ("cmd /c expand """ & tempfile & """ """ & PS1file_ & """" ),0,True

    if fso.FileExists(tempfile) then
        Set aFile = fso.GetFile(tempfile)
        aFile.Delete
    end if

    Do while not FSO.FileExists(PS1file_)
        WScript.Sleep 100   
    Loop
End Sub
'*****************************************************
private function decodeBase64(base64)
    dim DM, EL
    Set DM = CreateObject("Microsoft.XMLDOM")
    Set EL = DM.createElement("tmp")
    EL.DataType = "bin.base64"
    EL.Text = base64
    decodeBase64 = EL.NodeTypedValue
end function
'*****************************************************
private Sub writeBytes(file, bytes)
    Dim binaryStream
    Set binaryStream = CreateObject("ADODB.Stream")
    binaryStream.Type = 1
    binaryStream.Open
    binaryStream.Write bytes
    binaryStream.SaveToFile file, 1
end Sub
'*****************************************************
Sub FillBase64file_
    'CONTAINS THE POWERSHELL + C# SCRIPT, COMPRESSED AND 
    'BASE64 ENCODED BY DROPPING THE filename.ps1 FILE INTO Bin2Txt.vbs
    '(CREATES filename.ps1.TXT)

Base64file_ = "TVNDRgAAAAAqCQAAAAAAACwAAAAAAAAAAwEBAAEAAAAAAAAASQAAAAEAAQDUGwAAAAAAAAAANFKgbCAAcmFkQ0RGNTcucHMxAG/VbG7ZCNQbQ0vNWXtv4sYW/5uV9jtMo6vGbh3jbFvdqpRqjTFgFWxkO4tyV6vI4AHca2w0NiHZbb77PfPwM4RuVe1t0W6YGZ/XnHPmd84YPQyv/Mc9RuzvEK+jJMqjNEFvL1+/ev3qkEXJBnmPWY53veZUHZLgCNP2suW0V/wtwUF4gnQRJWF6zNRRSnZZ+6F7SPJoh1UryTFJ9x4m99EKU7LXrzr7wzKOVijLgxy+VnGQZWhO0g3BWfb6FRKfT0DZIo2SHO0Jvo/SQ3aMwnx7h/pI650n3AvJg4DcOut1hvOXuAZpGuMgKTmzbXqcV9yULScHzDfR4r1PoxDNUvB/SqQsJ9QX6yjGSbDDdzKlZ/vpHLewKFExbFGsdnLyKEYd7kdpBHReDr7foXUGmhN8RNWa9LYUrrDlWRpi1dnjhE/1FXg7U10IHV/wtgHBbL4gUY5lWWj71Ol2VVWtafsF8QGlxQR5DlqYaOjYlz6aOsavyJ+YaGRNTSGgsLfBlNUn3Pb6c2mdlQYUHoCPcFuUrFPq605dCjN9GiVYknt1horAiNOMPy2fR2uJCVOnONnk25/7Wqm1ppY5nzlJHeIY57jmXLn3tAry1fbTE+p2dRuZs7l/y7aPFtZ0ikx7yBzimZ5nOTb1luXzRwPwmjk1fXNYafJwEs4gMMEG+3A80kMuTRb28G7gOvrQ0D1fQYvZnWf6vmWPjYluj00FwRma50T9DxwkBSWHOFaQN/OdO33guL41mtzYYwVda1qDsualjjiTZnIfkTTZ4SRXzYcol65rRE/UbXXH8TCoPol2kqx6hyWPjqQp1zLq9y+uLmTqEuSBpeCNK+S46KqrIWNq6q7HnWK4pmmf8vjf44dul4OZ6sUY76UfNK3pADHCcYZPGr0HpNryjDrFWAye2F8+EWssh/hQHDjwljF1PBNZo/JEIctrpczf4Kc/TJanIk8azrwuncm2/PQiRgov1s76zBvXERJOY4GM7LtA5fNoXIBHgfZUKFBcXPTqT0OcpLsoCQCky6eF0k9t3gK2aNZfbi4VKCrqPCAAMoXVKmwGXHOJLuX32odi1mUzWe6hJ8TB44RV6KmuuWXXX1B8zRUXoCWUwHmuq4Dje4F+/72hVmBkHzDylKvXAZyKXiXuGclX/Rfrpoz+n3mMXjzmL9nXf7bhRloUTgcvVP4v8bBcspIQPzhrGhTl1KIsf3tdPeDevjpJeHVdz52a+nre8BbnVGvzvVaLE2ppRGURFMh2rj2ikCnwyZrpY1rQANJ1KHbIsqHKDf2Jglxz6OqLGuBD5Rs5LhBb3nyq30JE+cMJhM10uaRCOiAhfTbXbwAKXXNqme9MXjxGU92bIHM0Mg2fU8NuThn787lO75+SekXUzjelJ1aLUHa76Na5QQb0IIZp++Be6iThYgUNbnxoPC49NKOeXzjur0gXrYnvzK+m5sgviAtxUGym0LUAne2wIFEGWAQXDKHFgQI1Nm3T1adIn5qu7wk+mncP1FhvRTBO1Dk0CAF5FLNFSv4Lp0IHJ8AFATr0Xo3t8bPYJjjabPNq30Ooh+7Msk00cRY06fjWF5Y9hDlk1c10CCnHqO8Dgj5CKASGDqJ8F0BtgliJOIxJsN9GqwxtqC3FTB2RdGftIEWkj0UtpFeQTmeUgt38pLOh6MNhKKGLBV7Si1F2AfK/R3JPFH0v+ohHgomOC0Cny0X32ni6uVNnOMgOBAvQr+OyUlMvmKkvl7s9O390G4BBuSxVIrnn5W/faM3i+HwHOomCmJr/o8KWvPwRumArD2jVlusoeN7gAmSaxooqdJ714qLFVMM3IfbzNsoR4qvnxedTw1kNmQxORcsHdOK+UKn8pV/xyn8gpkTckqzff6OhGltfowgBgAoXKsee3sJRe8eT2RmNAIHo0AYUnDmwbPk1R4CIiWmNJ34T3wth3sLyjQka6PR65gDEg159RMGWwYEQO9ct26/jNJCybp2tAdz6AuUligT6EP4LYAZCQPkbw3yGzPLzXdcAWdzRv/66vQLNgoa631iqiWzHR56vu/7N/JvuP61TKF8ylLurXE8roc89YtkjB7zvooHlz/R5CUWD2byJRKUYpRbSZ9B0GplAmKDcwF0XB0Qy0jilF+NQrHviGJFdkKOQBEcxrDeUfKmAoYpI5V+jONjQtw11YramDiOCV/Tl0jtMoJkPYi6BYcq6BSxncaUBK2jD3kS1YYQKVJjRaRyFA3KAGwPf7WJL314oPyrXZWkVjdJTVTF4oWNHSOA4jzvaLndgJ3hSHeN8suRBqcG9IMvCFY0BzoeG1L4jNeUxQgNyKMdGutvDNWcZY+ACCTVqD8fgO2f5G/yVgEcBO4T1kBiDOKf0CtLYP2odwzU+5OVQoaoKCs81DGd+K59pxxstXiNX564zdmndb+Xri1nVeRbdRt2rB9jFm0MckIKxEdv6FehkfJsvJlVuxi2O4/QoQ7SVf1evdlohhs/Lge2ccT+PTjsGJ7qwPxmVWsMHEGNBO3UzL9Xxd0yQI9tGjriwHGS4mXFKM484a7ERvgmujR8BgvMDSXrVDZyzvR/GsbXbpwRid8gw+e6NGsb0eHo4nwZZbhKSEnGdlj8UXHsS3UNaF5d3/JBjkggAPQXTxZFYJKHCXsDOsk0BuOgI99dgV1R6FIvpgdKtDwxhxOwg5JWs8T48ujg7xKz9OWkbxfA0iR8LlmbFELnLn0nawxo+z0Wt0iTLmd3t+kKvQw/XwRmOdrFhHJqmvRHxeX/+rbh6Oj40FO1XKM0o1BEKbY9JKP95hZsw+mx9J4CuAsIvrLtxiCutZZpsQVi6/O1LWUHDLHCiUj7Mcp7qD+XosRwd+de2sjBceWQlGMrRYzkC8zh41H7EEKAiEsowIKe0L7jDEpv+Ulg/L4epvjbosSSuO+xLhXOZpjFqwGmhk09ZIBiEXr5FV9Mg2RwA6pBBf0bZoysXrzHByQqHepbhHSjAGcq4iSEvYEoxP4rfydb0dzIq8X1RqD/89FPxi9G/ArLJ6FvD3v8A"




End Sub
'*****************************************************

消息显示在屏幕的左上角。 您可以将它们居中，但这有点麻烦，我发现用户更喜欢左上角的显示，尤其是单行状态消息。

Splash.vbs“更新”子写入一个文本文件，Powershell+C# 每 100 毫秒读取一次。如果文件为空，Powershell+C# 将删除文本文件并退出。如果文本文件被删除，Powershell+C# 将退出。 Splash.vbs 脚本然后删除临时目录中的 .ps1 文件。

文本文件选项是：

提示和进度条：

15/20 Your message...

仅在一行中提示：

0/0 Your message...

进度条仅在一行中：

5/30

要刷新屏幕以删除启动消息，只需将文件中的第一个（或唯一的）字符设为减号 ("-")。

要结束 .ps1 应用程序，只需清空文件即可。显然，如果您希望其他 VBS、powershell 或批处理文件显示消息，您可以保持它运行。

运行 Splash.vbs，一切都会变得显而易见。

这种技术可以用来将其他C#应用封装成VBS脚本，直接放在网页上。然后，最终用户可以将它们复制并粘贴到他们自己的 VBS 脚本中，而许多防病毒软件包通常会忽略这些脚本。

Bin2Txt.vbs 可以压缩任何二进制文件（.exe、.png、.mp4 等），因此您的 VBS 脚本也可以重新创建这些文件并即时使用它们，前提是防病毒软件包没有删除他们先。

注意：

对于那些不信任的人，我在 Splash.vbs 文件中注释掉了 run 命令： 
'wsh.Run ( "powershell -NoLogo -Command ""& '" & PS1file_ & "' '" & PROGESSfile_ & "'""  "),0,false

...连同删除例程：

'DELETE THE SPLASH APP FROM THE TEMP DIRECTORY
    if fso.FileExists(PS1file_) then
        'Set aFile = fso.GetFile(PS1file_)
        'aFile.Delete
    end if

因此，运行 Splash.vbs 文件，查看在 temp 目录中创建的 .ps1 文件并检查它是否与上面的 Powershell+C# 脚本匹配。如果您满意，请取消注释“wsh.Run”和“aFile.Delete”命令并重新运行。

答案 5 :(得分：0)

我发现了在VbScript中运行长脚本时显示进度的更好方法。

enter image description here

我在this url中发现了一些代码，并对其进行了修改以使其看起来更好。其他代码的问题是我们无法更改进度栏的大小。我在代码中修复了它。只需更改m_ProgressBar.width和height。还要更改html正文中的边距。就是这样。

Class ProgressBar
    Private m_PercentComplete
    Private m_CurrentStep
    Private m_ProgressBar
    Private m_Title
    Private m_Text
    Private m_Top
    Private m_Left

    'Initialize defaults
    Private Sub Class_Initialize()
        m_PercentComplete = 1
        m_CurrentStep = 0
        m_Title = "Progress"
        m_Text = ""
        m_Top = 100
        m_Left = 150
    End Sub

    Public Function SetTitle(pTitle)
        m_Title = pTitle
        if IsObject(m_ProgressBar) then
            m_ProgressBar.Document.title = m_PercentComplete & "% Complete : " & m_Title
            m_ProgressBar.Document.GetElementById("pc").InnerHtml = m_PercentComplete & "% Complete : " & m_Title
        end if
    End Function

    Public Function SetText(pText)
        m_Text = pText
        if IsObject(m_ProgressBar) then m_ProgressBar.Document.GetElementById("text").InnerHtml = m_Text
    End Function

    Public Function SetTop(pTop)
        m_Top = pTop
    End Function

    Public Function SetLeft(pLeft)
        m_Left = pLeft
    End Function

    Public Function GetTop()
        GetTop = m_ProgressBar.top
    End Function

    Public Function GetLeft()
        GetLeft = m_ProgressBar.left
    End Function

    Public Function Update(percentComplete)
        If percentComplete > 100 Then
            m_PercentComplete = 100
        elseif percentComplete < 1 then
            m_PercentComplete = 1
        else
            m_PercentComplete = percentComplete 
        end if
        UpdateProgressBar()
    End Function

    Public Function Show()
        Set m_ProgressBar = CreateObject("InternetExplorer.Application")
        'in code, the colon acts as a line feed
        m_ProgressBar.navigate2 "about:blank" : m_ProgressBar.width = 800 : m_ProgressBar.height = 380 : m_ProgressBar.toolbar = false : m_ProgressBar.menubar = false : m_ProgressBar.statusbar = false : m_ProgressBar.visible = True : m_ProgressBar.Resizable = False : m_ProgressBar.top = m_Top : m_ProgressBar.left = m_Left
        m_ProgressBar.document.write "<body Scroll=no style='margin:100px;'><div style='text-align:center;padding:15px;'><span name='pc' id='pc'>0% Complete</span></div>"
        m_ProgressBar.document.write "<div id='statusbar' name='statusbar' style='border:1px solid blue;line-height:22px;height:30px;color:blue;'>" _
            & "<table width='100%' height='100%'><tr><td id='progress' style='width:1%' bgcolor='#0000FF'></td><td></td></tr></table></div>"
        m_ProgressBar.document.write "<div style='text-align:center;padding:15px;'><span id='text' name='text'></span></div>"
    End Function

    Public Function Close()
        m_ProgressBar.quit
    End Function

    Private Function UpdateProgressBar()
        if m_CurrentStep <> m_PercentComplete then
            If m_PercentComplete = 100 Then
                m_ProgressBar.Document.GetElementById("statusbar").InnerHtml = "<table width='100%' height='100%'><tr><td bgcolor='#0000FF'></td></tr></table>"
            else
                m_ProgressBar.Document.GetElementById("progress").style.width = m_PercentComplete & "%"
            end if
            m_ProgressBar.Document.title = m_PercentComplete & "% Complete : " & m_Title
            m_ProgressBar.Document.GetElementById("pc").InnerHtml = m_PercentComplete & "% Complete : " & m_Title
            m_ProgressBar.Document.GetElementById("text").InnerHtml = m_Text
            m_CurrentStep = m_PercentComplete
        end if 
    End Function

End Class

然后，添加以下代码以显示进度栏并更新进度的当前状态。

'Declare progressbar and percentage complete
Dim pb
Dim percentComplete
'Setup the initial progress bar
Set pb = New ProgressBar
percentComplete = 0
pb.SetTitle("Step 1 of 5")
pb.SetText("Copying bin/Debug Folder")
pb.SetTop(150) ' These are optional
pb.SetLeft(300) ' These are optional
pb.Show()

'Loop to update the percent complete of the progress bar
'Just add the pb.Update in your code to update the bar
'Text can be updated as well by pb.SetText
Do While percentComplete <= 100
    wscript.sleep 500
    pb.Update(percentComplete)
    percentComplete = percentComplete + 10
Loop
wscript.sleep 2000
pb.Close()

'This shows how you can use the code for multiple steps
Set pb = New ProgressBar
percentComplete = 0
pb.SetTitle("Step 2 of 5")
pb.SetText("Copying bin/Release Folder")
pb.Show()
pb.Update(percentComplete)
Do While percentComplete <= 100
    wscript.sleep 500
    pb.Update(percentComplete)
    percentComplete = percentComplete + 10
Loop
msgbox "Completed", vbSystemModal
pb.Close()
wscript.quit

答案 6 :(得分：0)

如果您的脚本在控制台中运行并且不向其输出文本，则这是一个非常简单的解决方案。你可以发出

wscript.stdout.write "*"

每 x 条记录。它很简单但没有限制，你可以用几行 *. 如果您向控制台发出文本，请以 vbcrlf 开头和结尾，以免它们与星号混淆。

相关问题
最新问题