AI-ASP-CLASSIC/Core/DynamicIncludes.asp

<%
' Self-explained Constant
Const DI_CurrentFolder = "../"

' ASP block tags
Private DI_CloseTag : DI_CloseTag = Chr(37)&Chr(62)
Private DI_OpenTag : DI_OpenTag = Chr(60)&Chr(37)
Private DI_OpenClose : DI_OpenClose = DI_OpenTag & DI_CloseTag
Private DI_OpenBreakClose : DI_OpenBreakClose = DI_OpenTag & (vbNewLine & DI_CloseTag)
Private DI_CloseOpen : DI_CloseOpen = DI_CloseTag & DI_OpenTag
Private DI_CloseBreakOpen : DI_CloseBreakOpen = DI_CloseTag & (vbNewLine & DI_OpenTag)

' ASP write block tags
Private DI_WriteTag : DI_WriteTag = DI_OpenTag & "="
Private DI_ResponseWrite : DI_ResponseWrite = DI_OpenTag & " Response.Write "
Private DI_Require : DI_Require = DI_OpenTag & (" Require($1) " & DI_CloseTag)

' Public variables for file inclusion
Public DynamicInclude_PreviousPath : DynamicInclude_PreviousPath = vbNullString
Public DynamicInclude_CurrentPath  : DynamicInclude_CurrentPath  = DI_CurrentFolder
Public DynamicInclude_TrimHtml : DynamicInclude_TrimHtml = false
Public DynamicInclude_TrimNewlines : DynamicInclude_TrimNewlines = false

' Executes an imported file in the global namespace
Sub ExecuteFile(ByVal File)
    Const DI_Bar = "/"
    Const DI_ReverseBar = "\"

    Dim BarIndex, Parsed, Path, FileName, CallerPath

    Path = Replace(File, DI_ReverseBar, DI_Bar)
    BarIndex = InStrRev(Path, DI_Bar)
    FileName = IIf(IsNull(BarIndex) Or BarIndex = 0, Path, Mid(Path, BarIndex + 1))
    Path = IIf(IsNull(BarIndex) Or BarIndex = 0, vbNullString, Mid(Path, 1, BarIndex))

    ' Update paths for recursive imports, remembering the caller's own
    ' baseline so it can be restored (not clobbered to the global default)
    ' once this file - and anything it recursively includes - has run.
    CallerPath = DynamicInclude_CurrentPath
    DynamicInclude_PreviousPath = DynamicInclude_CurrentPath
    DynamicInclude_CurrentPath = DynamicInclude_CurrentPath & Path

    ' Parse and execute the file - only the bare filename is appended here,
    ' since the directory portion is already folded into DynamicInclude_CurrentPath.
    Parsed = ParseFile(DynamicInclude_CurrentPath & FileName)
    ExecuteGlobal Trim(Parsed)

    ' Restore the caller's baseline so sibling #include's in the same parent
    ' file (e.g. a header then a footer) keep resolving correctly.
    DynamicInclude_CurrentPath = CallerPath
    DynamicInclude_PreviousPath = vbNullString
End Sub

' Reads and parses an ASP file
Function ParseFile(ByRef File)
    Const DI_LineJoin = """ & vbNewLine & """
    Const DI_Space = " "
    Const DI_Quote = """"
    Const DI_DoubleQuote = """"""

    Dim LineArray(4), KeepLeft, KeepRight, Match, Rows, PlainRow, Regex

    ' Read the file content
    ParseFile = ReadFile(File)

    ' Replace tags and write commands
    ParseFile = Replace(ParseFile, DI_CloseOpen, DI_CloseBreakOpen)
    ParseFile = Replace(ParseFile, DI_OpenClose, DI_OpenBreakClose)
    ParseFile = Replace(ParseFile, DI_WriteTag, DI_ResponseWrite)

    ' Convert ASP imports to Require calls
    Set Regex = New RegExp
    With Regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "<!--\s*#include file=(""[^""]+"")\s*-->"
    End With
    ParseFile = Regex.Replace(ParseFile, DI_Require)

    ' Ensure proper ASP tags are present
    If Left(ParseFile, 2) <> DI_OpenTag Then
        ParseFile = (DI_OpenClose & vbNewLine) & ParseFile
    End If
    If Right(ParseFile, 2) <> DI_CloseTag Then
        ParseFile = ParseFile & (vbNewLine & DI_OpenClose)
    End If

    ' Trim the first open tag and last close tag
    ParseFile = Mid(ParseFile, 3, Len(ParseFile) - 4)
    ParseFile = Replace(ParseFile, "%", "&percnt;")
    ParseFile = Replace(ParseFile, "<&percnt;", DI_OpenTag)
    ParseFile = Replace(ParseFile, "&percnt;>", DI_CloseTag)

    ' Trim HTML if required
    If DynamicInclude_TrimHtml Then
        Regex.Pattern = "([^%]>)\s+(<[^%]\/?)"
        ParseFile = Regex.Replace(ParseFile, "$1$2")
        Regex.Pattern = "([^%](?!pre)>)\s*([^\s]+)\s*(<[^%](?!pre))"
        ParseFile = Regex.Replace(ParseFile, "$1$2$3")
    End If

    ' Insert plain texts in Response.write commands
    Regex.Pattern = (DI_CloseTag & "([^%])+") & DI_OpenTag
    Set Rows = Regex.Execute(ParseFile)
    LineArray(0) = vbNewLine
    LineArray(1) = "Response.write """
    LineArray(3) = DI_Quote
    LineArray(4) = vbNewLine

    For Each Match In Rows
        PlainRow = Mid(Match.Value, 3, Len(Match.Value) - 4)
        If (Left(PlainRow, 2) = vbNewLine) Then
            PlainRow = Right(PlainRow, Len(PlainRow) - 2)
        End If
        PlainRow = Replace(PlainRow, DI_Quote, DI_DoubleQuote)
        PlainRow = Replace(PlainRow, vbNewLine, DI_LineJoin)
        If (Right(PlainRow, Len(DI_LineJoin)) = DI_LineJoin) Then
            PlainRow = Left(PlainRow, Len(PlainRow) - Len(DI_LineJoin))
        End If
        If DynamicInclude_TrimHtml Then
            KeepLeft = (Left(PlainRow, 1) = DI_Space)
            KeepRight = (Right(PlainRow, 1) = DI_Space)
            PlainRow = Trim(PlainRow)
            If KeepLeft Then
                PlainRow = DI_Space & PlainRow
            End If
            If KeepRight Then
                PlainRow = PlainRow & DI_Space
            End If
        End If
        LineArray(2) = PlainRow
        ParseFile = Replace(ParseFile, Match.Value, Join(LineArray, vbNullString))
    Next

    ' Clean up
    Set Rows = Nothing
    Set Match = Nothing
    Erase LineArray

    ' Remove empty Response.write commands and duplicate new lines
    ParseFile = Replace(ParseFile, "Response.write """"" & vbNewLine, vbNullString)
    If DynamicInclude_TrimNewlines Then
        Regex.Pattern = "(?:\s+\n)+"
        ParseFile = Regex.Replace(ParseFile, vbNewLine)
    End If
    ParseFile = Replace(ParseFile, "&percnt;", "%")

    Set Regex = Nothing
End Function

' Reads a file as plain text
Function ReadFile(ByRef File)
    Dim System : Set System = Server.CreateObject("Scripting.FileSystemObject")
    Dim Path, FileData

    If File = vbNullString Then
        File = DI_CurrentFolder
    End If

    Path = Server.MapPath(File)

    If System.FileExists(Path) Then
        Set FileData = System.OpenTextFile(Path, 1)
        ReadFile = FileData.ReadAll
        Set FileData = Nothing

        ' Normalize line endings to vbNewLine regardless of how the file was
        ' saved. ParseFile's plain-text-to-Response.write splicing searches
        ' for vbNewLine specifically - a lone LF left unconverted embeds a
        ' raw newline inside a generated string literal, breaking it.
        ReadFile = Replace(ReadFile, Chr(13) & Chr(10), Chr(10))
        ReadFile = Replace(ReadFile, Chr(10), vbNewLine)
    Else
        Err.Raise 53, "DynamicIncludes.ReadFile", "File '" & File & "' was not found."
    End If

    Set System = Nothing
End Function

' Tries to include a file silently
Sub Include(ByVal File)
    On Error Resume Next
    ExecuteFile File
    On Error GoTo 0
End Sub

' Tries to include a file and stops execution on error
Sub Require(ByVal File)
    On Error Resume Next
    ExecuteFile File
    If Err.Number > 0 Then
        Response.Write "---FATAL ERROR: while trying to execute <b>" & File & "</b>---<br>" & _
                      "---Error description: " & Err.Description & "<br>" & _
                      "---Error Source: " & Err.Source & "<hr>" & _
                      "---Error Line: " & Err.Line & "<hr>"
        Response.End
    End If
    On Error GoTo 0
End Sub
Function IIf(expr, truePart, falsePart)
    If CBool(expr) Then
        IIf = truePart
    Else
        IIf = falsePart
    End If
End Function
%>