HTA Application problem - mshta.exe will not terminate

Prev: Outlook Express and VBScripts
Next: Scripting Printers

From: jmosow on 24 Feb 2005 16:26

---

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

From: "Michael Harris (MVP)" <mikhar at mvps dot on 24 Feb 2005 20:15

---

> 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.


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

From: jmosow on 24 Feb 2005 20:34

---

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.

From: "Michael Harris (MVP)" <mikhar at mvps dot on 24 Feb 2005 21:11

---

jmosow(a)yahoo.com wrote:
> 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.


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)...


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

From: jmosow on 25 Feb 2005 08:39

---

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>

<!--'************************************************
'***************************************************
-->

<head>
<hta:application id="VSSCompHTA"
APPLICATIONNAME="SourceSafe Compile"
BORDER="thin"
BORDERSTYLE="normal"
CAPTION="yes"
CONTEXTMENU="yes"
ICON=""
INNERBORDER="yes"
MAXIMIZEBUTTON="yes"
MINIMIZEBUTTON="yes"
NAVIGABLE="yes"
SELECTION="yes"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
SCROLL="yes"
VERSION="1.00"
WINDOWSTATE="normal">

<meta http-equiv="Content-Type" content="text/html;
charset=windows-1252">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title> VSSComp - SourceSafe Compiles</title>
</head>
<script language="vbscript">

' 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"><img id="logo" border="0" src="itilogo1.jpg"
width="157" height="60" alt="Rapid Input Form"></p>
-->
<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">&nbsp;
<input type="button" Style="height:30;width:70;position:relative"
value="End" name="END">&nbsp;</p>
</form>
</body>

<CENTER>
<font face='arial black'>
<hr color='black'>
</font>


<font color='red'>
<Div align="center" ID="UpperDiv"></Div>
</font>

<font face='arial black'>
<hr color='black'>
</font>

<Div align="left" ID="OutPut"></Div>

<font face='arial black'>
<hr color='BLACK'>
</font>

</CENTER>
</html>

 |  Next  |  Last
Pages: 1 2
Prev: Outlook Express and VBScripts
Next: Scripting Printers