.
<html>
<head>
<title>My Script</title>
<script language="VBScript">
Option Explicit
Dim blnQuit
Sub MyLogic()
Dim {some stuff}
{code}
Do While Not blnQuit
{loop code}
Loop
If blnQuit Then
{early quit cleanup code}
Else
{normal completion code}
End If
End Sub
Sub btnQuit_onclick()
{other "quit" stuff, "are you sure" MsgBox, etc.}
blnQuit = True
End Sub
Sub window_onload()
{init code if any}
MyLogic
{finish code if any}
End Sub
</script>
</head>
<body>
Welcome to the amazing <i>My Script.</i><br>
I'm doing important stuff, quit if you get<br>
tired of waiting.<br>
<input type="button" id="btnQuit" value="Quit">
</body>
</html><html>
<head>
<script language="Javascript">
function VBDecodeURI(s) {
return decodeURI(s)
}
</script>
<script language="VBScript">
Option Explicit
Dim blnQuit
Dim FSO
Const ForReading = 1
Sub btnQuit_onclick()
blnQuit = True
End Sub
Sub ShowText(ByVal strNewText)
Dim strText
strText = txtDisplay.innerText
'Trim back the history text occasionally.
If Len(strText) > 6000 Then
strText = Right(strText, 4000)
End If
txtDisplay.innerText = strText & vbNewLine & strNewText
txtDisplay.doScroll "down"
End Sub
'---------------------------------------------------------
'Looper Begins
'
'Special "subroutine" that contains a hard loop within
'which we need to simulate VB's *DoEvents* functionality.
'Looper control.
Dim LPRTIMER
'Global Looper data & objects that must be preserved
'across iterations.
Dim LPRtsIn, LPRblnOpen, LPRstrFName
Sub Looper()
'Do everything prior to the loop.
LPRstrFName = VBDecodeURI(document.location.pathname)
If Left(LPRstrFName, 1) = "/" Then
'Running as HTM, truncate leading "/" char.
LPRstrFName = Mid(LPRstrFName, 2)
End If
LPRTIMER = window.setInterval("Looper_Loop", 100, "VBScript")
End Sub
Sub Looper_Loop()
'Loop control and logic within the loop.
If blnQuit Then
window.clearInterval LPRTIMER
Looper_Finish
Else
If Not LPRblnOpen Then
Set LPRtsIn = FSO.OpenTextFile(LPRstrFName, ForReading)
LPRblnOpen = True
End If
If Not LPRtsIn.AtEndOfStream Then
ShowText(LPRtsIn.ReadLine)
Else
LPRtsIn.Close
Set LPRtsIn = Nothing 'Release reference.
LPRblnOpen = False 'Remind myself next trip.
End If
End If
End Sub
Sub Looper_Finish()
'Do everything after the loop.
If IsObject(LPRtsIn) Then
LPRtsIn.Close
Set LPRtsIn = Nothing
LPRblnOpen = False
End If
End Sub
'Looper Ends
'---------------------------------------------------------
Sub window_onload()
Set FSO = CreateObject("Scripting.FileSystemObject")
Looper
End Sub
Sub window_onunload()
Set FSO = Nothing
End Sub
</script>
</head>
<body style="background-color: #bbbbee">
<h2>Simple HTM/HTA "DoEvents" demonstration:</h2>
<p>This script will list itself over and
over until you press Quit.</p>
<p>
<textarea id="txtDisplay"
style="background-color: #ccccff"
rows="25" cols="72" readonly="true">
</textarea>
</p>
</body>
</html> <body style="background-color: #bbbbee">
<h2>Simple HTM/HTA "DoEvents" demonstration:</h2>
<p>This script will list itself over and
over until you press Quit.</p>
<p>
<textarea id="txtDisplay"
style="background-color: #ccccff"
rows="25" cols="72" readonly="true">
</textarea>
</p> <p><input type="button" id="btnQuit" value="Quit"></p> </body>