'Toggles Abyss web server PID (process ID) file from "nul" '(which disables it) to the standard "log/abyssws.pid" setting. 'Get Abyss from http://www.aprelium.com/abyssws/ Option Explicit Main Sub Main Const TemporaryFolder = 2 Dim blnAbyssWasRunning, blnLoggingEnabled Dim strAbyssPath, strAbyssConfPath, strMessage 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 strAbyssPath = AbyssPath() 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 '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 WScript.Sleep 2000 'Give time for files to close End If On Error Goto 0 'Load the CONF file xml.async = False xml.load strAbyssConfPath 'Check current logging state On Error Resume Next blnLoggingEnabled = True Set node = xml.selectSingleNode("//root/server/parameters/opsys/pidfile") If node Is Nothing Then blnLoggingEnabled = False Else If InStr(node.text, ".") = 0 Then blnLoggingEnabled = False End If 'EDIT abyssws.conf file If blnLoggingEnabled = True Then CreateOrChangeNode xml, "//root/server/parameters/opsys/pidfile", "nul" Else CreateOrChangeNode xml, "//root/server/parameters/opsys/pidfile", "log/abyssws.pid" End If xml.save strAbyssConfPath 'LAUNCH If blnAbyssWasRunning Then ws.CurrentDirectory = fs.GetParentFolderName(strAbyssConfPath) ws.Run """" & strAbyssPath & """", 1, 0 End If 'Notify user of success strMessage = "The Abyss instance located in """ strMessage = strMessage & fs.GetParentFolderName(strAbyssConfPath) If blnLoggingEnabled = True Then strMessage = strMessage & """ now has PID file logging DISABLED. " Else strMessage = strMessage & """ now has PID file logging ENABLED. " End If strMessage = strMessage & "Re-run this script to toggle this setting." MsgBox strMessage End Sub Function AbyssPath() 'Find the location of the AbyssWs executable Dim strFile, fs Set fs = CreateObject("Scripting.FileSystemObject") strFile = "" 'See if the user dropped a file If strFile = "" Then If WScript.Arguments.Count = 1 Then strFile = Wscript.Arguments(0) If fs.FileExists(strFile) Then If Lcase(fs.GetFileName(strFile)) <> "abyssws.exe" Then strFile = "" End If Else strFile = "" End If End If End If 'See if the user dropped a folder If strFile = "" Then If WScript.Arguments.Count = 1 Then strFile = Wscript.Arguments(0) If fs.FolderExists(strFile) Then strFile = fs.BuildPath(strFile, "abyssws.exe") If Not fs.FileExists(strFile) Then strFile = "" End If End If End If End If 'See if Abyss is in the script folder If strFile = "" Then strFile = FileNameInThisDir("abyssws.exe") If Not fs.FileExists(strFile) Then strFile = "" End If End If 'Ask the user to locate Abyss If strFile = "" Then strFile = BrowseForFolder("Location of AbyssWs.exe") If strFile <> "" Then strFile = fs.BuildPath(strFile, "abyssws.exe") If Not fs.FileExists(strFile) Then strFile = "" End If End If End If 'Return the value AbyssPath = strFile End Function 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