'Replaces text between comment tags

Option Explicit

Dim strFolder, strExtensions, strStart, strEnd, strNew
GetVariables strFolder, strExtensions, strStart, strEnd, strNew
ProcessFolder CreateObject("Scripting.FileSystemObject").GetFolder(strFolder), strStart, strEnd, strNew

    
Sub ProcessFolder(objFolder, strStart, strEnd, strNew)
Dim fils, fil, fols, fol
Dim strExtension
Const READONLY = 1
Const HIDDEN = 2
Const SYSTEM = 4
    On Error Resume Next
    'Get each file in turn
    Err.Clear
    Set fils = objFolder.Files
    If Err.Number = 0 Then 
        For Each fil In fils
            For Each strExtension In Split(strExtensions, " ")
                If LCase(Right(fil.name, Len(strExtension))) = LCase(strExtension) Then
                If ((fil.Attributes And READONLY) = 0) Then
                If ((fil.Attributes And SYSTEM) = 0) Then
                If ((fil.Attributes And HIDDEN) = 0) Then
                If Lcase(fil.Path) <> Lcase(Wscript.ScriptFullName) Then
                    If Update(fil.Path, strStart, strEnd, strNew) Then
                        Status fil.Path
                    End If
                End If        
                End If        
                End If        
                End If        
                End If        
            Next
        Next
        'Check for any sub folders and recursively process them
        Set fols = objFolder.SubFolders
        For each fol in fols
            If Lcase(fol.Name) <> "recycled" Then
                ProcessFolder fol, strStart, strEnd, strNew
            End If
        Next
    End If
End Sub

Sub Status(strMessage)
    If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
        Wscript.Echo strMessage
    End If
End Sub


Function Update (strFileName, strStart, strEnd, strNew) 'As Boolean
'True if web page is modified
Dim blnModified
Dim lngStart, lngEnd, lngPointer
Dim strIn, strOut
blnModified = False
strOut = ""
lngPointer = 1
strIn = File2String(strFileName)
    Do
        lngStart = InStr(lngPointer, strIn, strStart)
        If lngStart > 0 Then
            lngEnd = InStr(lngStart, strIn, strEnd)
            If lngEnd > lngStart Then
                blnModified  = True
                'Get everything from pointer to start
                strOut = strOut & Mid(strIn, lngPointer, lngStart - lngPointer)
                'Add new text
                strOut = strOut & strStart & strNew & strEnd
                'Move pointer to new position
                lngPointer = lngEnd + Len(strEnd)
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    'Add any text at the end
    strOut = strOut & Mid(strIn, lngPointer)
    'Save the file
    If blnModified Then
        String2File strOut, strFileName
    End If
    Update = blnModified
End Function

Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForWriting = 2
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
    ts.Write(strData)
    'Clean up
    ts.Close
    Set ts = Nothing
    Set fs = Nothing
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 GetVariables (strFolder, strExtensions, strStart, strEnd, strNew)
    If WScript.Arguments.Count > 0 Then
        strFolder = WScript.Arguments(0)
    Else
        strFolder = InputBox("Enter full path to folder containing files to be modified", "Enter File", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName))
    End If
    If WScript.Arguments.Count > 1 Then
        strExtensions = WScript.Arguments(1)
    Else
        strExtensions = InputBox("Enter space-delimited file extensions to modify", "Extensions", ".htm .html .asp")
    End If
    If WScript.Arguments.Count > 2 Then
        strStart = WScript.Arguments(2)
    Else
        strStart = InputBox("Enter start string", "Start Tag", "<!--START-->")
    End If
    If WScript.Arguments.Count > 3 Then
        strEnd = WScript.Arguments(3)
    Else
        strEnd = InputBox("Enter end string", "End Tag", "<!--END-->")
    End If
    If WScript.Arguments.Count > 4 Then
        strNew = WScript.Arguments(4)
    Else
        strNew = InputBox("Enter file which contains new text that will go between the tags", "Interior Tag Text File", FileNameLikeMine("txt"))
        strNew = File2String(strNew)
    End If
End Sub

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
    Set fs = Wscript.CreateObject("Scripting.FileSystemObject")
    strExtension = strFileExtension
    If Len(strExtension) < 1 Then strExtension = "txt"
    If strExtension = "." Then strExtension = "txt"
    If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
    FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
    ''''''''''Clean up
    Set fs = Nothing
End Function

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