Running 2 subroutines at the same time
I am trying to enhance an hta i've been working on for a while with a loding bar. I want to make the loading bar running while the other sub is being executed. I don't know how to make both subs run at the same time. Any help is appreciated.
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<HTA:APPLICATION APPLICATIONNAME="Count - Progressbar - Table">
<script type="text/vbscript">
Class ProgressBar
Public Sub Init()
Dim NewDiv : Set NewDiv = Document.CreateElement("div")
NewDiv.innerHTML = "<div id='_progress' style='position:absolute;margin-top: 15px;top:0px;" & _
"left:130px;height:230px;width:600px;background-color:orange;" & _
"color:white;z-index:1000;display:none;'><div id='_LB0' style=" & _
"'position:absolute;left:50%;top:50%;'><div style='position:absolute;" & _
"font-family:arial;font-size:10px;color:green;left:-50px;top:-18px;'>" & _
"<div id='_message'>Working Hard H....</div><div id='_status'></div></div>" & _
"<div style='position:absolute;left:-50px;top:-5px;font-size:1px;" & _
"width:100px;height:10px;background:red'><div id='_LB1' " & _
"style='position:absolute;left:0px;top:0px;font-size:1px;width:0px;" & _
"height:10px;background:white'></div></div></div></div>"
Document.Body.AppendChild(newDiv)
End Sub
Public Sub Show()
Dim p : Set p = Document.GetElementById("_progress")
With p.Style
.display = ""
End With
End Sub
Public Sub Hide()
Document.GetElementById("_progress").style.display = "none"
End Sub
End Class
</script>
<script language="VBscript">
Sub Window_OnLoad
window.moveTo 200,200
window.resizeto 800,500
Progress.init()
End Sub
Function Reachable(strComputer)
' On Error Resume Next
Dim wshShell, fso, tfolder, tname, TempFile, results, retString, ts
Const ForReading = 1, TemporaryFolder = 2
Reachable = false
Set wshShell = Createobject("wscript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
tname = fso.GetTempName
TempFile = tfolder & tname
wshShell.run "cmd /c ping -n 1 -w 10 " & strComputer & ">" & TempFile,0,true
Set results = fso.GetFile(TempFile)
Set ts = results.OpenAsTextStream(ForReading)
Do While ts.AtEndOfStream <> True
retSt开发者_如何学Goring = ts.ReadLine
If instr(retString, "Reply") > 0 Then
Reachable = true
Exit Do
End If
Loop
ts.Close
results.delete
Set ts = Nothing
Set results = Nothing
Set tfolder = Nothing
Set fso = Nothing
Set wshShell = Nothing
End Function
Dim Progress : Set Progress = New ProgressBar
Sub Table
Progress.Show
For x = 0 to AvailableOptions.Options.Length - 1
If (AvailableOptions.Options(x).Selected) Then
intCount = intCount + 1
End If
Next
DataArea.InnerHTML = ""
strHTML = strHTML & "<table width='100%' border='0' cellspacing='1' class='tablesorter'>"
strHTML = strHTML & "<thead> "
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Computer</STRONG></th>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Info A</STRONG></th>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Status</STRONG></th>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</thead> "
strHTML = strHTML & "<tfoot> "
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Computer</STRONG></th>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Info A</STRONG></th>"
strHTML = strHTML & "<th bgcolor = 'black'><font color = 'white'><b><STRONG>Status</STRONG></th>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tfoot> "
strHTML = strHTML & "<tbody> "
part = 1
whole = intCount
For i = 0 to AvailableOptions.Options.Length - 1
If (AvailableOptions.Options(i).Selected) Then
strComputer = AvailableOptions.Options(i).Value
If part > whole Then
Document.GetElementById("_progress").style.display = "none"
Else
Document.GetElementById("_status").InnerText = Round(part / whole * 100) & "%"
Document.GetElementById("_LB1").Style.Width = Round(part / whole * 100) & "px"
part=part+1
If Reachable(strComputer) Then
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td>" & strComputer & "</td>"
strHTML = strHTML & "<td>Good</td>"
strHTML = strHTML & "<td>ON</td>"
strHTML = strHTML & "</tr>"
Else
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td>" & strComputer & "</td>"
strHTML = strHTML & "<td>Not so good</td>"
strHTML = strHTML & "<td>OFF</td>"
strHTML = strHTML & "</tr>"
End If
End If
End If
Next
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & intCount
Progress.Hide
DataArea.InnerHTML = strHTML
End Sub
</script>
</head>
<body bgcolor="white">
<select size="14" name="AvailableOptions" style="width:100" multiple="multiple" >
<option value="PC01">PC01</option>
<option value="PC02">PC02</option>
<option value="PC03">PC03</option>
<option value="PC04">PC04</option>
<option value="PC05">PC05</option>
<option value="PC06">PC06</option>
<option value="PC07">PC07</option>
<option value="PC08">PC08</option>
<option value="PC09">PC09</option>
<option value="PC10">PC10</option>
<option value="PC11">PC11</option>
<option value="PC12">PC12</option>
<option value="PC13">PC13</option>
<option value="PC14">PC14</option>
</select>
<div id="table" style='overflow:auto;position:absolute;margin-top: 15px;top:0px;left:130px;height:230px;width:600px;background-color:orange;z-index:1000;display:block;'>
TABLE
<p><span id="DataArea"></span></p>
<input type="button" class="button" value="Table" style="width:70" onClick="VBScript:Table">
</div>
</body>
</html>
Consider using WshShell.Exec instead of WshShell.Run.
Exec will return immediately, running the process in the back ground allowing you to complete other actions (such as updating the progress) whilst waiting for the ping to complete.
Run does not return until the process has exited and this allows you to run scripts and programs synchronously.
Given your code:
wshShell.run "cmd /c ping -n 1 -w 10 " & strComputer & ">" & TempFile,0,true
Set results = fso.GetFile(TempFile)
Set ts = results.OpenAsTextStream(ForReading)
Do While ts.AtEndOfStream <> True
retString = ts.ReadLine
If instr(retString, "Reply") > 0 Then
Reachable = true
Exit Do
End If
Loop
ts.Close
Exec mightbe a better choice as it allows you to capture the output of the ping command while your code is still running.
See Exec Method
加载中,请稍侯......
精彩评论