'Configures Abyss to support WSF as a CGI. Get 'Abyss from http://www.aprelium.com/abyssws/ Option Explicit Main Sub Main Dim blnAbyssWasRunning, blnNodeFound Dim strAbyssPath, strCscriptPath, strAbyssConfPath Dim objWMIService, colItems, objItem Dim fs, ws, sh, fols, fol, xml, nodes, node, entry '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 '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 CSCRIPT strCscriptPath = fs.BuildPath(WScript.Path, "cscript.exe") If Not fs.FileExists(strCscriptPath) Then MsgBox "Unable to locate CSCRIPT.EXE. Aborting." Exit Sub End If 'KILL existing instance of abyssws blnAbyssWasRunning = False 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 If blnAbyssWasRunning = False Then 'Only ask user one time If MsgBox("Abyss is running. I'll need to shut it down for a few seconds while I make the changes. Okay?", vbYesNo, "Confirm") = vbNo Then Exit Sub End If End If blnAbyssWasRunning = True 'Set it so we know we have to restart it later objItem.Terminate End If Next Set objWMIService = Nothing If blnAbyssWasRunning Then WScript.Sleep 2000 'Give time for files to close End If End If On Error Goto 0 'LOAD the conf file Set xml = XmlDoc(strAbyssConfPath) 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 If xml.url = "" Then MsgBox "Your abyss.conf file appears to be corrupt! Try renaming it with an ""xml"" file extension and opening it with your browser to identify the problem." Exit Sub End If 'EDIT abyssws.conf file 'Enable scripting GetNodeWithText xml.selectSingleNode("//root/server/host/scripting"), "enabled", "yes", False 'Set index file Set node = xml.selectSingleNode("//root/server/host/indexes") Set node = GetNodeWithText(node, "index", "index.wsf", True) 'Set interpreter Set node = xml.selectSingleNode("//root/server/host/scripting/interpreters") Set node = GetNodeWithText(node, "interpreter/ext", "wsf", True) Set node = GetNodeWithText(node.parentNode, "file", strCscriptPath, False) Set node = GetNodeWithText(node.parentNode, "arguments", "%1 //nologo", False) Set node = GetNodeWithText(node.parentNode, "type", "0", False) Set node = GetNodeWithText(node.parentNode, "updatepaths", "yes", False) 'Save the modifications we made xml.save strAbyssConfPath 'LAUNCH Abyss If blnAbyssWasRunning = True Then ws.CurrentDirectory = fs.GetParentFolderName(strAbyssConfPath) ws.Run """" & strAbyssPath & """", 1, 0 End If 'Notify user of success MsgBox "The Abyss instance located in """ & fs.GetParentFolderName(strAbyssConfPath) & """ has been updated to support WSF." End Sub Function GetNodeWithText(xmlNode, ByVal strPath, strText, blnDuplicatePath) 'Returns the node that has the path and text value. 'Creates the node if it doesn't exist. xmlNode is a 'reference to the document or to a node in that document. Dim xml, nodes, node, parent, newNode 'Clean the path up Do While Left(strPath, 1) = "/" : strPath = Mid(strPath, 2) : Loop Do While Right(strPath, 1) = "/" : strPath = Left(strPath, Len(strPath) - 1) : Loop 'Test to see if we have a node with the data On Error Resume Next Set nodes = Nothing Set nodes = xmlNode.selectNodes(strPath) On Error Goto 0 If Not(nodes Is Nothing) Then For Each node In nodes If node.Text = strText Then Set GetNodeWithText = node Exit Function End If Next End If 'The specified key/data node doesn't exist, so create it Set node = CreateNode(xmlNode, strPath, blnDuplicatePath) node.Text = strText Set GetNodeWithText = node End Function Function CreateNode(ByVal xmlNode, ByVal strPath, blnMakeDuplicate) 'Creates any depth of path under the starting node. Returns the final node. Dim xml, newNode, strNode 'Get a ref to the root If xmlNode.ownerDocument Is Nothing Then Set xml = xmlNode Else Set xml = xmlNode.ownerDocument End If 'Clean the path up Do While Left(strPath, 1) = "/" : strPath = Mid(strPath, 2) : Loop Do While Right(strPath, 1) = "/" : strPath = Left(strPath, Len(strPath) - 1) : Loop 'Check each element in the path to see if it exists For Each strNode In Split(strPath, "/") Set newNode = Nothing On Error Resume Next Set newNode = xmlNode.selectSingleNode(strNode) On Error Goto 0 If newNode Is Nothing Then 'The desired node doesn't exist -- Create it Set newNode = xml.createElement(strNode) Set xmlNode = xmlNode.appendChild(newNode) Else If blnMakeDuplicate = True Then 'Create a duplicate node with the same name Set newNode = xml.createElement(strNode) Set xmlNode = xmlNode.appendChild(newNode) Else 'Point xmlNode to the existing node without creating a duplicate Set xmlNode = newNode End If End If Next 'Return Set CreateNode = xmlNode End Function Function XmlDoc(strFile) 'Returns an xml document root node Dim xml, node 'Create XML object 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("Msxml2.XMLDocument") 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 Not xml Is Nothing Then xml.async = False If Not xml.load(strFile) Then 'Set xml = Nothing End If End If Set XmlDoc = xml End Function 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