HTA Application problem - mshta.exe will not terminate

jmo...@yahoo.com

unread,

Feb 24, 2005, 4:26:19 PM2/24/05

to

I am putting together an HTA application. In it, I have a Do/Loop that
will run until either a button is selected or the IE window is closed.
The button works fine. But, if I close the IE window, mshta.exe
remains running. I tried using onbeforeunload and setting the same
flags and doing the same process that I use for the button, but no
luck.

TIA

Michael Harris (MVP)

unread,

Feb 24, 2005, 8:15:07 PM2/24/05

to

I assume this is realted to your previous post...

I have seen the same behavior in HTAs that use WshShell.Run with the wait
option. Calling Run seems to break the modal nature of event handlers,
making the mshta UI responsive and even closable while the Run method is
still waiting. If mshta.exe is closed using the window's close button (RHS
of the title bar) or via the system menu (LHS of the title bar) or via
ALT+F4 or ... , then the UI closes but the mshta.exe process gets orphaned
and never terminates.

This is, at worst, a bug a mshta.exe or, at best, a known but undocumented
behavior.

You can try using an onbeforeunload event handler to warn that something is
still in progress.

For example, assign a global boolean variable to true (e.g., gBusy = true)
before calling the Run method. At the end of the eventhandler that calls
Run, assign the global variable to false (e.g., gBusy = false). In your
onbeforeunload, check gBusy and if it is true, use

window.event.returnValue = "Still busy...Please don't leave!!!!"

See the onbeforeunload documentation for how the returnValue is incorporated
into a warning dialog.

--
Michael Harris
Microsoft MVP Scripting
http://maps.google.com/maps?q=Sammamish%20WA%20US

jmo...@yahoo.com

unread,

Feb 24, 2005, 8:34:52 PM2/24/05

to

Thanks for the info. This is actually a different problem than from my
previous post. I have tried your suggestion. I don't think the Run is
the problem. I have an END button on the page and when I close the
document/window, all is good and mshta stops running. The problem is
only if I close the window using the X in the upper-right corner. Then
mshta stays running. I did try the onbeforunload, go throught the same
process and the END button, but mshta keeps on going.

Michael Harris (MVP)

unread,

Feb 24, 2005, 9:11:43 PM2/24/05

to

Without you providing actual code for a simplified repro case, it's
impossible to say what the problem is in your specific case.

You can always follow the recommeded method for

Updating the Display During Lengthy Operations
http://msdn.microsoft.com/library/en-us/dndude/html/dude02262001.asp

That eliminates the need for your sleep solution (which I still think is the
root cause)...

jmo...@yahoo.com

unread,

Feb 25, 2005, 8:39:23 AM2/25/05

to

Here is the HTA I am working on. I think the article you linked to
about updating the display is taken care of using the Sleep function I
wrote. The problem I am having is if I close the window using the X in
the upper-right corner. The mshta.exe continues to run. If I use the
End button, the mshta will quit.

<html>

' To Encode: screnc /e html rapidhta.hta Rapid.hta

Option Explicit

On Error Resume Next

Dim fso
Dim WshShell
Dim WshNetwork
Dim fil 'As Scripting.File
Dim fils 'As Scripting.Files
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim LogMessage
Dim LogFileName
Dim LogFile
Dim cvDate
Dim Log
Dim vbQuote
Dim WindowsDir
Dim StartTime
Dim StopFlag

Dim HostIP
Dim Version
Dim AppName
Dim ProgName
Dim SourceType

Dim WFLPipe
Dim WFLError

Const ForReading = 1, ForWriting = 2, ForAppending = 8

vbQuote = Chr(34)

Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
WindowsDir = WshShell.ExpandEnvironmentStrings("%windir%") & "\"

Set cvDate = new cvDateFormat
Set Log = New WriteLog

StopFlag = False

HostIP = "10.117.48.2"
Version = "2"
AppName = "3"
ProgName = "4"
SourceType = "5"

Sub End_onclick()

document.close
Window.Close
StopFlag = True

End Sub

Sub onbeforeunload

document.close
Window.Close
StopFlag = True

End Sub

Sub OnLoad

StartTime = Now()
UpperDiv.InnerHTML = "<b>Processing started at: " &
cvDate.FixDate(StartTime, "mm/dd/yyyy") & _
" " & cvDate.FixTime (StartTime, "Long") & "</b>"
document.VSSComp.END.disabled = False
document.VSSComp.START.disabled = False

End Sub

Sub Start_Onclick()

On Error Resume Next

Do

document.VSSComp.END.disabled = False
document.VSSComp.START.disabled = True
Stop
If StopFlag = True Then
alert("StopFlag1")

'document.parentNode.removeChild
Exit Sub
End If
WriteMessage "Waiting...."
Sleep (8)
Log.ProcessLogFiles
Log.WriteLog "StopFlag: " & StopFlag, True
If StopFlag = True Then
alert("StopFlag2")
Exit Sub
End If
ProcessFiles

Loop

End Sub

Sub ProcessFiles

On Error Resume Next

WriteMessage "Processing the WFL"
CreateWFLPipe HostIP, "SystemDisk", "COMPILE\START\" & SourceType &
Version & AppName & ProgName
WriteWFLPipe ""
WriteWFLPipe "USER=ITI;"
WriteWFLPipe "FAMILY DISK = DISK ONLY;"
WriteWFLPipe "DISPLAY " & Chr(34) & "BEGINNING JOB COMPILE/START/"
& SourceType & Version & AppName & ProgName & Chr(34) & ";"
WriteWFLPipe "RUN *SYSTEM/FTPUTILITY;"
WriteWFLPipe " FILE FTPIN = *TSS" & Version & "/" & AppName & "/"
& ProgName & "/FTP ON D;"
WriteWFLPipe " FILE FTPOUT (TITLE = *TSS" & Version & "/" &
AppName & "/" & ProgName & " ON D, FILEKIND=COBOL85SYMBOL);"
WriteWFLPipe "RUN *SYSTEM/FTPUTILITY;"
WriteWFLPipe " FILE FTPIN = *TSS" & Version & "/" & AppName & "/"
& ProgName & "/CNF ON D;"
WriteWFLPipe " FILE FTPOUT (TITLE = *CNF/A/C" & Version & "/" &
AppName & "/" & ProgName & " ON D, FILEKIND=DATA);"
WriteWFLPipe "RUN *SYSTEM/FTPUTILITY;"
WriteWFLPipe " FILE FTPIN = *TSS" & Version & "/" & AppName & "/"
& ProgName & "/WFL ON D;"
WriteWFLPipe " FILE FTPOUT (TITLE = *COMPILE/" & SourceType &
Version & AppName & ProgName & " ON DISK, FILEKIND=JOBSYMBOL);"
WriteWFLPipe "IF FILE *COMPILE/" & SourceType & Version & AppName &
ProgName & " ON DISK IS RESIDENT THEN"
WriteWFLPipe " PROCESS START *COMPILE/" & SourceType & Version &
AppName & ProgName & " ON DISK;"
WriteWFLPipe "REMOVE *TSS" & Version & "/" & AppName & "/" &
ProgName & "/FTP ON D;"
WriteWFLPipe "REMOVE *TSS" & Version & "/" & AppName & "/" &
ProgName & "/CNF ON D;"
WriteWFLPipe "REMOVE *TSS" & Version & "/" & AppName & "/" &
ProgName & "/WFL ON D;"
WriteWFLPipe "REMOVE *COMPILE/START/" & SourceType & Version &
AppName & ProgName & " ON DISK;"
CloseWFLPipe
StartWFLPipe HostIP, "Disk", "-COMPILE\START\" & SourceType &
Version & AppName & ProgName, True

End Sub

Function Sleep (WaitTime)

Dim WaitFile

On Error Resume Next

If Not fso.FileExists ("Wait.vbs") Then
Set WaitFile = fso.OpenTextFile ("Wait.vbs", ForWriting, True)
WaitFile.WriteLine "Set objArgs = WScript.Arguments"
WaitFile.WriteLine "If objArgs.Count > 0 Then"
WaitFile.WriteLine " WaitTime = objArgs(0)"
WaitFile.WriteLine "Else"
WaitFile.WriteLine " WaitTime = " & vbQuote & "10" & vbQuote
WaitFile.WriteLine "End If"
WaitFile.WriteLine "WScript.Sleep WaitTime * 1000"
WaitFile.Close
End If

WshShell.Run "Wait.vbs " & WaitTime, 0, TRUE

End Function

Function WriteMessage (Message)

Dim WriteNow
Dim I

WriteNow = Now()
OutPut.innerText = cvDate.FixDate(WriteNow, "mm/dd/yyyy") & " " &
cvDate.FixTime (WriteNow, "Long") & _
": " & Message
Sleep (1)

End Function

'''''''''' Create and Open and WFL Pipe Subroutine

Function CreateWFLPipe (WFLPipeHostName, WFLPipeShareName,
WFLPipeFileName)

Dim WFLPipeName

On Error Resume Next
Err.Clear

WshNetwork.MapNetworkDrive "", "\\" & HostIP & "\IPC$", False,
"ITI", ""
WFLPipeName = "\\" & WFLPipeHostName & "\PIPE\COPYX\JOB\" &
WFLPipeShareName & "\" & WFLPipeFileName
WFLPipeName = Replace(WFLPipeName, "\", "/")
WFLPipeName = UCase(WFLPipeName)

Set WFLPipe = fso.OpenTextFile(WFLPipeName, ForWriting, True)

If Err <> 0 Then
Log.ErrorMessage Err.number, Err.Description, "Error in
WFLProcess creating the WFL file " & WFLPipeName, True
WFLError = True
Exit Function
End If
WFLPipe.WriteLine ("BEGIN JOB "& Replace(UCase(WFLPipeFilename),
"\", "/") & ";")

End Function

Function WriteWFLPipe (WFLPipeText)

On Error Resume Next
Err.Clear

If WFLError = True Then
Exit Function
End If

WFLPipe.WriteLine Replace(UCase(WFLPipeText), "\", "/")
If Err <> 0 Then
Log.ErrorMessage Err.number, Err.Description, "Error in
WriteWFLPipe writing the WFL file " & WFLPipeName, True
WFLError = True
End If

End Function

Function CloseWFLPipe

If WFLError = True Then
Exit Function
End If

WriteWFLPipe ""
WriteWFLPipe "end job;"
WFLPipe.Write Chr(26) & CHR(26)
WFLPipe.close

If Err <> 0 Then
Log.ErrorMessage Err.number, Err.Description, "Error in WFLProcess
closing the WFL file " & WFLPipeName, True
WFLError = True
End If

End Function

Function StartWFLPipe (WFLPipeHostName, WFLPipePackName,
WFLPipeFileName, WaitOption)

Dim WFLPipeName
Dim WFLMsg
Dim X

On Error Resume Next

If WFLError = True Then
Exit Function
End If

If WFLPipePackName = "" Then
WFLPipePackName = "DISK"
End If

If Left(WFLPipeFileName, 1) = "*" Then
WFLPipeFileName = Replace(WFLPipeFileName, "*", "-")
End If
If Left(WFLPipeFileName, 1) <> "(" And Left(WFLPipeFileName, 1) <>
"-" And Left(WFLPipeFileName, 1) <> "_" Then
Log.WriteLog "Error in StartWFLPipe - the file name does not
include an * or a user code", True
WFLError = True
Exit Function
End If

WFLPipeName = UCase("\\" & WFLPipeHostName & "\PIPE\WFLD\" &
WFLPipeFileName & "\_ON_\" & WFLPipePackName)
WFLPipeName = Replace(WFLPipeName, "/", "\")

' Read PIPE for WFL status

Log.WriteLog "Starting workflow", True
Set WFLPipe = fso.OpenTextFile(WFLPipeName, ForReading, True)
If Err <> 0 Then
Log.ErrorMessage Err.number, Err.Description, "Error in WFLProcess
opening WFLD pipe for file " & WFLPipeName, True
WFLError = True
Exit Function
End If

If WaitOption = False Then
WflPipe.Close
Log.WriteLog "Not waiting for WFL response messages", True
Exit Function
End If

X = " "
Do While ASC(X) <> 26 and ASC(X) <> 63
X = WFLPipe.Read(1)
If ASC(X) <> 26 and ASC(X) <> 63 Then
WFLMsg = WFLMsg + x
End If
Err.Clear

Loop
WFLPipe.Close

Log.WriteLog "Finished workflow", True
Log.WriteLog "", True
WFLMsg = UCase(WFLMsg)

If Instr(WFLMsg, "[WFL1]") = 0 or Instr(WFLMsg, "[WFL2]") = 0 then
WFLMsg = " **** WFL Error **** " & vbCrlf & WFLMsg
Log.ErrorMessage Err.number, Err.Description, "Error in WFLProcess
during WFLD pipe read for " & WFLPipeName, True
WFLError = True
Exit Function
End If

End Function

'////////////////////////////////////////////////////////

Class WriteLog

Private Function m_LogFileName

m_LogFileName = Left(document.location.pathname,
InstrRev(document.location.pathname, "\")) & _
cvDate.FixDate (Now(), "mmddyyyy") & "." & _
Right(document.location.pathname,
Len(document.location.pathname) - InstrRev(document.location.pathname,
"\")) & _
".LOG.TXT"
m_LogFileName = Replace(m_LogFileName, "%20", " ")

End Function

Private Sub Class_Initialize
End Sub

Public Property Get LogFileName

LogFileName = m_LogFileName

End Property

Public Property Let LogFileName(FileName)

m_LogFileName = FileName

End Property

Public Function ProcessLogFiles

Dim fol
Dim fil
Dim fils
Dim ScriptPath

If fso.FileExists(m_LogFileName) Then
'Log.WriteLog "", True
'Log.WriteLog "", True
Exit Function
End If

Log.WriteLog String(30, "*"), True
Log.WriteLog "Log File " & m_LogFileName & " Created at " &
StartTime, True
Log.WriteLog "", True
Log.WriteLog String(30, "*"), True
Log.WriteLog "Cleaning up old log files...", True

ScriptPath = Replace(document.location.pathname, "%20", " ")
ScriptPath = Left(ScriptPath, InstrRev(ScriptPath, "\"))
Set fol = fso.GetFolder(ScriptPath)
Set fils = fol.Files
Err.Clear
For Each fil in fils
If Instr(UCase(fil.name), Ucase(document.location.pathname)
& ".LOG.TXT") > 0 _
and DateDiff("d", fil.DateCreated, Now) > 7 Then
Log.WriteLog fil.Name & " is being deleted - Date
Created - " & fil.DateCreated, True
fso.DeleteFile fil.name, True
End If
Next
Log.WriteLog "", True

End Function

Public Function ErrorMessage (ErrorNumber, ErrorDescription,
LogMessage, PrintDateFlag)

WriteLog "", PrintDateFlag
WriteLog "*** " & LogMessage & " Error Number: " & ErrorNumber
& " Error Description: " & _
ErrorDescription, PrintDateFlag
WriteLog "", PrintDateFlag

End Function

Public Function WriteLog (LogMessage, PrintDateFlag)

Dim WriteNow
Dim LogFile

WriteNow = Now()
Set LogFile = fso.OpenTextFile(LogFileName, ForAppending,
True)
If PrintDateFlag = False Then
LogFile.WriteLine Space(Len(cvDate.FixDate(WriteNow,
"mm/dd/yyyy") & " " & _
cvDate.FixTime (WriteNow, "Long") & ": ")) & LogMessage
Else
LogFile.WriteLine cvDate.FixDate(WriteNow, "mm/dd/yyyy") &
" " & _
cvDate.FixTime (WriteNow, "Long") & ": " & LogMessage
End If
LogFile.Close

End Function

End Class

'////////////////////////////////////////////////////////

Class cvDateFormat

' Use: FixDate(valid date string, format string)

Public Function FixDate(strDate,format)

Dim d
Dim m
Dim y

d = DatePart("D",strDate)
m = DatePart("M",strDate)
y = DatePart("YYYY",strDate)

If Len(d) < 2 Then
d = "0" & d
End If

If Len(m) < 2 Then
m = "0" & m
End If
Select Case LCase(Format)
Case LCase("yyyy/mm/dd")
FixDate = y & "/" & m & "/" & d
Case LCase("yy/mm/dd")
FixDate = right(y,2) & "/" & m & "/" & d
Case LCase("dd/mm/yy")
FixDate = d & "/" & m & "/" & right(y,2)
Case LCase("dd/mm/yyyy")
FixDate = d & "/" & m & "/" & y
Case LCase("yyyy-mm-dd")
FixDate = y & "-" & m & "-" & d
Case LCase("yy-mm-dd")
FixDate = right(y,2) & "-" & m & "-" & d
Case LCase("dd-mm-yy")
FixDate = d & "-" & m & "-" & right(y,2)
Case LCase("dd-mm-yyyy")
FixDate = d & "-" & m & "-" & y
Case LCase("mm/dd/yyyy")
FixDate = m & "/" & d & "/" & y
Case LCase("ddmmyyyy")
FixDate = d & m & y
Case LCase("ddmmyy")
FixDate = d & m & right(y,2)
Case LCase("mmddyy")
FixDate = m & d & right(y,2)
Case LCase("mmddyyyy")
FixDate = m & d & y
Case LCase("yyyymmdd")
FixDate = y & m & d
Case LCase("yymmdd")
FixDate = right(y,2) & m & d
Case LCase("yyyy")
FixDate = y
Case LCase("short")
FixDate = FormatDateTime(strDate,vbShortDate)
Case LCase("long")
FixDate = FormatDateTime(strDate,vbLongDate)
Case LCase("dd-month-yyyy")
m = MonthName (m, True)
FixDate = d & "-" & m & "-" & y
Case LCase("dd-month-yy")
m = MonthName (m, True)
FixDate = d & "-" & m & "-" & right(y,2)
Case LCase("dayname")
FixDate = WeekDayName(Weekday(strDate), False)
Case LCase("daynameabbr")
FixDate = WeekDayName(Weekday(strDate), True)
Case LCase("sitedate")
FixDate = WeekDayName(Weekday(strDate), False) & ", " &
DateSuffix(DatePart("D",strDate)) & _
" of " & MonthName(m, False) & ", " &
FixDate(strDate,"yyyy")
Case LCase("stamp")
FixDate = fixdate(Now(),"yyyymmdd") &
FixTime(Now(),"Stamp")
Case Else
FixDate = d & "/" & m & "/" & y
End Select

End Function

Private Function DateSuffix(num)

Dim x

If num < 13 or num > 20 Then
Select Case Right(num,1)
Case "0"
x = "th"
Case "1"
x = "st"
Case "2"
x = "nd"
Case "3"
x = "rd"
Case else
x = "th"
End Select
End If

If num > 12 and num < 21 Then
x = "th"
End If

DateSuffix = num & x

End Function

Public Function FixTime(strTime,format)

Dim h
Dim m
Dim s

h = Hour(strTime)
m = Minute(strTime)
s = Second(strTime)

If s < 10 Then
s = "0" & s
End If

If m < 10 Then
m = "0" & m
End If

If h < 10 Then
h = "0" & h
End If

Select Case LCase(format)
Case LCase("hh:mm:ss")
FixTime = h & ":" & m & ":" & s
Case LCase("hhmmss")
FixTime = h & m & s
Case LCase("Stamp")
FixTime = h & m & s
Case LCase("Long")
FixTime = FormatDateTime(strTime,vbLongTime)
Case LCase("Short")
FixTime = FormatDateTime(strTime,vbShortTime)
Case Else
FixTime = FormatDateTime(strTime,vbShortTime)
End Select

End Function

End Class

'////////////////////////////////////////////////////////

</script>

<body onload="OnLoad" onbeforeunload="onbeforeunload" style="font:10pt
verdana">
<form name="VSSComp">

<p align="center"><em><font size="5">SourceSafe
Compiles</font></em></p>
<hr>
<p align="center"><input type="button"
Style="height:30;width:70;position:relative" value="Start"
name="START"> 
<input type="button" Style="height:30;width:70;position:relative"
value="End" name="END"> </p>
</form>
</body>

</CENTER>
</html>

Michael Harris (MVP)

unread,

Feb 25, 2005, 10:25:03 PM2/25/05

to

jmo...@yahoo.com wrote:
> Here is the HTA I am working on. I think the article you linked to
> about updating the display is taken care of using the Sleep function I
> wrote. The problem I am having is if I close the window using the X
> in the upper-right corner. The mshta.exe continues to run. If I use
> the End button, the mshta will quit.

Here's a simpler example to follow that illustrates the points I was trying
to make. It assumes you have sleep.exe from the w2k or winxp reskit
installed.

Save and run it as a *.hta ...

<html>
<head>
<script language="vbscript">
dim gBusy
sub demo()
gBusy = true
set shell = createobject("wscript.shell")
msg.innertext = "running..."
shell.run "sleep.exe 60",7,true
msg.innertext = "finished..."
gBusy = false
end sub
sub checkBusy()
if gBusy then
window.event.returnValue = "Still busy..."
end if
end sub
</script>
</head>
<body onbeforeunload="call checkBusy()">
<div style="width:50%;font:x-small verdana;">
<p>Click 'demo' to execute sleep.exe 60 in a minimized window
<nobr>(shell.run "sleep.exe 60",7,true)...</nobr>
<p>Click 'close' to within 60 seconds to trigger the onbeforeload
warning.
<p>Notice that the call to shell.run lets the UI refresh and
also lets you click the close button even though the demo event
handler is still running (waiting for shell.run to return).
<p>Also notice that if you cancel the window.close, the modality
of the of shell.run call is broken as well, i.e. as soon as
the window.close is canceled, execution of the demo event handler
resumes immediately after the shell.run call even though
</div>
<hr>
<input type="button" onclick="call demo()" value="demo">
<input type="button" onclick="window.close" value="close">
<hr>
<div id="msg">
</div>
</body>
</html>

jmo...@yahoo.com

unread,

Feb 28, 2005, 2:22:14 PM2/28/05

to

Thanks for the sample. My HTA does something similar. I do have an
END button. If I click the END button, the mshta will terminate.
However, if I do an 'abnormal' terminate of the HTA by just closing the
window, the mshta is orphaned. I have not been able to determine how
to get around this.

dieseyer.de

unread,

Mar 22, 2005, 1:07:06 PM3/22/05

to

Hallo!

<Alt-F4> close hta-window - 'mshta-engine', but it don't stop, when a
permanent Do..Loop is running.

Put your Do..Loop in a procedure (without Do..Loop) and call this:

YesIntervall = window.setInterval( "EveryTime",1000 )

Example: http://dieseyer.de/scr-html/120minReboot.hta