<%
dim cacheflag
    cacheflag = setcookies
Function FormatDate(DateAndTime, Format)
    On Error Resume Next
    Dim yy, y, m, d, h, mi, s, strDateTime
    FormatDate = DateAndTime
    If Not IsNumeric(Format) Then Exit Function
    If Not IsDate(DateAndTime) Then Exit Function
    yy = CStr(Year(DateAndTime))
    y = Mid(CStr(Year(DateAndTime)), 3)
    m = CStr(Month(DateAndTime))
    If Len(m) = 1 Then m = "0" & m
    d = CStr(Day(DateAndTime))
    If Len(d) = 1 Then d = "0" & d
    h = CStr(Hour(DateAndTime))
    If Len(h) = 1 Then h = "0" & h
    mi = CStr(Minute(DateAndTime))
    If Len(mi) = 1 Then mi = "0" & mi
    s = CStr(Second(DateAndTime))
    If Len(s) = 1 Then s = "0" & s
    Select Case Format
        Case "1"
            strDateTime = yy & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
        Case "2"
            strDateTime = yy & m & d & h & mi & s
        Case "3"
            strDateTime = yy & m & d & h & mi
        Case "4"
            strDateTime = yy & "年" & m & "月" & d & "日"
        Case "5"
            strDateTime = m & "-" & d
        Case "6"
            strDateTime = m & "/" & d
        Case "7"
            strDateTime = m & "月" & d & "日"
        Case "8"
            strDateTime = y & "年" & m & "月"
        Case "9"
            strDateTime = y & "-" & m
        Case "10"
            strDateTime = y & "/" & m
        Case "11"
            strDateTime = y & "-" & m & "-" & d
        Case "12"
            strDateTime = yy & "/" & m & "/" & d
        Case "13"
            strDateTime = yy & "." & m & "." & d
        Case "14"
            strDateTime = yy & "-" & m & "-" & d
        Case Else
            strDateTime = DateAndTime
    End Select
    FormatDate = strDateTime
End Function
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ",--"
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceBadChar = tempChar
End Function
Function ReplaceConstChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceConstChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},;,:," & Chr(34) & "," & Chr(0) & ",--"
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceConstChar = tempChar
End Function
Function StrLen(Str)
    If Str = "" Or IsNull(Str) Then
        StrLen = 0
        Exit Function
    Else
        Dim regex
        Set regex = New regexp
        regEx.Pattern = "[^\x00-\xff]"
        regex.Global = True
        Str = regEx.Replace(Str, "^^")
        Set regex = Nothing
        StrLen = Len(Str)
    End If
End Function
Function StrLeft(Str, StrLen)
    Dim L, T, I, C
    If Str = "" Then
        StrLeft = ""
        Exit Function
    End If
    Str = Replace(Replace(Replace(Replace(Str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
    L = Len(Str)
    T = 0
    For i = 1 To L
        C = Abs(AscW(Mid(Str, i, 1)))
        If C>255 Then
            T = T + 2
        Else
            T = T + 1
        End If
        If T>= StrLen Then
            StrLeft = Left(Str, i) & "…"
            Exit For
        Else
            StrLeft = Str
        End If
    Next
    StrLeft = Replace(Replace(Replace(Replace(StrLeft, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
End Function
Function StrReplace(Str)
    If Str = "" Or IsNull(Str) Then
        StrReplace = ""
        Exit Function
    Else
        StrReplace = Replace(Str, " ", "&nbsp;")
        StrReplace = Replace(StrReplace, Chr(13), "&lt;br&gt;")
        StrReplace = Replace(StrReplace, "<", "&lt;")
        StrReplace = Replace(StrReplace, ">", "&gt;")
    End If
End Function
Function ReStrReplace(Str)
    If Str = "" Or IsNull(Str) Then
        ReStrReplace = ""
        Exit Function
    Else
        ReStrReplace = Replace(Str, "&nbsp;", " ")
        ReStrReplace = Replace(ReStrReplace, "<br />", Chr(13))
        ReStrReplace = Replace(ReStrReplace, "&lt;br&gt;", Chr(13))
        ReStrReplace = Replace(ReStrReplace, "&lt;", "<")
        ReStrReplace = Replace(ReStrReplace, "&gt;", ">")
    End If
End Function
Function HtmlStrReplace(Str)
    If Str = "" Or IsNull(Str) Then
        HtmlStrReplace = ""
        Exit Function
    Else
        HtmlStrReplace = Replace(Str, "&lt;br&gt;", "<br />")
    End If
End Function

Function CheckStr(Strer, Num)
    Dim Shield, w
    If Strer = "" Or IsNull(Strer) Then Exit Function
    Select Case Num
        Case 1
            If IsNumeric(Strer) = 0 Then
                Response.Write "操作错误"
                Response.End
            End If
            Strer = Int(Strer)
    End Select
    CheckStr = Strer
End Function

'载入模版文件
Function FileSetTemplate(TxtPath)
Dim objStream,EditFile
Set objStream = CreateObject("adodb.stream")   
          EditFile=TxtPath   
          objStream.Type=2   
          objStream.Mode = 3   
          objStream.Charset = "utf-8"   
          objStream.Open   
          objStream.LoadFromFile Server.MapPath(SysRootDir&templatepath&EditFile)   
          FileSetTemplate = objStream.ReadText   
          objStream.Close   
Set objStream = Nothing
End Function
Function FileSetTemplategb(FilePath)
Dim fso,FileText,Templatecontent
Set fso = Server.CreateObject("Scripting.FileSystemObject")
set FileText=fso.OpentextFile(Server.Mappath(templatepath&FilePath))
Templatecontent=FileText.readall
FileSetTemplate=Templatecontent
End Function 



'清空缓存函数clscache()
Function clscache()
    Dim cacheobj
    application.Lock
    For Each cacheobj In application.contents
        If CStr(Left(cacheobj, Len(Cacheflag))) = CStr(Cacheflag) Then application.contents.Remove (cacheobj)
    Next
    application.unlock
End Function
'清空缓存函数结束


Function setcache(cachename, cachevalue)
    Dim cachedata,Cacheflag
    cachename = LCase(filterstr(cachename))
    cachedata = application(Cacheflag & cachename)
    If IsArray(cachedata) Then
        cachedata(0) = Cachevalue
        cachedata(1) = Now()
    Else
        ReDim cachedata(2)
        cachedata(0) = Cachevalue
        cachedata(1) = Now()
    End If
    application.Lock
    application(Cacheflag & cachename) = cachedata
    application.unlock
End Function
Function getcache(cachename)
    Dim cachedata,Cacheflag
    cachename = LCase(filterstr(cachename))
    cachedata = application(Cacheflag & cachename)
    If IsArray(cachedata) Then getcache = cachedata(0) Else getcache = ""
End Function
Function chkcache(cachename)
    Dim cachedata,Cacheflag,Cachetime
	Cachetime=1
    chkcache = False
    cachename = LCase(filterstr(cachename))
    cachedata = application(Cacheflag & cachename)
    If Not IsArray(cachedata) Then Exit Function
    If Not IsDate(cachedata(1)) Then Exit Function
    If DateDiff("s", CDate(cachedata(1)), Now()) < 60 * Cachetime Then chkcache = True
End Function
Function filterstr(Str)
    filterstr = LCase(Str)
    filterstr = Replace(filterstr, " ", "")
    filterstr = Replace(filterstr, "'", "")
    filterstr = Replace(filterstr, """", "")
    filterstr = Replace(filterstr, "=", "")
    filterstr = Replace(filterstr, "*", "")
End Function
Sub DoDelslhtml(htmlname)
    On Error Resume Next
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    servermap = server.MapPath("..")
    servermap = servermap&"\"&htmlname
    FSO.DeleteFile(servermap)
    Set FSO = Nothing
End Sub

%>