Im having a hard time getting a hta application to update the screen
while processing.
>From what i have read i should be using settimeout but i can not work
out how. I must be just a dunce. The vbscript file just does a
wscript.sleep for 5 seconds while i troubleshoot this issue.
Any help will be greatfully received.
gui-report.hta
<html>
<link type="text/css" href="gui-report.css" rel="stylesheet" />
<head>
<title>GUI-Report</title>
<HTA:APPLICATION
ID="objHTAGUI-Report"
APPLICATIONNAME="HTAGUI-Report"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
<OBJECT width="0" height="0" classid="clsid:
550dda30-0541-11d2-9ca9-0060b0ec3d39" id="complist" VIEWASTEXT="">
</OBJECT>
<body onload="Initialize();" onunload="Cleanup();" class="MainBody">
<script language="vbscript">
Dim fs, sh
Const sCmdString = "cscript /nologo test.vbs "
Const MaxForks = 1 'starts from zero (ie, 0 = one fork, 5 = six forks)
Const MaxRunTime = 15 ' Seconds
'wshExec
Const WshRunning = 0
Const WshFinished = 1
Sub Initialize()
Dim xmlDoc
Set xmlDoc = complist.XMLDocument
Const THESETTINGS = "C:\work\xmlreport\test.xml"
Set fs = CreateObject("Scripting.FileSystemObject")
Set sh = CreateObject("Wscript.Shell")
xmlDoc.Async=False
if fs.FileExists(THESETTINGS) Then
xmlDoc.load THESETTINGS
Else
xmlDoc.loadxml ("<?xml version=""1.0"" encoding=""utf-8"" ?
><computerlist><computer><Name>BLANK NAME</Name><Status></
Status><Reboot>0</Reboot><Enabled>-1</Enabled></computer></
computerlist>")
End If
End Sub
Sub Window_Onload
End Sub
Sub ChangePointer
If window.event.srcElement.id = "notesbuttonrun" Then
notesbuttonrun.style.cursor="hand"
ElseIf window.event.srcElement.id = "notesbutton" Then
notesbutton.style.cursor="hand"
End If
End Sub
Sub OK_OnClick
Dim xmlDoc
Set xmlDoc = complist.XMLDocument
xmlDoc.save "test.xml"
SetStatus "Saved!"
End Sub
Sub Load_OnClick
Dim fso, oFile, sHTML, sFilename, rc
Dim sLine, aLine
Dim xmlDoc, sXML
Set FSO = CreateObject("Scripting.FileSystemObject")
sFilename = FileName.Value
'on error Resume Next
Dim iLine
If FSO.FileExists(sFilename) Then
Set xmlDoc = complist.XMLDocument
Set oFile = FSO.OpenTextFile(sFilename)
sXML = "<?xml version=""1.0"" encoding=""utf-8"" ?><computerlist>"
Do Until oFile.AtEndOfStream
iLine = iLine + 1
SetStatus "Loading Line: " & iLine
sLine = oFile.ReadLine
aLine = Split(sLine, vbTab)
If Len(aLine(0)) > 0 Then
sXML = sXML & vbNewLine & "<computer><Name>" & aLine(0) & "</
Name><Status></Status><Reboot>0</Reboot><Enabled>-1</Enabled></
computer>"
End If
'
' If isArray(aLine) Then
' Else
' sXML = sXML & vbNewLine & "<name>" & TypeName(aLine) & "</
Name><Status></Status><Reboot>0</Reboot><Enabled>0</Enabled>"
' End If
Loop
oFile.Close
sXML = sXML & vbNewLine & "</computerlist>"
rc = xmlDoc.loadxml (sXML)
SetStatus "Loaded file: " & RC
Else
SetStatus "File Not Found"
End If
End Sub
Sub SetStatus(sMsg)
code.InnerHTML = "<textarea cols=100 rows=1>" & sMsg & "</textarea>"
End Sub
Sub cancel_OnClick
TheStatus.Value = "Cancel"
End Sub
Dim aThreadInfo
Dim iVal
Sub CheckBool()
SetStatus Now()
window.clearTimeout iVal
MsgBox "HH"
' iVal = window.setTimeout("CheckBool()", 100)
End Sub
Sub Process_OnClick
Call ProcessTest()
End Sub
Sub ProcessTest
Dim xmlDoc, xmlList, xmlComp
SetStatus "Processing"
Set xmlDoc = complist.XMLDocument
Set xmlList= xmlDoc.SelectNodes("computerlist/computer")
SetStatus TypeName(xmlList)
Redim aThreadInfo(MaxForks, 2)
Dim i
For i = 0 To UBound( aThreadInfo, 1)
Set aThreadInfo(i,0) = Nothing ' wshExec
aThreadInfo(i,1) = 0 ' Time
Set aThreadInfo(i,2) = Nothing ' xmlComp
Next
Dim xmlStatus, sEnabled, sCompName
' sEnabled = xmlComp.SelectSingleNode("Enabled").text
' If cBool(sEnabled) Then
' Else
' Set xmlStatus = xmlComp.SelectSingleNode("Status")
' xmlStatus.Text = "Disabled"
' End If
Dim iThread
For Each xmlComp in xmlList
iVal = window.setTimeout("CheckBool()", 100)
Set xmlStatus = xmlComp.SelectSingleNode("Status")
SetStatus "Processing: " & xmlComp.SelectSingleNode("Name").text
sCompName = xmlComp.SelectSingleNode("Name").text
xmlStatus.text = sCompName
sCommand = sCmdString & " /Workstation:" & sCompName
iThread = -1
Do until iThread <> -1
iThread = GetNextThread()
SetStatus "GetNextThread = -1"
' wscript.Sleep 100
Loop
Set aThreadInfo(iThread,0) = sh.exec(sCommand)
aThreadInfo(iThread,1) = Now()
Set aThreadInfo(iThread,2) = xmlComp
Do Until ProcessCheck()
' wscript.sleep 200
Loop
Next
Do Until ProcessCount()=0
'call ProcessCheck ()
Loop
End Sub
Dim idTimer
Sub PausedSection()
idTimer = window.setTimeout("PausedSection", 2000, "VBScript")
End Sub
Function GetNextThread ( )
Dim i
GetNextThread = -1
For i = 0 to UBound( aThreadInfo, 1)
If aThreadInfo( i, 1) = 0 then
GetNextThread = i
SetStatus "GetNextThread" & i
Exit Function
End if
Next
End Function
Function ProcessCount()
Dim i, t
call ProcessCheck ()
t=0
For i = 0 to UBound(aThreadInfo)
If NOT isNothing(aThreadInfo(i,0)) Then
t=t+1
End If
Next
ProcessCount=t
SetStatus "ProcessCount" & ProcessCount
End Function
Function ProcessFinished()
Dim i
ProcessFinished = True
'wscript.sleep 100
For i = 0 to UBound(aThreadInfo)
If NOT isNothing(aThreadInfo(i,0)) Then
ProcessFinished = False
End If
Next
End Function
Function ProcessCheck()
Dim i, stdOut
ProcessCheck = False
'wscript.sleep 100
For i = 0 to UBound(aThreadInfo)
If isNothing(aThreadInfo(i,0)) Then 'Check those objects that are
running
ProcessCheck = True
Else
If aThreadInfo(i, 0).Status = WshRunning Then
UpdateXMLStatus aThreadInfo(i, 2), Now() - aThreadInfo(i, 1)
' If Now-aThreadInfo(i,1) > MaxRunTime Then
' Call ProcessStdIO(aThreadInfo(i, 2), "Thread took longer than
MaxRunTime")
' DebugPrint "Terminating thread " & i & " and processid " &
aThreadInfo(i,0).ProcessID
' DebugPrint "Terminating thread Started:" & aThreadInfo(i,1)
' 'aThreadInfo(i,0).Terminate
' Run ".\kill.exe " & aThreadInfo(i,0).ProcessID
' wScript.Sleep 1000
' Set aThreadInfo(i,0) = Nothing
' aThreadInfo(i,1) = 0
' aThreadInfo(i,2) = vbNullString
' End If
Else
stdOut = vbNullString
stdOut = aThreadInfo(i, 0).StdOut.ReadAll
UpdateXMLStatus aThreadInfo(i, 2), "Completed"
'ProcessStdIO (aThreadInfo(i, 2), aThreadInfo(i,
0).StdOut.ReadLine)
aThreadInfo(i, 1) = 0
Set aThreadInfo(i, 0) = Nothing
Set aThreadInfo(i, 2) = Nothing
ProcessCheck = True
End If
End if
Next
End Function
Function isNothing(oTemp)
If TypeName(oTemp)="Nothing" Then isNothing = TRUE
End Function
Function UpdateXMLStatus(oXML, sStatus)
Dim xmlStatus
Set xmlStatus = oXML.SelectSingleNode("Status")
xmlStatus.Text = sStatus
End Function
Function ProcessCompThread (xmlComp)
End Function
</script>
<title>Gui Report Title</title>
</head>
<body>
<table border="0" width="100%">
<tr>
<td width="50%">FileName:<input type="file" value="FileName"
name="FileName" size="40"> <input type="button" value="Load"
name="Load" class="button"></td>
<td width="50%"><input type="button" value="Process"
name="Process" class="button" size=50></td>
</tr>
<tr>
<td width="50%">
<input type="button" value="OK" name="OK" class="button"><input
type="button" value="Cancel" name="Cancel" class="button"></td>
<td width="50%">ReportDir:<input type="text" value="ReportDir"
name="ReportDir" size="50"></td>
</tr>
<tr>
<td width="100%" colspan="2">
<div id="InsertBuildSelect"></div>
<table cellspacing="1" cellpadding="2" id="actionheader"
width="100%">
<tbody>
<tr>
<th width="300">Computer Name</th>
<th width="250">Status</th>
<th width="50">Enabled</th>
<th width="50">Reboot</th>
<th>output</th>
</tr>
</tbody>
</table>
<DIV STYLE="overflow: auto; width: 100%; height: 550; padding:0px;
margin: 0px">
<table datasrc="#complist" width="100%" cellspacing="1"
cellpadding="2" id="actionlist">
<tbody>
<tr>
<td width="300"><span datafld="Name"></span></td>
<td width="250"><span datafld="Status"></span></td>
<td width="50"><input type="checkbox" datafld="Enabled"
style="width:12; height:12" /></td>
<td><input type="checkbox" datafld="Reboot" style="width:12;
height:12" /></td>
</tr>
</tbody>
</table>
</DIV>
<table>
<td width="100%" colspan="2">
<div ID=code_header></div>
<div id="code"></div>
</td>
</table>
</div>
</td>
</tr>
</table>
<input type="hidden" name="TheStatus" size="20">
</body>
</html>
test.xml
<?xml version="1.0" encoding="utf-8"?>
<computerlist>
<computer><Name>ADMIN</Name><Status></Status><Reboot>0</
Reboot><Enabled>0</Enabled></computer>
<computer><Name>ADMIN1</Name><Status></Status><Reboot>0</
Reboot><Enabled>0</Enabled></computer>
<computer><Name>ADMIN2</Name><Status></Status><Reboot>0</
Reboot><Enabled>0</Enabled></computer>
</computerlist>