%
' 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 = ""
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, "%", "%")
ParseFile = Replace(ParseFile, "<%", DI_OpenTag)
ParseFile = Replace(ParseFile, "%>", 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, "%", "%")
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 " & File & "---
" & _
"---Error description: " & Err.Description & "
" & _
"---Error Source: " & Err.Source & "