<% ' 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 & "
" & _ "---Error Line: " & Err.Line & "
" 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 %>