'Modifies the AbyssWs.exe program to eliminate the "persist.data"
'file Abyss insists on using to keep server statistics.
'CAUTION - Modifying the program may run you afoul of the license.
'If you've already run this script, running it again will undo the
'changes. 

Main

Sub Main
Dim strFile, strData, strMessage, fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	'Find the location of the AbyssWs executable
	strFile = AbyssPath()
	If strFile = "" Then
		MsgBox "Error - Can't locate AbyssWs.exe."
		Exit Sub
	End If
	
	'Read the file into a string
	strData = ReadByteArray(strFile)
	strData = ByteArray2Text(strData)
	
	'Toggle "persist.data" and "nul"
	If InStr(strData, "persist.data") <> 0 Then
		'Replace the text
		strData = Replace(strData, "persist.data", "nul         ")
		strMessage = "I am ready to MODIFY and REPLACE the file """ & strFile & """"
		strMessage = strMessage & " with one that will NOT create a ""persist.data"""
		strMessage = strMessage & " file. Are you sure you want to do this?"
	Elseif InStr(strData, "nul         ") <> 0 Then
		'Replace the text
		strData = Replace(strData, "nul         ", "persist.data")
		strMessage = "I am ready to MODIFY and REPLACE the file """ & strFile & """"
		strMessage = strMessage & " with one that WILL create a ""persist.data"""
		strMessage = strMessage & " file. Are you sure you want to do this?"
	Else
		MsgBox "The file """ & strFile & """ is not recognizable. No changes will be made."
		Exit Sub
	End If
	
	'Warn the user
	If MsgBox(strMessage, vbYesNo, "Overwrite") = vbNo Then Exit Sub
	
	'Save the changed file
	String2File strData, strFile
	MsgBox "Done"
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

Function ByteArray2Text(varByteArray)
'Convert byte array into a string with ADODB.Recordset
Dim rs
Const adLongVarChar = 201
    Set rs = CreateObject("ADODB.Recordset")
    rs.Fields.Append "temp", adLongVarChar, LenB(varByteArray)
    rs.Open
    rs.AddNew
    rs("temp").AppendChunk varByteArray
    rs.Update
    ByteArray2Text = rs("temp")
    rs.Close
    Set rs = Nothing
End Function

Function ReadByteArray(strFileName)
Const adTypeBinary = 1
Dim bin
	Set bin = CreateObject("ADODB.Stream")
	bin.Type = adTypeBinary
	bin.Open
	bin.LoadFromFile strFileName
	ReadByteArray = bin.Read
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 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

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