开发者

Running 2 subroutines at the same time

开发者 https://www.devze.com 2023-01-25 17:00 出处:网络
I am trying to enhance an hta i\'ve been working on for a while with a loding bar. I want tomake the loading bar running while the other sub is being executed.I don\'t know how to make both subs run a

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&nbspHard 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

0

精彩评论

暂无评论...
验证码 换一张
取 消