The following class includes VBScript ASP files.
The first http request you make is slow coz it needs to compile the asp to vbs, but thereafter its faster than using SSI #include because its dynamic. Have fun, e ...
<%
class VbsAspIncluder
' ASP VBScript Class: VbsAspIncluder
' Inludes ASP files unless theyve already been included.
' Doesnt work for files which have already been included using the SSI include directive.
' All SSI include directives in included files will also be included by includer.
' If you edit include file 'example.asp' then you need to delete the file 'example.asp.vbs',..
' not perfect but faster than monitoring the asp file for changes using checksum.
' USAGE: -
' dim includer ' <- must be named includer '
' set includer = new VbsAspIncluder
' includer.includeVirtual "/include/file.asp"
' includer.includeFile "file.asp"
' set includer = nothing
' REVISION: 1.0
' DATE: 27-11-2009
' AUTHOR: "Eugene Kerner" <
[email protected]>
' class scope variable declarations ' ...
private rootPath, debug, fso, includedFiles
' init() - dont edit these instead use the set methods ' ...
private sub class_initialize()
' SET rootPath if need be, the dir containing your include dir ' ...
rootPath = reReplace(request.serverVariables("APPL_PHYSICAL_PATH"), "\\www\\.*$", true, false, "\www")
' SET debug to true if you are having problems ' ...
debug = false
set fso = createObject("Scripting.FileSystemObject")
set includedFiles = createObject("Scripting.Dictionary")
end sub
private sub class_terminate()
set includedFiles = nothing
set fso = nothing
end sub
' includes a file given a relative file path ' ...
public sub includeFile(byVal aspFile)
aspFile = request.serverVariables("APPL_PHYSICAL_PATH") & aspFile
parseAndExec(aspFile)
end sub
' includes a file given a virtual path ' ...
public sub includeVirtual(byVal aspFile)
aspFile = rootPath & aspFile
parseAndExec(aspFile)
end sub
private sub parseAndExec(aspFile)
aspFile = replace(aspFile, "/", "\")
if not includedFiles.exists(aspFile) then
if fso.fileExists(aspFile & ".vbs") then
if debug then response.write "Including File: " & aspFile & ".vbs" & "<br>" & vbNewLine
parseAndExecVbs aspFile & ".vbs"
else
if debug then response.write "Including File: " & aspFile & "<br>" & vbNewLine
parseAndExecAsp(aspFile)
end if
includedFiles.add aspFile, true
end if
end sub
private sub parseAndExecVbs(vbsFile)
dim fh
set fh = fso.openTextFile(vbsFile, 1)
executeGlobal fh.readAll()
fh.close()
set fh = nothing
end sub
private sub parseAndExecAsp(aspFile)
dim fh, openVbs, closeVbs, idx, cwl, ch1, ch2, vbsStr, inVbs, startVbs, startHtml, skipNextCh, matches
openVbs = "<%"
closeVbs = "%" & ">"
vbsStr = ""
inVbs = false
startDoc = true
startVbs = false
startHtml = true
skipNextCh = false
set fh = fso.openTextFile(aspFile, 1)
while not fh.atEndOfStream
cwl = fh.readLine() & vbNewLine
' update any SSI include directives to use this includer ...
set matches = reMatch(cwl, "#include (file|virtual)=""([^""]+)", false, false)
if matches.count > 0 then
if lCase(matches.item(0).subMatches(0)) = "file" then
vbsStr = vbsStr & "includer.includeFile """ & matches.item(0).subMatches(1) & """" & vbNewLine
else
vbsStr = vbsStr & "includer.includeVirtual """ & matches.item(0).subMatches(1) & """" & vbNewLine
end if
else ' not an SSI line, parse ...
ch1 = mid(cwl, 1, 1)
for idx = 2 to len(cwl)
ch2 = mid(cwl, idx, 1)
if skipNextCh then
skipNextCh = false
elseif ch1 & ch2 = openVbs then ' startVbs ...
if not startHtml then vbsStr = vbsStr & """ & vbNewLine"
vbsStr = vbsStr & vbNewLine
inVbs = true
startVbs = true
skipNextCh = true
elseif ch1 & ch2 = closeVbs then ' startHtml ...
vbsStr = vbsStr & vbNewLine
inVbs = false
startHtml = true
skipNextCh = true
else ' not skipNextCh or openVbs or closeVbs ...
if inVbs then
' inVbs as apposed to inHtml ...
if startVbs then
' we need to know if the first ch is a "=" ro a "@" ...
if not reMatch(ch1, "\s", true, true) then
' found first ch, account for the "=" sorthand for response.write ...
if ch1 = "=" then
ch1 = "response.write "
elseif ch1 = "@" then
ch1 = "' "
end if
startVbs = false
end if
end if
vbsStr = vbsStr & ch1
else ' inHtml ...
if startHtml then
' occurs beginning of a doc, after a closeVbs tag, and after an inHtml newline ...
vbsStr = vbsStr & "response.write """
startHtml = false
end if
if reMatch(ch1, "[\r\n]", true, true) then
' end of an inHtml line, close off string ...
ch1 = """ & vbNewLine" & vbNewLine
startHtml = true
elseif ch1 = """" then
' convert quotes to double quote cox we are in a string ...
ch1 = """"""
end if
vbsStr = vbsStr & ch1
end if ' end inHtml
end if ' end skipNextCh
ch1 = ch2
next
end if
set matches = nothing
wend
fh.close()
' write vbsStr to file so faster for next request ...
set fh = fso.openTextFile(aspFile & ".vbs", 2, true)
fh.write vbsStr
fh.close()
set fh = nothing
executeGlobal vbsStr
end sub
' returns true or flase ' ...
private function reMatch(scalar, regex, ignore, returnBoolean)
dim re
set re = new regExp
re.ignoreCase = ignore
re.pattern = regex
if returnBoolean then
reMatch = re.execute(scalar).count > 0
else
set reMatch = re.execute(scalar)
end if
set re = nothing
end function
' returns an array of match obects ' ...
private function reReplace(scalar, regex, ignore, global, substitute)
dim re
set re = new regExp
re.ignoreCase = ignore
re.global = global
re.pattern = regex
reReplace = re.replace(scalar, substitute)
set re = nothing
end function
end class
%>
