Option Explicit
'On Error Resume Next
'Does a recursive find and replace operation on all files of specified types
'Written by Eric Phelps http://www.ericphelps.com

'Force "cscript"
Dim gintCompareMethod 'As Integer
Main
Wscript.Quit 0

Sub Main()
Dim fil 'As Scripting.File
Dim fils 'As Scripting.Files
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim fs 'As Scripting.FileSystemObject
Dim strDirectories() 'As String
Dim strFileTypes 'As String
Dim lngCounter 'As Long
Dim strOldText 'As String
Dim strNewText 'As String
Const READONLY = 1
Const HIDDEN = 2
Const SYSTEM = 4
	If MsgBox ("This program will do a text search-and-replace on all specified files (Under 1MB in size) in and below a directory you designate. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit
	Set fs = CreateObject("Scripting.FileSystemObject")
	If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then 
		If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & Wscript.ScriptFullName & ".log" & ". Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, "Search and Replace") = vbCancel Then Wscript.Quit
	Else
		If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen and will not be logged. Run this program under WSCRIPT if you want a log file. Continue?", vbOkCancel, "Search and Replace") = vbCancel Then Wscript.Quit
	End If
	Redim strDirectories(0)
	strDirectories(0) = InputBox("Enter path to start swapping text at:", "Search and Replace", FileNameInThisDir(""))
	If strDirectories(0) = "" Then Wscript.Quit
	strDirectories(0) = fs.GetAbsolutePathName(strDirectories(0))
	gintCompareMethod = MsgBox("Case-sensitive?", vbYesNo) - 6
	strOldText = InputBox("Enter old text you want replaced", "Old Text", "/index.htm"">")
	If strOldText = "" Then Wscript.Quit
	strNewText = InputBox("Enter new text you want", "New Text", "/index.html"">")
	strFileTypes = InputBox("Enter extensions for file types you want to apply this operation to", "File Types", ".txt .htm .html .asp .css .js .vbs .bat .cmd .ini")
	If MsgBox("This is your last question. Text replacement starts if you click yes. Okay to replace all instances of """ & strOldText & """ with """ & strNewText & """ in all """ & strFileTypes & """ files in and below the """ & strDirectories(0) & """ directory?", vbYesNo, "Search and Replace") = vbNo Then Wscript.Quit
	lngCounter = 0
	Status "*************************************"
	Status "*************************************"
	Status "Program:		" & Wscript.ScriptFullName
	Status "Replacing:	  " & strOldText
	Status "With:		   " & strNewText
	Status "In and Below:   " & strDirectories(0)
	Status "For file types: " & strFileTypes
	Status "Starting Time:  " & Now
	Do Until lngCounter > Ubound(strDirectories,1)
		'Next folder to process
		Set fol = fs.GetFolder(strDirectories(lngCounter))
		'Get each file in turn
		Set fils = fol.Files
		If Err.Number <> 0 Then Exit Sub
		For Each fil In fils
			If Instr(fil.Name, ".") <> 0 Then
			If Instr(1, strFileTypes, Mid(fil.Name, InstrRev(fil.Name, ".")), vbTextCompare) <> 0 Then
			If Wscript.ScriptFullName <> fil.Path Then
			If ((fil.Attributes And READONLY) = 0) Then
			If ((fil.Attributes And SYSTEM) = 0) Then
			If ((fil.Attributes And HIDDEN) = 0) Then
				ReplaceText fil, strOldText, strNewText
			End If
			End If
			End If
			End If
			End If
			End If
		Next
		'Check for any sub folders and add them to the folder array
		Set fols = fol.SubFolders
		For each fol in fols
			If Lcase(fol.Name) <> "recycled" Then
				Redim Preserve strDirectories(Ubound(strDirectories,1) + 1)
				strDirectories(Ubound(strDirectories,1)) = fol.Path
			End If
		Next
		lngCounter = lngCounter + 1
	Loop
	Status "Program finished: " & Now
	Status "*************************************"
	Status "*************************************"
	If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & Wscript.ScriptFullName & ".log", vbOkOnly, "Search and Replace"
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 Scripting.FileSystemObject
	Set fs = CreateObject("Scripting.FileSystemObject")
	 FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
	''''''''''Clean up
	Set fs = Nothing
End Function

Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it writes
'to a log in the same directory as the script.
Dim ts 'As Scripting.TextStream
Dim fs 'As Scripting.FileSystemObject
Const ForAppending = 8 'Scripting.IOMode
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then 
		Wscript.Echo strMessage
	Else
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True)
		ts.WriteLine strMessage
		ts.Close
		''''''''''Clean up
		Set ts = Nothing
		Set fs = Nothing
	End If
End Sub

Sub Force(sScriptEng)
'Forces this script to be run under the desired scripting host
'Valid sScriptEng arguments are "wscript" or "cscript"
'If you don't supply a valid name, Force will switch hosts...
	If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
		'Running under WSCRIPT
		If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
			'Need to switch to CSCRIPT
			CreateObject("Wscript.Shell").Run "cscript.exe " & Wscript.ScriptFullName
			Wscript.Quit
		End If
	Else
		'Running under CSCRIPT
		If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
			'Need to switch to WSCRIPT
			CreateObject("Wscript.Shell").Run "wscript.exe " & Wscript.ScriptFullName
			Wscript.Quit
		End If
	End If
End Sub

Sub ReplaceText(objScriptingFile, strOldText, strNewText)
Dim ts 'As Scripting.TextStream
Dim intTries 'As Integer
Dim strFileText 'As String
Const ForReading = 1 'Scripting.IOMode
Const ForWriting = 2 'Scripting.IOMode
	'Trying to work with huge strings here causes slowdowns & overflows
	If objScriptingFile.Size > 999999 Then
		Status "* TOO LARGE: " & objScriptingFile.Path
		Exit Sub
	End If
	'Opening executable scripts seems to cause an error first time. Maybe
	'due to a delay from the system virus-checker. Good results re-trying!
	'Open the file for reading
	On Error Resume Next
	For intTries = 0 to 3
		Set ts = Nothing
		Err.Clear
		Set ts = objScriptingFile.OpenAsTextStream(ForReading)
		If Err.Number = 0 Then Exit For
		Wscript.Sleep 50
	Next
	If intTries > 2 Then
		Status "* CAN'T OPEN: " & objScriptingFile.Path
		Err.Clear
		On Error Goto 0
		Exit Sub
	End If
	'Read the file
	For intTries = 0 to 3
		Err.Clear
		strFileText = ts.ReadAll
		If Err.Number = 0 Then Exit For
		Wscript.Sleep 50
	Next
	If intTries > 2 Then
		Status "* CAN'T READ: " & objScriptingFile.Path
		Err.Clear
		On Error Goto 0
		Exit Sub
	End If
	ts.Close
	'Replace text
	If Instr(1, strFileText, strOldText, gintCompareMethod) = 0 Then Exit Sub
	strFileText = Replace(strFileText, strOldText, strNewText, 1, -1, gintCompareMethod)
	'Save changes
	For intTries = 0 to 3
		Err.Clear
		Set ts = objScriptingFile.OpenAsTextStream(ForWriting)
		ts.Write strFileText
		If Err.Number = 0 Then Exit For
		Wscript.Sleep 50
	Next
	If intTries > 2 Then
		Status "* CAN'T SAVE: " & objScriptingFile.Path
		Err.Clear
		On Error Goto 0
		Exit Sub
	End If
	Status "  MODIFIED: " & objScriptingFile.Path
	ts.Close
	On Error goto 0
End Sub