classcommon.asp

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

      If strTemp <> str Then
         strTemp = strTemp & Lang("BaseConfig.Suspension", "…")
      End If
      GetTopic = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
   End Function
   
   Public Function GetTopic2(ByVal str, ByVal strlen)
      If str = "" Or IsNULL(str) Then
         GetTopic2 = ""
         Exit Function
      End If
	  If ELCLng(strlen) = 0 Then
	     GetTopic2 = str
		 Exit Function
	  End If
	  
	  If ELCLng(strlen) < 0 Then
	     GetTopic2 = ""
		 Exit Function
	  End If
	  
      Dim l, t, c, i, strTemp
      l = Len(str)
      t = 0
      strTemp = str
      strlen = ELCLng(strlen)
      For i = 1 To l
          c = Abs(Asc(Mid(str, i, 1)))
          If c > 255 Then
             t = t + 2
          Else
             t = t + 1
          End If
          If t >= strlen Then
             strTemp = Left(str, i)
             Exit For
          End If
      Next
      If strTemp <> str Then
         strTemp = strTemp & Lang("BaseConfig.Suspension", "…")
      End If
      GetTopic2 = strTemp
   End Function
   
   Public Function StrLength(str)
      Dim WINNT_CHINESE
      WINNT_CHINESE = (Len("中文") = 2)
      If WINNT_CHINESE Then
        Dim l, t, c
        Dim i
        l = Len(str)
        t = l
        For i = 1 To l
            c = Asc(Mid(str, i, 1))
            If c < 0 Then c = c + 65536
            If c > 255 Then
                t = t + 1
            End If
        Next
        StrLength = t
      Else
        StrLength = Len(str)
      End If
   End Function
   
   Public Function ELRound(ByVal num)
      If IsNumeric(num) Then
	     Dim tmp1, tmp2
		 tmp1 = num
		 tmp2 = tmp1 - Int(num)
		 If tmp2 = 0 Then
		    ELRound = num
		 Else
		    If tmp2 >= 0.5 Then
			   ELRound = Int(num) + 1			   
		    Else
			   ELRound = Int(num)
			End If
		 End If
	  Else
	     ELRound = 0
	  End If
   End Function
   
   Public Function ELClng(ByVal lng)
      If IsNumeric(lng) Then
         If lng-Int(lng)<>0 Then
		    ELClng = lng
		 Else
		    ELClng = Clng(lng)
		 End If
      Else
         ELClng = 0
      End If
   End Function
   
   Public Function ELRequest(strFieldName, requestType)'1：字符串， 2：数字, boolean， 3：过滤非法字符  4:替换“'”符号
      If Trim(strFieldName) = "" Then
	     ELRequest = ""
		 If requestType = 2 Then ELRequest = 0
	  Else
	     ELRequest = Trim(Request(strFieldName))
	     Select Case requestType
		   Case 1: ELRequest = ELRequest
		   Case 2: 
		      If ELRequest = "" Then 
			     ELRequest = 0
			  Else
			     ELRequest = ELClng(ELRequest)
			  End If
		   Case 3: ELRequest = ReplaceBadChar(ELRequest)
		   Case 4: ELRequest = Replace(ELRequest, "'", "''")
		 End Select
	  End If
   End Function
   
   Public Function ELSplit(ByVal Str, Seprate)
      If Str = "" Or IsNULL(Str) Then
	     Dim TempStr
		 TempStr = Seprate
		 ELSplit = Split(TempStr, Seprate)
		 Exit Function
	  End If
	  ELSplit = Split(Str, Seprate)
   End Function
   
   Public Function ELFormatCurrency(ByVal C)
      If Not IsNumeric(C) Then
	     ELFormatCurrency = "0.00"
	  Else
	     If C = 0 Then
		    ELFormatCurrency = "0.00"
		 Else
		    ELFormatCurrency = Replace(FormatCurrency(C), "￥", "")
		    ELFormatCurrency = Replace(ELFormatCurrency, "$", "")
		 End If
	  End If
   End Function
   
   Public Function CheckEmail(ByVal email)
      Dim names, name, i, c
      CheckEmail = True
      names = Split(email, "@")
      If UBound(names) <> 1 Then
         CheckEmail = False
         Exit Function
      End If
      For Each name In names
         If Len(name) <= 0 Then
         CheckEmail = False
         Exit Function
         End If
         For i = 1 To Len(name)
            c = LCase(Mid(name, i, 1))
            If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
               CheckEmail = False
               Exit Function
            End If
         Next
         If Left(name, 1) = "." Or Right(name, 1) = "." Then
            CheckEmail = False
            Exit Function
         End If
      Next
      If InStr(names(1), ".") <= 0 Then
         CheckEmail = False
         Exit Function
      End If
      i = Len(names(1)) - InStrRev(names(1), ".")
      If i <> 2 And i <> 3 And i <> 4 Then
         CheckEmail = False
         Exit Function
      End If
      If InStr(email, "..") > 0 Then
         CheckEmail = False
      End If
   End Function
   
   Public Sub Sort(arr, SortType, DataType) '1：升序  -1：降序   DataType: 1-数字 2:-字符
      Dim i, j, l, Temp
	  l = UBound(arr)
	  
	  If SortType <> 1 And SortType <> -1 Then
	     SortType = 1
	  End If
	  
	  For i = 0 To l-1
	     For j = i+1 To l
		    If DataType = 1 Then
			   If SortType = 1 Then
	              If (arr(i) - arr(j)) >0 Then
	                 Temp = arr(i)
		             arr(i) = arr(j)
			         arr(j) = Temp
		          End If
		       Else
		          If (arr(i) - arr(j)) <0 Then
	                 Temp = arr(i)
		             arr(i) = arr(j)
			         arr(j) = Temp
		          End If
		       End If
			Else
	           If StrComp(arr(i),arr(j)) = SortType Then
	              Temp = arr(i)
		          arr(i) = arr(j)
			      arr(j) = Temp
		       End If
			End If
	     Next
      Next
   End Sub
   
   Public Function URLDecode(ByVal EncodeStr)
      Dim NewStr, HaveChar, LastChar, i, Char_C
	  Dim Next_1_C, Next_1_Num
	  NewStr = ""
	  HaveChar = False
	  LastChar = "" 
	  If EncodeStr = "" Then Exit Function
	  For i = 1 To Len(EncodeStr)
	     Char_C = Mid(EncodeStr, i, 1)
		 If Char_C="+" Then 
		    NewStr = NewStr & " " 
		 ElseIf Char_C="%" then 
		    Next_1_C = Mid(EncodeStr, i+1, 2) 
		    Next_1_Num = Cint("&H" & Next_1_C) 
		    If HaveChar Then 
		       HaveChar = False 
		       NewStr = NewStr & Chr(Cint("&H" & LastChar & Next_1_C)) 
		    Else 
		       If Abs(Next_1_Num)<=127 then 
		          NewStr = NewStr & Chr(Next_1_Num) 
		       Else 
		          HaveChar = True 
		          LastChar = Next_1_C 
		       End if 
		    End If 
		    i = i + 2 
		 Else 
		    NewStr = NewStr & Char_C 
		 End If 
      Next 
	  URLDecode = NewStr 
   End Function
   
   Public Function HTMLEncode(ByVal fString)
      Dim TempString
      If fString = "" Or IsNull(fString) Then
         HTMLEncode = ""
	     Exit Function
      Else
         TempString = fString			 
		 TempString = replace(TempString, ">", "&gt;")
		 TempString = replace(TempString, "<", "&lt;")
		 TempString = Replace(TempString, CHR(32), "&nbsp;")
		 TempString = Replace(TempString, CHR(34), "&quot;")
		 TempString = Replace(TempString, CHR(39), "&#39;")
		 TempString = Replace(TempString, CHR(13) & CHR(10), "<BR> ")
		 TempString = Replace(TempString, CHR(13), "<BR> ")
		 TempString = Replace(TempString, CHR(10) & CHR(10), "</P><P> ")
		 TempString = Replace(TempString, CHR(10), "<BR> ")
		 TempString = Replace(TempString, VBCrLf, "<BR> ")
      End If
      HTMLEncode = TempString
   End Function
   
   Public Function HTMLDecode(ByVal fString)
      Dim TempString
      If fString = "" Or IsNull(fString) Then
         HTMLDecode = ""
	     Exit Function
      Else
         TempString = fString			 
		 TempString = replace(TempString, "&gt;", ">")
		 TempString = replace(TempString, "&lt;", "<")
		 TempString = Replace(TempString, "&nbsp;", CHR(32))
		 TempString = Replace(TempString, "&quot;", CHR(34))
		 TempString = Replace(TempString, "&#39;", CHR(39))
		 TempString = Replace(TempString, "<BR> ", CHR(13) & CHR(10))
		 TempString = Replace(TempString, "<BR> ", CHR(13))
		 TempString = Replace(TempString, "</P><P> ", CHR(10) & CHR(10))
		 TempString = Replace(TempString, "<BR> ", CHR(10))
		 TempString = Replace(TempString, "<BR> ", VBCrLf)
      End If
      HTMLDecode = TempString
   End Function
   
   Public Function ServerHTMLEncode(ByVal fString)
      If fString = "" Or IsNULL(fString) Then
	     ServerHTMLEncode = ""
	  Else
	     ServerHTMLEncode = Server.HTMLEncode(fString)
	  End If
   End Function
   
   Public Function ServerURLEncode(ByVal URL)
      If URL = "" Or IsNULL(URL) Then
	     ServerURLEncode = ""
	  Else
	     ServerURLEncode = Server.URLEncode(URL)
	  End If
   End Function
   
   Public Function RemoveHTML(ByVal strHTML)
      Dim objRegExp, Match, Matches 
      Set objRegExp = New Regexp
      objRegExp.IgnoreCase = True
      objRegExp.Global = True
      objRegExp.Pattern = "<.+?>"
      Set Matches = objRegExp.Execute(strHTML)
      For Each Match In Matches 
         strHtml = Replace(strHTML, Match.Value, "")
      Next
      RemoveHTML = strHTML
      Set objRegExp = Nothing
   End Function
   
   Public Function FormatDate(ByVal fDate)
      If IsDate(fDate) = False Then fDate = Date()
	  fDate = FormatDatetime(fDate, 2)
	  Dim arr
	  arr = Split(fDate, "-")
	  FormatDate = arr(0) &"-"& Right("0"& arr(1), 2) &"-"& Right("0"& arr(2), 2)
   End Function
   
   Public Function GetRndNumber()
      Dim RndN, DtNow
	  Randomize
	  DtNow = Now()
	  RndN=int(9999*rnd)+1000
	  GetRndNumber = year(DtNow) & right("0" & month(DtNow),2) & righ