'On Error Resume Next
'Recursively replaces four spaces with a single tab on all 
'specified files. Written by Eric Phelps http://www.ericphelps.com

Option Explicit

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 replace all instances of four spaces with a single tab character in 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 spaces for tabs:", "Search and Replace", FileNameInThisDir(""))
	If strDirectories(0) = "" Then Wscript.Quit
	strDirectories(0) = fs.GetAbsolutePathName(strDirectories(0))
	strOldText = String(4, " ")
	strNewText = vbTab
	strFileTypes = InputBox("Enter extensions for file types you want to apply this operation to", "File Types", ".txt .vbs .js .snippet")
	If MsgBox("Ready to replace spaces with tabs 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 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(strFileText, strOldText) = 0 Then Exit Sub
	Do While Instr(strFileText, strOldText) <> 0
		strFileText = Replace(strFileText, strOldText, strNewText)
	Loop
	'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