'Launch Abyss web server version 2.0. Drop a folder 
'on this script. Abyss will run with that folder 
'as the document root. Existing instance of Abyss 
'will be killed. Get Abyss from 
'http://www.aprelium.com/abyssws/

Option Explicit

Main

Sub Main
Const TemporaryFolder = 2
Dim blnGoodConsole
Dim strAbyssPath, strWebPath, strAbyssConfPath, strConsolePath
Dim objWMIService, colItems, objItem
Dim fs, ws, sh, fols, fol, xml, node

	'Create objects
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	'The sh object is optional. We'll have to do without it under Win95.
	On Error Resume Next
	Set sh = Nothing
	Set sh = CreateObject("Shell.Application")
	On Error Goto 0
	'The xml object is a moving target. Who knows what version the user has installed?
	On Error Resume Next
	Set xml = Nothing
	If xml Is Nothing Then Set xml = CreateObject("Msxml2.DOMDocument.4.0")
	If xml Is Nothing Then Set xml = CreateObject("Msxml2.DOMDocument")
	If xml Is Nothing Then Set xml = CreateObject("Msxml.DOMDocument")
	If xml Is Nothing Then Set xml = CreateObject("Microsoft.XMLDOM")
	On Error Goto 0
	If xml Is Nothing Then
		If MsgBox("You need to install Microsoft XML. May I point your default browser to ""http://msdn.microsoft.com/XML/XMLDownloads/"" to allow you to download it?", vbYesNo, "Download") = vbYes Then
			ws.Run "http://msdn.microsoft.com/XML/XMLDownloads/", 1, False
		End If
		Exit Sub
	End If

	'Find ABYSWS executable
	If fs.FileExists(FileNameInThisDir("abyssws.exe")) Then
		strAbyssPath = FileNameInThisDir("abyssws.exe")
	Else
		strAbyssPath = BrowseForFolder("Location of ""abyssws.exe"":")
		If strAbyssPath <> "" Then strAbyssPath = fs.BuildPath(strAbyssPath, "abyssws.exe")
	End If
	If Not fs.FileExists(strAbyssPath) Then
		MsgBox "Fatal error: Abyssws.exe not located."
		Exit Sub
	End If
	'Force a long path
	If Not(sh Is Nothing) Then
		strAbyssPath = fs.GetParentFolderName(strAbyssPath)
		Set fol = sh.NameSpace(strAbyssPath)
		strAbyssPath = fol.ParentFolder.ParseName(fol.Title).Path
		If Right(strAbyssPath, 1) <> "\" Then strAbyssPath = strAbyssPath & "\"
		strAbyssPath = strAbyssPath & "abyssws.exe"
		If Not fs.FileExists(strAbyssPath) Then
			MsgBox "Fatal error: Unable to resolve long file name for Abyssws.exe."
			Exit Sub
		End If
	End If
	
	'Find CONF file
	strAbyssConfPath = fs.BuildPath(fs.GetParentFolderName(strAbyssPath), "abyss.conf")
	If Not fs.FileExists(strAbyssConfPath) Then
		MsgBox "Fatal error: """ & strAbyssConfPath & """ not located."
		Exit Sub
	End If
	
	'Find WEB path
	strWebPath = ""
	If WScript.Arguments.Count = 1 Then
		strWebPath = WScript.Arguments(0)
		If Not fs.FolderExists(strWebPath) Then
			strWebPath = ""
		End If
	End If
	If strWebPath = "" Then
		strWebPath = BrowseForFolder("Folder to serve:")
	End If
	If strWebPath = "" Then
		MsgBox "Fatal Error: No folder to serve."
		Exit Sub
	End If	
	'Force a long path
	Set fol = sh.NameSpace(strWebPath)
	strWebPath = fol.ParentFolder.ParseName(fol.Title).Path
	If Right(strWebPath, 1) <> "\" Then strWebPath = strWebPath & "\"
	If Not fs.FolderExists(strWebPath) Then
		MsgBox "Fatal error: Unable to resolve long file name for web path."
		Exit Sub
	End If
	
	'Check the "root" path used for console graphics and documentation
	blnGoodConsole = True
	Set node = Nothing
	Set node = xml.selectSingleNode("//root/server/parameters/root")
	If node Is Nothing Then
		blnGoodConsole = False
	Else
		If Not fs.FileExists(fs.BuildPath(node.text, "console\antileech.gif")) Then
			blnGoodConsole = False
		End If
	End If
	If blnGoodConsole = False Then
		strConsolePath = ""
		'First try the executable folder
		If strConsolePath = "" Then
			If fs.FileExists(fs.BuildPath(fs.GetParentFolderName(strAbyssPath), "console\antileech.gif")) Then
				strConsolePath = fs.GetParentFolderName(strAbyssPath)
			End If
		End If
		'Try the place Abyss was originally installed
		If strConsolePath = "" Then
			On Error Resume Next
			strConsolePath = ws.RegRead("HKEY_CURRENT_USER\Software\AbyssWebServer\Install_Dir")
			On Error Goto 0
			If Not fs.FileExists(fs.BuildPath(strConsolePath, "console\antileech.gif")) Then
				strConsolePath = ""
			End If
		End If
		'Try the place Abyss is usually installed
		If strConsolePath = "" Then
			If fs.FileExists("C:\Program Files\Abyss Web Server\console\antileech.gif") Then
				strConsolePath = "C:\Program Files\Abyss Web Server\"
			End If
		End If
		'Use the web path because it is public. It won't work, but it won't cause problems.
		If strConsolePath = "" Then
			strConsolePath = strWebPath 
		End If
	End If
	
	'KILL existing instance of abyssws
	On Error Resume Next
	Set objWMIService = Nothing
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	If objWMIService Is Nothing Then 'Only a problem on Win9x
		If MsgBox("I could automate the shutdown and restart of Abyss if you had WMI installed. Can I take you to a web page where you can download WMI?", vbYesNo, "Download") = vbYes Then
			ws.Run "http://www.microsoft.com/downloads/details.aspx?FamilyId=98A4C5BA-337B-4E92-8C18-A63847760EA5", 1, False
			Exit Sub
		Else
			MsgBox "If Abyss is running, you'll need to shut it down now BEFORE clicking OK."
		End If
	Else
		Set colItems = objWMIService.ExecQuery("Select ExecutablePath from Win32_Process where Name='abyssws.exe'",,48)
		For Each objItem in colItems
			If LCase(objItem.ExecutablePath) = LCase(strAbyssPath) Then
				blnAbyssWasRunning = True 'Set it so we know we have to restart it later
				objItem.Terminate
			End If
		Next
		Set objWMIService = Nothing
		WScript.Sleep 2000 'Give time for files to close
	End If
	On Error Goto 0
	
	'Load the CONF file
	xml.async = False
	xml.preserveWhiteSpace = True
	xml.load strAbyssConfPath
	
	'EDIT abyssws.conf file
 	CreateOrChangeNode xml, "//root/server/parameters/root", strConsolePath
	CreateOrChangeNode xml, "//root/server/host/path", strWebPath
	xml.save strAbyssConfPath
	
	'LAUNCH Abyss
	ws.CurrentDirectory = fs.GetParentFolderName(strAbyssConfPath)
	ws.Run """" & strAbyssPath & """", 1, 0
	
End Sub

Sub CreateOrChangeNode(xml, strNode, strValue)
Dim node, temp, strParent, strChild
	Set node = xml.selectSingleNode(strNode)
	If node Is Nothing Then
		'Find the parent
		strChild = Mid(strNode, InStrRev(strNode, "/") + 1)
		strParent = Left(strNode, InStrRev(strNode, "/") - 1)
		'Does the parent exist?
		Set node = xml.selectSingleNode(strParent)
		If node Is Nothing Then
			'Recursively create the parent
			CreateOrChangeNode xml, strParent, ""
		End If
		'Create the new node values in memory
		Set temp = xml.createElement(strChild)
		temp.text = strValue
		'Append the new node to the parent
		xml.selectSingleNode(strParent).appendChild temp
	Else
		'Set the value of the existing node
		xml.selectSingleNode(strNode).text = strValue
	End If
End Sub

Function FileNameInThisDir(strFileName) 'As String
'Returns the complete path and file name to a file in
'the script directory. For example, "trans.log" might
'return "C:\Program Files\Scripts\Database\trans.log"
'if the script was in the "C:\Program Files\Scripts\Database"
'directory.
Dim fs 'As Object
	Set fs = CreateObject("Scripting.FileSystemObject")
	 FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
	''''''''''Clean up
	Set fs = Nothing
End Function

Function BrowseForFolder(strPrompt)
'Uses the "Shell.Application" (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5 'My Documents
Const ssfDRIVES = 17 'My Computer
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2 
	Dim sh, fol, fs, lngView, strPath
	Set sh = CreateObject("Shell.Application")
	If Instr(TypeName(sh), "Shell") = 0 Then
		BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName))
		Exit Function
	End If
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
	strPath = ""
	Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
	Err.Clear
	On Error Resume Next
	strPath = fol.ParentFolder.ParseName(fol.Title).Path
	'An error occurs if the user selects a drive instead of a folder
	If Err.Number <> 0 Then
		BrowseForFolder = Left(Right(fol.Title, 3), 2) & "\"
	Else
		BrowseForFolder = strPath
	End If
End Function