<%
Public Inc_File, Include_Vars, Include_Vars_Count
Dim ObjFsChk
Set Inc_File = New Csl_Include
Set ObjFsChk = Server.CreateObject("Scripting.FileSystemObject")
Set RegFltr = New regexp
Set RegFltr2 = New regexp
Class Csl_Include
Private Sub Class_Initialize()
Set Include_Vars = Server.CreateObject("Scripting.Dictionary")
Include_Vars_Count = 0
End Sub
Private Sub Class_Deactivate()
Include_Vars.RemoveAll
Set Include_Vars = Nothing
Set Include = Nothing
End Sub
Public Default Function Inc_File(ByVal Str_Path)
Dim Str_Source
IF Str_Path <> "" Then
Init_Path = Str_Path
Str_Source = ReadFile(Str_Path)
IF Str_Source <> "" Then
Str_Source = ProcessIncludes (Str_Source, Init_Path, 0)
ConvertToCode Str_Source
FormatCode Str_Source
IF Str_Source <> "" Then
ExecuteGlobal Str_Source
End IF
End IF
'Esto es simplemente una variante al mostrar el error de include
IF Not ObjFsChk.FileExists(Str_Path) Then
Response.Write "<table border='1' cellspacing='0' cellpadding='0' align='center'><tr><td>" & VbCrLf
Response.Write "<font color=""Red"">Error:<BR></font>" & VbCrLF
Response.Write "El archivo <font color=""Red"">" & Str_Path & "</font> No se pudo Incluir"
Response.Write "</td></tr></table>"
End IF
End IF
End Function
Private Sub ConvertToCode(Str_Source)
Dim i, Str_Temp, Arr_Temp, Int_Len, BaseCount
BaseCount = Include_Vars_Count
IF Str_Source <> "" Then
Str_Temp = Replace(Str_Source,"<" & "%","¿%")
Str_Temp = Replace(Str_Temp,"%" & ">","¿")
IF Left(Str_Temp,1) = "¿" Then Str_Temp = Right(Str_Temp,Len(Str_Temp) - 1)
IF Right(Str_Temp,1) = "¿" then Str_Temp = Left(Str_Temp,Len(Str_Temp) - 1)
Arr_Temp = Split(Str_Temp,"¿")
Int_Len = Ubound(Arr_Temp)
IF (Int_Len + 1) > 0 Then
For i = 0 To Int_Len
Str_Temp = Arr_Temp(i)
Str_Temp = Replace(Str_Temp,VbCrLf & VbCrLf,VbCrLf)
IF Left(Str_Temp,2) = VbCrLf Then Str_Temp = Right(Str_Temp,Len(Str_Temp) - 2)
IF Right(Str_Temp,2) = VbCrLf Then Str_Temp = Left(Str_Temp,Len(Str_Temp) - 2)
IF Left(Str_Temp,1) = "%" Then
Str_Temp = Right(Str_Temp,Len(Str_Temp) - 1)
IF Left(Str_Temp,1) = "=" Then
Str_Temp = Right(Str_Temp,Len(Str_Temp) - 1)
Str_Temp = "Response.Write " & Str_Temp
End IF
Else
IF Str_Temp <> "" Then
Include_Vars_Count = Include_Vars_Count + 1
Include_Vars.Add Include_Vars_Count, Str_Temp
Str_Temp = "Response.Write Include_Vars.Item(" & Include_Vars_Count & ")"
End IF
End IF
IF Right(Str_Temp,2) <> VbCrLf Then Str_Temp = Str_Temp
Arr_Temp(i) = Str_Temp
Next
Str_Source = Join(Arr_Temp,VbCrLf)
End IF
End IF
End Sub
Private Function ProcessIncludes(Tmp_Source, CurDir, CurDepth)
Dim Int_Start, Str_Path, Str_Mid, Str_Temp, LocalDir
IF (CurDepth < 20) Then
LocalDir = Left(CurDir, Len(CurDir)-Len(ObjFsChk.GetFileName(CurDir)))
Tmp_Source = Replace(Tmp_Source,"<!-- #","<!--#")
Int_Start = InStr(Tmp_Source,"<!--#Include")
Str_Mid = Lcase(GetBetween(Tmp_Source,"<!--#Include","-->"))
Do Until Int_Start = 0
Str_Mid = Lcase(GetBetween(Tmp_Source,"<!--#Include","-->"))
IF (Str_Mid <> "") Then Int_Start = 1
IF Int_Start > 0 Then
Str_Method = Lcase(Trim(GetBetween(Str_Mid," ","=")))
Str_Temp = Lcase(GetBetween(Str_Mid,chr(34),Chr(34)))
Str_Temp = Trim(Str_Temp)
IF (Str_Method = "File") Then
Newdir = ObjFsChk.BuildPath(LocalDir,Replace(Str_Temp,"/","\"))
Str_Path = ProcessIncludes(ReadFile(Newdir), Newdir, CurDepth+1)
Tmp_Source = Replace(Tmp_Source,"<!--#Include" & Str_Mid & "-->",Str_Path & VbCrLf)
ElseIF (Str_Method = "Virtual") Then
Newdir = Server.MapPath(Str_Temp)
Str_Path = ProcessIncludes(ReadFile(Newdir), Newdir)
Tmp_Source = Replace(Tmp_Source,"<!--#Include" & Str_Mid & "-->",Str_Path & VbCrLf)
Else
Tmp_Source = Replace(Tmp_Source,"<!--#Include" & Str_Mid & "-->","" & VbCrLf)
End IF
End IF
Int_Start = InStr(Tmp_Source,"<!--#Include")
Loop
ProcessIncludes = Tmp_Source
Else
ProcessIncludes = ""
End IF
End Function
Private Sub FormatCode(Str_Code)
Dim i, Arr_Temp, Int_Len
Str_Code = Replace(Str_Code,VbCrLf & VbCrLf,VbCrLf)
IF Left(Str_Code,2) = VbCrLf Then Str_Code = Right(Str_Code,Len(Str_Code) - 2)
Str_Code = Trim(Str_Code)
IF InStr(Str_Code,VbCrLf) > 0 Then
Arr_Temp = Split(Str_Code,VbCrLf)
For i = 0 To Ubound(Arr_Temp)
Arr_Temp(i) = ltrim(Arr_Temp(i))
IF Arr_Temp(i) <> "" Then Arr_Temp(i) = Arr_Temp(i) & VbCrLf
Next
Str_Code = Join(Arr_Temp,"")
Arr_Temp = VbNull
End IF
End Sub
Private Function ReadFile(Str_Path)
Dim ObjFile
IF Str_Path <> "" Then
IF InStr(Str_Path,":") = 0 Then Str_Path = Server.MapPath(Str_Path)
IF ObjFsChk.FileExists(Str_Path) Then
Set ObjFile = ObjFsChk.OpenTextFile(Str_Path, 1, False)
IF Err.Number = 0 Then
IF (Not ObjFile.AtEndOfStream) Then
ReadFile = ObjFile.ReadAll
RegFltr.Global = True
RegFltr.IgnoreCase = True
RegFltr.Pattern = "<%[^=](.|\n)*?%" & ">"
RegFltr2.Global = True
RegFltr2.IgnoreCase = True
RegFltr2.Pattern = """.*?"""
Set Matches = RegFltr.Execute(ReadFile)
pEnd = 0
pStart = 1
Str_Temp_New = ""
For Each Match In Matches
pEnd = Match.FirstIndex + 1
IF (pEnd <> pStart) Then
Str_Temp_New = Str_Temp_New & Mid(ReadFile, pStart, pEnd - pStart)
pStart = pEnd
End IF
Set Matches2 = RegFltr2.Execute(Match.Value)
pEnd2 = 0
pStart2 = 1
cpystr = ""
For Each Match2 in Matches2
pEnd2 = Match2.FirstIndex + 1
IF (pEnd2 <> pStart2) Then
cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
pStart2 = pEnd2
End IF
cpystr = cpystr & Replace(Match2.value,"'","æ")
pEnd2 = pStart2 + Match2.length
pStart2 = pEnd2
Next
IF (pEnd2 < Len(Match.Value)) Then
pEnd2 = Len(Match.Value) + 1
cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
End IF
Set Matches2 = Nothing
RegFltr.Pattern = "'.*?\n"
Str_Temp_New = Str_Temp_New & RegFltr.Replace(cpystr,vbcr)
pEnd = pStart + Match.length
pStart = pEnd
Next
IF (pEnd < len(ReadFile)) Then
pEnd = len(ReadFile) + 1
Str_Temp_New = Str_Temp_New & Mid(ReadFile, pStart, pEnd - pStart)
End IF
ReadFile = Replace(Str_Temp_New,"æ","'")
Else
ReadFile = ""
End IF
ObjFile.close
End IF
Set ObjFile = Nothing
End IF
End IF
End Function
Private Function GetBetween(StrData, StrStart, StrEnd)
Dim IngStart, IngEnd
IngStart = InStr(StrData, StrStart) + Len(StrStart)
IF (IngStart <> 0) Then
IngEnd = InStr(IngStart, StrData, StrEnd)
IF (IngEnd <> 0) Then
GetBetween = Mid(StrData, IngStart, IngEnd - IngStart)
End IF
End IF
End Function
End Class
%>