admin_classcollection.asp

依蓝旅游网站管理系统Elan2008.SP2

<%
Class ClassCollection
      
   Private Sub Class_Initialize()
   End Sub
   
   Private Sub Class_Terminate()
   End Sub 
   
   Public Function GetURLSource(ByVal URL, ByVal Charset)
      On Error Resume Next
	  Dim XMLHttp, Str
      Set XMLHttp = Server.CreateObject("MSXML2.XMLHTTP")
      XMLHttp.open "GET", URL, False
      XMLHttp.send()
	  If Err Then
	     Err.Clear
	     GetURLSource = "$RequestError"
		 Exit Function
	  End If
	  If XMLHttp.Status = 200 Then
         GetURLSource = Bytes2BStr(XMLHttp.responseBody, Charset)
	  Else
	     GetURLSource = "$RequestError"
	  End If	  
      Set XMLHttp = Nothing
   End Function

   Public Function Bytes2BStr(ByVal Body, ByVal sCharset)
	  Dim Objstream
	  Set Objstream = Server.CreateObject("adodb." & "stream")
	  Objstream.Type = 1
	  Objstream.Mode =3
	  Objstream.Open
	  Objstream.Write Body
	  Objstream.Position = 0
	  Objstream.Type = 2
	  Objstream.Charset = sCharset
	  Bytes2BStr = Objstream.ReadText 
	  Objstream.Close
	  Set Objstream = nothing
   End Function
   
   Public Function GetBody(ByVal ConStr, ByVal StartStr, ByVal OverStr, ByVal IncluL, ByVal IncluR)
      If ConStr = "$RequestError" Or ConStr = "" Or IsNull(ConStr) = True Or StartStr = "" Or IsNull(StartStr) = True Or OverStr = "" Or IsNull(OverStr) = True Then
         GetBody = "$RequestError"
         Exit Function
      End If
      Dim ConStrTemp
      Dim Start,Over
      ConStrTemp = Lcase(ConStr)
      StartStr = Lcase(StartStr)
      OverStr = Lcase(OverStr)
      Start = InStrB(1, ConStrTemp, StartStr, 0)
      If Start <= 0 then
         GetBody = "$RequestError"		 
         Exit Function
      Else
         If IncluL = False Then
            Start = Start + LenB(StartStr)
         End If
      End If
      Over = InStrB(Start ,ConStrTemp, OverStr, 0)
      If Over<=0 Or Over<=Start then
         GetBody = "$RequestError"
         Exit Function
      Else
         If IncluR = True Then
            Over = Over + LenB(OverStr)
         End If
      End If
      GetBody = MidB(ConStr, Start, Over-Start)
   End Function
   
   Public Function GetArray(Byval ConStr, ByVal StartStr, ByVal OverStr, ByVal IncluL, ByVal IncluR)
      If ConStr = "$RequestError" Or ConStr = "" Or IsNull(ConStr) = True or StartStr = "" Or OverStr = "" or  IsNull(StartStr) = True Or IsNull(OverStr) = True Then
         GetArray = "$RequestError"
         Exit Function
      End If
      Dim TempStr, TempStr2, objRegExp, Matches, Match
      TempStr = ""
      Set objRegExp = New Regexp 
      objRegExp.IgnoreCase = True 
      objRegExp.Global = True
      objRegExp.Pattern = "("& StartStr &").+?("& OverStr &")"
      Set Matches = objRegExp.Execute(ConStr) 
      For Each Match in Matches
         TempStr = EL_Common.Join2String(TempStr, Match.Value, "$Array$")
      Next 
      Set Matches = Nothing
   
      If TempStr = "" Then
         GetArray = "$RequestError"
         Exit Function
      End If
      If IncluL = False then
         objRegExp.Pattern = StartStr
         TempStr = objRegExp.Replace(TempStr, "")
      End if
      If IncluR = False then
         objRegExp.Pattern = OverStr
         TempStr = objRegExp.Replace(TempStr, "")
      End if
      Set objRegExp = nothing
      Set Matches = nothing
   
      TempStr = Replace(TempStr, """", "")
      TempStr = Replace(TempStr, "'", "")
      TempStr = Replace(TempStr, " ", "")
      TempStr = Replace(TempStr, "(", "")
      TempStr = Replace(TempStr, ")", "")

      If TempStr = "" then
         GetArray = "$RequestError"
      Else
         GetArray = TempStr
      End if
   End Function
   
   Function ConvertURL(Byval PrimitiveUrl,Byval ConsultUrl)
      Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
      If PrimitiveUrl = "" Or ConsultUrl = "" Or PrimitiveUrl = "$RequestError" Or ConsultUrl = "$RequestError" Then
         ConvertURL = "$RequestError"
         Exit Function
      End If
      If Left(Lcase(ConsultUrl), 7) <> "http://" Then
         ConsultUrl = "http://" & ConsultUrl
      End If
      ConsultUrl = Replace(ConsultUrl, "\", "/")
      ConsultUrl = Replace(ConsultUrl, "://", ":\\")
      PrimitiveUrl = Replace(PrimitiveUrl, "\", "/")
   
      If Right(ConsultUrl,1)<>"/" Then
         If Instr(ConsultUrl,"/")>0 Then
            If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then   
            Else
               ConsultUrl=ConsultUrl & "/"
            End If
         Else
            ConsultUrl=ConsultUrl & "/"
         End If
      End If
      ConArray=Split(ConsultUrl,"/")
   
      If Left(LCase(PrimitiveUrl),7) = "http://" then
         ConvertURL=Replace(PrimitiveUrl,"://",":\\")
      ElseIf Left(PrimitiveUrl,1) = "/" Then
         ConvertURL=ConArray(0) & PrimitiveUrl
      ElseIf Left(PrimitiveUrl,2)="./" Then
         PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)
         If Right(ConsultUrl,1)="/" Then   
            ConvertURL=ConsultUrl & PrimitiveUrl
         Else
            ConvertURL=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
         End If
      ElseIf Left(PrimitiveUrl,3)="../" then
         Do While Left(PrimitiveUrl,3)="../"
            PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
            Pi=Pi+1
         Loop            
         For Ci=0 to (Ubound(ConArray)-1-Pi)
            If ConvertURL<>"" Then
               ConvertURL=ConvertURL & "/" & ConArray(Ci)
            Else
               ConvertURL=ConArray(Ci)
            End If
         Next
         ConvertURL=ConvertURL & "/" & PrimitiveUrl
      Else
         If Instr(PrimitiveUrl,"/")>0 Then
            PriArray=Split(PrimitiveUrl,"/")
            If Instr(PriArray(0),".")>0 Then
               If Right(PrimitiveUrl,1)="/" Then
                  ConvertURL="http:\\" & PrimitiveUrl
               Else
                  If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 
                     ConvertURL="http:\\" & PrimitiveUrl
                  Else
                     ConvertURL="http:\\" & PrimitiveUrl & "/"
                  End If
               End If      
            Else
               If Right(ConsultUrl,1)="/" Then   
                  ConvertURL=ConsultUrl & PrimitiveUrl
               Else
                  ConvertURL=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
               End If
            End If
         Else
            If Instr(PrimitiveUrl,".")>0 Then
               If Right(ConsultUrl,1)="/" Then
                  If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
                     ConvertURL="http:\\" & PrimitiveUrl & "/"
                  Else
                     ConvertURL=ConsultUrl & PrimitiveUrl
                  End If
               Else
                  If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
                     ConvertURL="http:\\" & PrimitiveUrl & "/"
                  Else
                     ConvertURL=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
                  End If
               End If
            Else
               If Right(ConsultUrl,1)="/" Then
                  ConvertURL=ConsultUrl & PrimitiveUrl & "/"
               Else
                  ConvertURL=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
               End If         
            End If
         End If
      End If
      If Left(ConvertURL,1)="/" then
        ConvertURL=Right(ConvertURL,Len(ConvertURL)-1)
      End if
      If ConvertURL<>"" Then
         ConvertURL=Replace(ConvertURL,"//","/")
         ConvertURL=Replace(ConvertURL,":\\","://")
      Else
         ConvertURL="$RequestError"
      End If
   End Function
   
   Public Function FliterScript(ByVal ConStr, ByVal TagName, ByVal FType)
       Dim Re, Matches, Match
       Set Re = New RegExp
       Re.IgnoreCase = True