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

Option Explicit

Main

Sub Main
Const TemporaryFolder = 2
Dim strAbyssPath, strWebPath, strWebLogPath, strCgiLogPath, strPhpPath, strAbyssConfPath
Dim objWMIService, colItems, objItem
Dim fs, ws, sh, fols, fol
	'Create objects
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set sh = CreateObject("Shell.Application")
	'KILL existing instances of abyssws
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select Name from Win32_Process where Name='abyssws.exe'",,48)
	For Each objItem in colItems
		objItem.Terminate
	Next
	Set objWMIService = Nothing
	On Error Goto 0
	WScript.Sleep 2000
	'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
	'Find CONF file
	strAbyssConfPath = fs.BuildPath(fs.GetParentFolderName(strAbyssPath), "abyss.conf")
	'Find WEB ROOT
	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 & "\"
	'Find LOGS
	strWebLogPath = "nul" 'fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "abyss_web.log")
	strCgiLogPath = "nul" 'fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "abyss_cgi.log")
	'Find PHP
	strPhpPath = ""
	If strPhpPath = "" Then
		If fs.FileExists("C:\PHP\php-cgi.exe") Then strPhpPath = "C:\PHP\php-cgi.exe"
	End If
	If strPhpPath = "" Then
		If fs.FileExists("C:\PHP\php.exe") Then strPhpPath = "C:\PHP\php.exe"
	End If
	If strPhpPath = "" Then
		If fs.FileExists("C:\Program Files\PHP\php-cgi.exe") Then strPhpPath = "C:\Program Files\PHP\php-cgi.exe"
	End If
	If strPhpPath = "" Then
		If fs.FileExists("C:\Program Files\PHP\php.exe") Then strPhpPath = "C:\Program Files\PHP\php.exe"
	End If
	On Error Resume Next
	If strPhpPath = "" Then
		strPhpPath = ws.RegRead("HKEY_CLASSES_ROOT\Applications\php-cgi.exe\shell\Open\command\")
	End If
	If strPhpPath = "" Then
		strPhpPath = ws.RegRead("HKEY_CLASSES_ROOT\Applications\php.exe\shell\Open\command\")
	End If
	If strPhpPath = "" Then
		strPhpPath = ws.RegRead("HKEY_CLASSES_ROOT\phpFile\shell\Open\command\")
	End If
	On Error Goto 0
	If InStr(1, strPhpPath, "php", vbTextCompare) = 0 Then strPhpPath = ""
	If InStr(1, strPhpPath, ".exe", vbTextCompare) = 0 Then strPhpPath = ""
	If strPhpPath <> "" Then
		strPhpPath = Left(strPhpPath, InStr(1, strPhpPath, ".exe", vbTextCompare) + 3)
		If Left(strPhpPath, 1) = """" Then strPhpPath = Mid(strPhpPath, 2)
	End If
	If Not fs.FileExists(strPhpPath) Then strPhpPath = ""
	'EDIT abyssws.conf file
	ChangeKeyValue strAbyssConfPath, "ServerRoot", strWebPath
	ChangeKeyValue strAbyssConfPath, "Path", "."
	ChangeKeyValue strAbyssConfPath, "LogFile", strWebLogPath
	ChangeKeyValue strAbyssConfPath, "CGIErrorFile", strCgiLogPath
	If strPhpPath <> "" Then
		ChangeKeyValue strAbyssConfPath, "CGIEnabled", "Yes"
		AppendDataPair strAbyssConfPath, "IndexFile", "index.php"
		AppendDataPair strAbyssConfPath, "CGIPath", "/*.php"
		AppendDataPair strAbyssConfPath, "cgiinterpreter", """" & strPhpPath & """ php"
		AppendDataPair strAbyssConfPath, "cgienv", "REDIRECT_STATUS=200"
	End If
	'LAUNCH
	ws.CurrentDirectory = fs.GetParentFolderName(strAbyssConfPath)
	ws.Run """" & strAbyssPath & """", 1, 0
End Sub

Sub AppendDataPair(strFile, strKeyName, strKeyValue)
'If pair doesn't already exist, adds a space-separated keyname & keyvalue data pair.
Dim strContents, strData
	strData = strKeyName & " " & strKeyValue
	strContents = File2String(strFile)
	If Len(strContents) >= Len(strData) Then
		If strContents = strData Then Exit Sub
		If InStr(1, strContents, vbCrLf & strData & vbCrLf, vbTextCompare) <> 0 Then Exit Sub
		If InStr(1, strContents, strData & vbCrLf, vbTextCompare) = 1 Then Exit Sub
		If Right(strContents, Len(strData)) = strData Then Exit Sub
		If Len(strContents) >= Len(strData) + 2 Then
			If Right(strContents, Len(strData) + 2) = strData & vbCrLf Then Exit Sub
		End If
	End If
	If strContents <> "" Then
		If Right(strContents, 2) <> vbCrLf Then
			AppendToFile vbCrLf, strFile
		End If
	End If
	AppendToFile strData & vbCrLf, strFile
End Sub

Sub ChangeKeyValue(strFile, strKeyName, strKeyValue)
'Changes the keyvalue in an existing data pair. If no entry 
'for that keyname, a new data pair is added.
Dim strContents, lngPointer, strHead, strTail
	strContents = File2String(strFile)
	lngPointer = InStr(1, strContents, vbCrLf & strKeyName & " ", vbTextCompare)
	If lngPointer = 0 Then
		lngPointer = InStr(1, strContents, strKeyName & " ", vbTextCompare)
		If lngPointer <> 1 Then lngPointer = 0
	End If
	If lngPointer = 0 Then 
		AppendDataPair strFile, strKeyName, strKeyValue
		Exit Sub
	End If
	strHead = Left(strContents, lngPointer - 1)
	If ((strHead <> "") And (Right(strHead, 2) <> vbCrLf)) Then strHead = strHead & vbCrLf
	strTail = Mid(strContents, lngPointer)
	If Left(strTail, 2) = vbCrLf Then strTail = Mid(strTail, 3)
	If InStr(strTail, vbCrLf) <> 0 Then
		strTail = Mid(strTail, InStr(strTail, vbCrLf))
	Else
		strTail = vbCrLf
	End If
	String2File strHead & strKeyName & " " & strKeyValue & strTail, strFile
End Sub	

Sub AppendToFile(strText, strFile)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFile, ForAppending, True)
	Err.Clear
	On Error Resume Next
	ts.Write strText
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strText) Step 100
			Err.Clear
			ts.Write Mid(strText, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strText, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
	On Error Goto 0
End Sub

Function File2String(strFile) 'As String
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForReading = 1
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FileExists(strFile) Then
		Set ts = fs.OpenTextFile(strFile, ForReading, True)
		If ts.AtEndOfStream Then
			File2String =""
		Else
			File2String = ts.ReadAll
		End If
		ts.Close
	Else
		File2String = ""
	End If
End Function

Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	Err.Clear
	On Error Resume Next
	ts.Write strData
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strData) Step 100
			Err.Clear
			ts.Write Mid(strData, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strData, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
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