我是 VBScript 新手，正在编写一个解析大型输入文件的脚本，并且可能需要几分钟的运行时间才能完成处理。我需要一种方法来提醒用户脚本在这么长的处理时间内运行没有错误。我的第一个想法是为每处理的第 1000 条记录显示一个 msgbox（例如，“到目前为止，脚本已成功处理 1000 条记录。”）还没有完全破解编码增量器的正确方法，该增量器将有条件地每隔 N 条记录触发一个 msgbox（或确定是否有更好的方法来实现我的最终目标）。有任何想法吗？
问问题
31712 次
7 回答
9
如果您在控制台窗口（通过 cscript.exe）中运行脚本，那么您可以直接在窗口/输出中显示一个人造进度条，如下所示：
首先在您的 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
于 2015-11-11T13:28:18.237 回答
4
在这种情况下，我想使用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
于 2013-08-13T18:13:10.133 回答
4
除非您想惹恼您的用户，否则不要为此使用弹出消息。将您的代码包装在HTA中，该 HTA会显示类似于此页面中的进度指示器，例如：
<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> 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
...
于 2013-08-13T19:35:28.057 回答
1
下面使用的HTML .HTA 文件（由 VBS 脚本在 temp 目录中创建和启动）可用于通过使用“g”字符更新的 Webdings 文本字符串来显示连续的方形块。
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 来显示菊花轮时钟：
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
'***********************************于 2021-01-14T00:45:34.430 回答
1
尽管 HTA 解决方案很有效，但将窗口保持在顶部可能会很痛苦。当我需要使用 VBS 并真正让它跳舞时，我会使用 VBS+Powershell+C# 脚本。然后我可以直接将状态消息“飞溅”到屏幕的左上角：
这是 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”命令并重新运行它。
于 2021-01-19T22:26:04.300 回答
0
我找到了一种在 VbScript 中运行长脚本时显示进度的更好方法。
我在这个 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
于 2019-10-19T11:01:33.037 回答
0
如果您的脚本在控制台中运行并且没有向其输出文本，这是一个非常简单的解决方案。你可以发出
wscript.stdout.write "*"
每 x 条记录。它很简单但没有限制，你可以用几行 *. 如果您向控制台发出文本，请在它们之前和结尾加上 vbcrlf，这样它们就不会与星号混淆。
于 2021-05-12T11:48:10.320 回答