alternative to Wscript.Quit for use in HTA

[mggu...@gmail.com]

I have written a simple script to copy some files and then run
sysprep.
When a file or folder does not exist I use the wscript.quit command to
stop the script.

In order for my script to be more user friendly I would like to use a
HTA.
I have searching on the internet for the past 3 days and can not find
a answer to this question.

How to I quit a vbscript inside a HTA. (with quiting the current HTA
window)

here is my sample vbscript:

Sub copynetworkfiles
Dim Titlenetwork
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(NetworkFolder) Then
objFSO.CopyFile NetworkFolder & "*.*" , "c:\sysprep" ,
OverwriteExisting
Dirlog = Dirlog & "Copied Folder All Files From " & NetworkFolder &
strDriveLetter & VbCrLf
Else
Titlenetwork = "No Network Drive"
MsgBox "Unable to find " & NetworkFolder & VbCrLf & "Script will now
quit", 16 , Titlenetwork
WScript.quit
End If
End Sub

Once I port this to hta the wscript.quit does not work. Now I
understand why I just want a way to stop the script running.

At the moment I have about 10 subs and the script just keeps running
and will therefore error more and more.

Really looking for easy workaround, I have read that maybe forcing an
error may work and then write an error on for that error return code?

Any Ideas???????????????????

[Bob Barrows [MVP]]

You don't "quit" an hta, except by closing the window in which it is running
(window.close). An hta is a user interface, under a user's control. This is
quite different from a script running in the background which has to unload
itself with no user intervention. Why are you using an hta if you don't want
the user to be involved in the process?

I think what you want in that sub is "exit Sub", but frankly, I'm wondering
why you feel it is necessary. That sub is going to end anyways at that
point, whether you put an Exit Sub or WScript.Quit statement there or not.

--
Microsoft MVP - ASP/ASP.NET
Please reply to the newsgroup. This email account is my spam trap so I
don't check it very often. If you must reply off-line, then remove the
"NO SPAM"

[mggu...@gmail.com]

On May 6, 11:32 pm, "Bob Barrows [MVP]" <reb01...@NOyahoo.SPAMcom>
wrote:

I am very sorry I did not explain myself correctly.

The reason I have designed this HTA is I have 4 different type of
sysprep images to prepare with this script.

English Laptops and Workstations also Japanese version of each. As you
can imagine these all need different sysprep.inf files and some other
major settings (can not discuss as it is for my work)

I have my vbscript working well and I have each sysprep scenario
covered. However I already created nice GUI for the user to select
which version they will be using. (using my workplaces colours and
logo's looks great)

So what is happing is that after the sub exit's it goes back and keeps
running the other 9 subs although once it errors I want it to STOP.

Here are some workarounds that I have though about since my first
post.

1.use the shell.run command to run the vb script from the command
prompt using an argument to advise the script which type of sysprep I
am using.
2.Have a new window created when the script runs from the button press
in the hta and then just close the window on the error.

anyhow I would love some more feedback on this. :-)

More code here.

Sub ENthinkpad
sysprepname= "English Thinkpad"
NetworkFolder = strDriveLetter & "\EN\Thinkpad\"
vbsFolderFile1 = "\AutoRunPostSecondBoot_tp.vbs"
vbsFolderFile2 = "\PostFirstBoot_tp.vbs"
Setwallpaper
start(sysprepname)
MapDrive
createlocalFolder
createsysprepfolder
createOEMFolder
copynetworkfiles
removenetworkdrive
DisplayDirLog
copylocalfiles
runSysprepquestion
End Sub

Sub Setwallpaper
Dim NewWallpaperFile
NewWallpaperFile = SysprepType.WallpaperFile.Value
If SysprepType.WallpaperFile.Value ="" Then
MsgBox "You must select a wallpaper", vbCritical, "No wallpaer
Selected"
Else
objFSO.CopyFile NewWallpaperFile , "c:\windows\imagewallpaper.bmp" ,
OverwriteExisting
End If
End Sub

Sub MapDrive
Dim CheckDrive, AlreadyConnected, intDrive

' This sections creates two objects:
' objShell and objNetwork and counts the drives
Set objNetwork = CreateObject("WScript.Network")
Set CheckDrive = objNetwork.EnumNetworkDrives()

' This section deals with a For ... Next loop
' See how it compares the enumerated drive letters
' with strDriveLetter

On Error Resume Next
AlreadyConnected = False
For intDrive = 0 To CheckDrive.Count - 1 Step 2
If CheckDrive.Item(intDrive) =strDriveLetter _
Then AlreadyConnected =True
Next

' This section uses the If = then, else logic
' This tests to see if the Drive is already mapped.
' If yes then disconnects
If AlreadyConnected = True Then
objNetwork.RemoveNetworkDrive strDriveLetter
Pause(10)
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, strProfile,
strUser, strPassword

' The first message box
Dirlog = VbCrLf & "Disconnected " & strDriveLetter & " Drive" & VbCrLf
& _
"Mapped " & strRemotePath & " To " & strDriveLetter & " Drive" &
VbCrLf & _
" Authenticated using " & strUser & " credentials."
Else
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath
Dirlog = VbCrLf & "Mapped " & strRemotePath & " To " & strDriveLetter
& " Drive" & VbCrLf & _
"Authenticated using " & strUser & " credentials." & VbCrLf
End If
End Sub

Sub createlocalFolder
Const OverwriteExisting = True
Dim objFolder, createlocalFolderLog
Dirlog = Dirlog & VbCrLf
If objFSO.FolderExists(localFolder) Then
Call DeleteFiles(localFolder , createlocalFolderLog)
objFSO.DeleteFolder(localFolder)
Set objFolder = objFSO.CreateFolder(localFolder)
Dirlog = Dirlog & createlocalFolderLog & "Removed Folder " &
localFolder & VbCrLf & "Created " & localFolder & VbCrLf
Else
Set objFolder = objFSO.CreateFolder(localFolder)
Dirlog = Dirlog & "Created" & localFolder & VbCrLf
End If
End Sub

Sub createsysprepfolder
Const OverwriteExisting = True
Dim objFolder, createSysprepFolderLog
Dirlog = Dirlog & VbCrLf
If objFSO.FolderExists(SysprepFolder) Then
Call DeleteFiles(SysprepFolder , createSysprepFolderLog)
objFSO.DeleteFolder(SysprepFolder)
Set objFolder = objFSO.CreateFolder(SysprepFolder)
Dirlog = Dirlog & createSysprepFolderLog & "Removed Folder " &
SysprepFolder & VbCrLf & "Created " & SysprepFolder & VbCrLf
Else
Set objFolder = objFSO.CreateFolder(SysprepFolder)
Dirlog = Dirlog & "Created" & SysprepFolder & VbCrLf
End If
End Sub

Sub createOEMFolder
Dim systemroot, objEnv, objFolder
Set WshShell = CreateObject("WScript.Shell")
Set objEnv = WshShell.Environment("Process")
systemroot = objEnv("SYSTEMROOT")
systemrootfolder = systemroot & "\$OEM$"
Dirlog = Dirlog & VbCrLf
If objFSO.FolderExists(systemrootfolder) Then
Dirlog = Dirlog & "Found " & systemrootfolder & VbCrLf & "Do not
need to create " & systemrootfolder & VbCrLf
Else
Set objFolder = objFSO.CreateFolder(systemrootfolder)
Dirlog = Dirlog & "Created " & systemrootfolder & VbCrLf
End If
End Sub

Function deletefiles(folder, Deletefilelog)
Dim objWMIService, colFileList, objFile
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root
\cimv2")

Set colFileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & folder & "'} Where " _
& "ResultClass = CIM_DataFile")

If colFileList.Count = 0 Then
Deletefilelog = "There were " & colFileList.Count & " files to delete
in " & folder & VbCrLf
Else
Deletefilelog = "Deleted " & colFileList.Count & " Files From " &
folder & VbCrLf
For Each objFile In colFileList
objFile.Delete
Next
End If
End Function

Sub copynetworkfiles
Dim Titlenetwork
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(NetworkFolder) Then
objFSO.CopyFile NetworkFolder & "*.*" , "c:\sysprep" ,
OverwriteExisting

Pause(5)
Dirlog = Dirlog & VbCrLf & "Copied All Files From " & NetworkFolder &

VbCrLf
Else
Titlenetwork = "No Network Drive"
MsgBox "Unable to find " & NetworkFolder & VbCrLf & "Script will now
quit", 16 , Titlenetwork

Quit
End If
End Sub

Sub removenetworkdrive
objNetwork.RemoveNetworkDrive strDriveLetter
Dirlog = Dirlog & VbCrLf & "Disconnected " & NetworkFolder & VbCrLf
End Sub

Sub DisplayDirLog
Dim TitleDirLog
TitleDirLog = "List of Folders Created & Copied"
MsgBox Dirlog & Deletefilelog, vbInformation & vbOKOnly, TitleDirLog
End Sub

Sub copylocalfiles

Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim newlocalFolder, newsystemrootfolder, filelog, errorlog, TitleBad,
TitleGood
newlocalFolder = localFolder & "\"
newsystemrootfolder = systemrootfolder & "\"
TitleBad = "Error Finding The Following Files"
TitleGood = "All Required Files were Copied"

If objFSO.FileExists(localFolderFile1) Then
objFSO.MoveFile localFolderFile1 , newlocalFolder
filelog = "Moved " & localFolderFile1 & " to " & newlocalFolder &
VbCrLf
Else
errorlog = localFolderFile1 & VbCrLf
End If

If objFSO.FileExists(localFolderFile2) Then
objFSO.MoveFile localFolderFile2 , newlocalFolder
filelog = filelog & "Moved " & localFolderFile2 & " to " &
newlocalFolder & VbCrLf
Else
errorlog = errorlog & localFolderFile2 & VbCrLf
End If

If objFSO.FileExists(localFolderFile3) Then
objFSO.MoveFile localFolderFile3 , newlocalFolder
filelog = filelog & "Moved " & localFolderFile3 & " to " & VbCrLf
Else
errorlog = errorlog & localFolderFile3 & VbCrLf
End If

If objFSO.FileExists(localFolderFile4) Then
objFSO.MoveFile localFolderFile4 , newlocalFolder
filelog = filelog & "Moved " & localFolderFile4 & " to " &
newlocalFolder & VbCrLf
Else
errorlog = errorlog & localFolderFile4 & VbCrLf
End If

If objFSO.FileExists(systemrootFolderFile5) Then
objFSO.CopyFile systemrootFolderFile5 , newsystemrootfolder,
OverwriteExisting
filelog = filelog & "Moved " & systemrootFolderFile5 & " to " &
newsystemrootfolder & VbCrLf
Else
errorlog = errorlog & systemrootFolderFile5 & VbCrLf
End If

If objFSO.FileExists(systemrootFolderFile6) Then
objFSO.copyFile systemrootFolderFile6 , newsystemrootfolder,
OverwriteExisting
filelog = filelog & "Moved " & systemrootFolderFile6 & " to " &
newsystemrootfolder & VbCrLf
Else
errorlog = errorlog & systemrootFolderFile6 & VbCrLf
End If

If objFSO.FileExists(vbsFolderFile1) Then
objFSO.MoveFile vbsFolderFile1 , newlocalFolder
filelog = filelog & "Moved " & vbsFolderFile1 & " to " &
newlocalFolder & VbCrLf
Else
errorlog = errorlog & vbsFolderFile1 & VbCrLf
End If

If objFSO.FileExists(vbsFolderFile2) Then
objFSO.MoveFile vbsFolderFile2 , newlocalFolder
filelog = filelog & "Moved " & vbsFolderFile2 & " to " &
newlocalFolder & VbCrLf
Else
errorlog = errorlog & vbsFolderFile2 & VbCrLf
End If

If errorlog ="" Then
MsgBox filelog, vbInformation & vbOKOnly, TitleGood
Else
MsgBox errorlog, vbCritical & vbOKOnly, TitleBad
End If
End Sub

Sub runSysprepquestion
Dim intAnswer, reallyquit
intAnswer = _
MsgBox ("Ready To Start Sysprep?", vbQuestion + vbYesNo, "Sysprep
Launch")
If intAnswer = vbYes Then
Runsysprep
Else
reallyquit = _
MsgBox ("Do you really want to exit from running sysprep?",
vbQuestion + vbYesNo, "Sysprep Launch")
If reallyquit = vbYes Then
Quit
Else
runSysprepquestion
End If
End If
End Sub

Sub Runsysprep
objShell.Run "c:\sysprep\sysprep.exe -mini -reseal -quiet"
End Sub

Sub Quit
End Sub

Sub Pause(intSeconds)
Dim strCommand
Dim objShell
strCommand = "cmd /c ping -n " & intSeconds & " 127.0.0.1>nul"
Set objShell = CreateObject("WScript.Shell")
objShell.Run strCommand,0,1
End Sub

</script>

</head>

<body>
<form name="SysprepType">
<div id="framecontentLeft">
<div class="innertube">

</div>
</div>

<div id="framecontentRight">
<div class="innertube">

</div>
</div>

<div id="framecontentTop">
<div class="innertube">
<IMG SRC="pix_xtra/apdc logo small.bmp" border="0" align=left
alt="LOGO SMALL">
<center><h1>Sysprep Setup</h1></center>

</div>
</div>

<div id="framecontentBottom">
<div class="innertube">
<CENTER>
<SCRIPT TYPE="text/javascript" LANGUAGE="JavaScript">
document.writeln('<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0
WIDTH=253>')
document.writeln('<TR><TD COLSPAN=5><IMG SRC="pix_xtra/topmod_e.gif"')
document.writeln('alt="" WIDTH=253 HEIGHT=33><\/TD>')
document.writeln('<\/TR><TR>')
document.writeln('<TD><IMG SRC="pix_xtra/left.gif" alt="" WIDTH=12
HEIGHT=20><\/TD>')

testMod()

document.writeln('<TD><IMG SRC="pix_xtra/right.gif" alt="" WIDTH=12
HEIGHT=20><\/TD>')
document.writeln('<\/TR><TR>')
document.writeln('<TD COLSPAN=5><IMG SRC="pix_xtra/bottom.gif"')
document.writeln('alt="" WIDTH=253 HEIGHT=12><\/TD>')
document.writeln('<\/TR><\/TABLE>')
</SCRIPT>
<i>Created By</i><br>
</CENTER>

</div>
</div>

<div id="maincontent">
<div class="innertube">
<br>
<h2>You Must Select Your Image Wallpaper</h2>
<input
type="file"
name="WallpaperFile"
size="50">
<input
type="button"
name="Quit"
value="Quit"
title="Quit"
onClick=window.close()>
<hr>
<input
type="button"
name="English Thinkpad"
class="ENbutton"
value="EN Thinkpad"
title="English Thinkpad"
onMouseOver="goLite(this.form.name,this.name)"
onMouseOut="goDim(this.form.name,this.name)"
onClick="ENthinkpad()">
<IMG SRC="pix_xtra\australC_1xa.gif" border="0" align=middle
alt="AUS Flag">
<input
type="button"
name="English Workstation"
class="ENbutton"
value="EN Workstation"
title="English Workstation"
onMouseOver="goLite(this.form.name,this.name)"
onMouseOut="goDim(this.form.name,this.name)"
onClick="ENWorkstation()">
<hr>
<input
type="button"
name="Japanese Thinkpad"
class="JPbutton"
value="JP Thinkpad"
title="Japanese Thinkpad"
onMouseOver="goLiteJP(this.form.name,this.name)"
onMouseOut="goDimJP(this.form.name,this.name)"
onClick="JPthinkpad()">
<IMG SRC="pix_xtra\japanCg1e.gif" border="0" align=middle
alt="Japan Flag">
<input
type="button"
name="Japanese Workstation"
class="JPbutton"
value="JP Workstation"
title="Japanese Workstation"
onMouseOver="goLiteJP(this.form.name,this.name)"
onMouseOut="goDimJP(this.form.name,this.name)"
onClick="JPWorkstation()">
<hr>

</form>
</div>
</div>

[Mark Ivey]

What about a simple error handler:

' http://msdn2.microsoft.com/en-us/library/5hsw66as(VS.80).aspx
Public Sub OnErrorDemo()
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim x As Integer = 32
Dim y As Integer = 0
Dim z As Integer
z = x / y ' Creates a divide by zero error
On Error GoTo 0 ' Turn off error trapping.
On Error Resume Next ' Defer error trapping.
z = x / y ' Creates a divide by zero error again
If Err.Number = 6 Then
' Tell user what happened. Then clear the Err object.
Dim Msg As String
Msg = "There was an error attempting to divide by zero!"
MsgBox(Msg, , "Divide by zero error")
Err.Clear() ' Clear Err object fields.
End If
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 6 ' Divide by zero error
MsgBox("You attempted to divide by zero!")
' Insert code to handle this error
Case Else
' Insert code to handle other situations here...
End Select
Resume Next ' Resume execution at same line
' that caused the error.
End Sub

Mark Ivey

<mggu...@gmail.com> wrote in message
news:1178513116.4...@y5g2000hsa.googlegroups.com...

[Michael Harris (MVP)]

Mark Ivey wrote:
> What about a simple error handler:
>
>
> ' http://msdn2.microsoft.com/en-us/library/5hsw66as(VS.80).aspx
> Public Sub OnErrorDemo()
> On Error GoTo ErrorHandler ' Enable error-handling routine.

That would be great if _VBScript_ supported it like VB/VBA does ;-).

--
Michael Harris
Microsoft.MVP.Scripting

[Mark Ivey]

Michael,

Please educate me a bit...

I am still a bit new to scripting, but am a pretty avid user of VBA. I have
used some basic error handling with VBS before. Are you saying that it does
not work well with them? Please tell me more. I am very interested in
learning about scripting.

Mark Ivey

"Michael Harris (MVP)" <mikhar.at.mvps.dot.org> wrote in message
news:%233r4m5P...@TK2MSFTNGP03.phx.gbl...

[Michael Harris (MVP)]

Mark Ivey wrote:
> Michael,
>
> Please educate me a bit...
>
> I am still a bit new to scripting, but am a pretty avid user of VBA.
> I have used some basic error handling with VBS before. Are you saying
> that it does not work well with them? Please tell me more. I am very
> interested in learning about scripting.

'On Error Goto MyErrorHandler' isn't supported because labels aren't
supported in VBScript.

VBScript has only two flavors of 'On Error ...'

On Error Resume Next
On Error Goto 0

--
Michael Harris
Microsoft.MVP.Scripting

[Mark Ivey]

Now I see what you are talking about...

Thx for the explanation.

"Michael Harris (MVP)" <mikhar.at.mvps.dot.org> wrote in message

news:OmwZm7Rk...@TK2MSFTNGP02.phx.gbl...

[christophercrossen]

Sorry this reply is almost a year late, but just in case someone stumbles across this post looking for a solution to this issue here's a couple of alternatives to Wscript.Quit which work well in an HTA.

The following procedure is the most basic way of quitting an HTA and can be called from anywhere within the <SCRIPT></SCRIPT> section of the HTA:

'** SOFT EXIT CODE
Sub QuitHTA
window.close()
End Sub

However, there's a bug whereas mshta.exe stays resident in memory after the HTA closes when using this window.close() event if your HTA is currently shelling an external application when you call the event. If your HTA is set to only allow one instance to run at a time, when this bug occurs, you cannot run your HTA again until you kill the mshta.exe process.

The following solution gets around the bug and closes your HTA by killing it's process upfront:

'** HARD EXIT CODE
Sub ExitHTA
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _

& strComputer & "\root\cimv2")

Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name _
= 'mshta.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
End Sub

[Paul Randall]

<Christopher Crossen> wrote in message
news:2008411155147...@fbol.com...

Is there a way to terminate only the mshta.exe process that is running
the script? It seems rude to terminate all these processes when only
one needs to exit. Perhaps objProcess has some property that the
script knows about, like window title?

-Paul Randall

[McKirahan]

"Paul Randall" <paul...@cableone.net> wrote in message
news:#ollf7Dn...@TK2MSFTNGP04.phx.gbl...

It doesn't terminate all processes only all mshta.exe processes.

I modified it be be a standalone VBS script ("mshtaEnd.vbs"):

Option Explicit
'****
'* Terminate Process: mshta.exe
'****
Const cWMI = "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"
Const cSQL = "SELECT * FROM Win32_Process WHERE Name = 'mshta.exe'"
Dim strQRY
For Each strQRY in GetObject(cWMI).ExecQuery(cSQL)
strQRY.Terminate()
Next
MsgBox "mshta.exe terminated!",vbInformation,WScript.ScriptName

[urkec]

"Paul Randall" wrote:

For each mshta.exe process Win32_Process.CommandLine contains something like:

"C:\WINDOWS\System32\mshta.exe" "C:\test.hta"

--
urkec

[Paul Randall]

"urkec" <ur...@discussions.microsoft.com> wrote in message
news:CCF17E45-9C03-4D0B...@microsoft.com...

Thank you urkec and McKirahan and Christopher Crossen

That looks quite handy. After starting a number of instances of
test.hta with a series of statements like:
mshta.exe "C:\test.hta" xyz
with different values for xyz, each instance of test.hta could
terminate itself without affecting any other instances of test.hta.

-Paul Randall