<%
Class Cls_Fun

    Public Function HexToStr(ByVal x)
        Dim i
        x = Replace(LCase(x), "\u", "")
        For i = 1 To Len(x) Step 4
            HexToStr = HexToStr & Chrw("&H" & Mid(X, i, 4))
        Next
    End Function

    Public Function GetTag(ByVal Val)
        If Easp.IsN(Val) Then
            Exit Function
        End If
        Dim ReturnVal, i, c
        ReturnVal = ""
        For i = 1 To Len(Val)
            c = (Mid(Val, i, 1))
            If ascw(c)>256 Or ascw(c)<0 Then
                ReturnVal = ReturnVal & Hex(ascw(c))
            Else
                ReturnVal = ReturnVal & c
            End If
        Next
        GetTag = ReturnVal
    End Function

    Public Sub ShowJsonMsg(ByVal ErrorNum, ByVal ErrorMessage)
        Easp.Use "json"
        Easp.json.addData "error", ErrorNum
        Easp.json.addData "message", ErrorMessage & ""
        Easp.WE Easp.Json.jsString()
    End Sub

    ' 判断函数是否存在,只能是函数

    Public Function FunIsExists(ByVal FunName)
        On Error Resume Next
        Dim v, oGetRef
        v = CStr(FunName)
        Set oGetRef = GetRef(v)
        If Err.Number = 0 Then
            function_exists = True
        Else
            Execute("Call " & v & "(" & Replace(Space(256), Space(1), "Null, ") & "Null)")
            If Err.Number = 450 Then
                FunIsExists = True
            Else
                FunIsExists = False
            End If
        End If
    End Function

    '===============================================
    '函数名：LoadToUrl
    '作  用：获取上一页来源
    '参  数：无
    '返回值：上一页来源
    '===============================================

    Public Function LoadToUrl()
        LoadToUrl = Request.ServerVariables("HTTP_REFERER")
    End Function

    '========================================================
    '函数名：ChkNumEric
    '作  用：检查字符中是否有非法字符：针对整型数字
    '参  数：#intVal    待检整数
    '返回值：过滤后的整数
    '========================================================

    Public Function ChkNumEric(ByVal intVal)
        If Not Easp.IsN(intVal) And IsNumeric(intVal) Then
            If intVal < 0 Then intVal = 0
            If intVal > 2147483647 Then intVal = 0
            intVal = CLng(intVal)
        Else
            intVal = 0
        End If
        ChkNumEric = intVal
    End Function

    ' 自动补0

    Public Function ZeroFill(ByVal Num, ByVal Num_Length)
        Dim ZeroFill_i, ZeroFill_ReturnNum
        For ZeroFill_i = Len(Num) To Num_Length -1
            ZeroFill_ReturnNum = ZeroFill_ReturnNum & "0"
        Next
        ZeroFill_ReturnNum = ZeroFill_ReturnNum & Num
        ZeroFill = ZeroFill_ReturnNum
    End Function

    '标记高亮关键字

    Public Function Highlight(ByVal strContent, ByVal keyword)
        If Easp.IsN(keyword) Then
            Highlight = strContent
            Exit Function
        Else
            Dim RegEx, ArrayKeyword, i
            Set RegEx = New RegExp
            RegEx.IgnoreCase = True '不区分大小写
            RegEx.Global = True
            ArrayKeyword = Split(keyword, " ")'用空格隔开的多关键字
            For i = 0 To UBound(ArrayKeyword)
                RegEx.Pattern = "("&ArrayKeyword(i)&")"
                strContent = RegEx.Replace(strContent, "<font color=""red"">$1</font>")
            Next
            Set RegEx = Nothing
            Highlight = strContent
        End If
    End Function

    '=============================================================
    '函数作用：过滤HTML代码，不带脏话过滤
    '=============================================================

    Public Function HtmlRCdoe(ByVal fString)
        If Not Easp.IsN(fString) Then
            fString = Replace(fString, ">", "&gt;")
            fString = Replace(fString, "<", "&lt;")
            fString = Replace(fString, Chr(32), "&nbsp;")
            fString = Replace(fString, Chr(9), "&nbsp;")
            fString = Replace(fString, Chr(34), "&quot;")
            fString = Replace(fString, Chr(39), "&#39;")
            fString = Replace(fString, Chr(13), "")
            fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
            fString = Replace(fString, Chr(10), "<br>")
            HtmlRCdoe = fString
        End If
    End Function

    '========================================================
    '函数名：ShowColor
    '作  用：字符串加颜色Font模式
    '参  数：Val				##### 信息字符串
    '		 color				##### 颜色字符串
    '返回值：新字符串
    '========================================================

    Public Function ShowColor(ByVal Val, ByVal color)
        If Easp.IsN(Val) Then
            ShowColor = ""
            Exit Function
        Else
            If Easp.IsN(color) Then
                ShowColor = Val
            Else
                ShowColor = "<font style=""color:"& color &""">"& Val &"</font>"
            End If
        End If
    End Function

    '===============================================
    '函数名：GetSpic
    '作  用：获取缩略图
    '参  数：UpPic		##### 原图
    '返回值：缩略图
    '===============================================

    Public Function GetSpic(ByVal UpPic)
        Dim PicTemp
        If Easp.IsN(UpPic) Then
            Exit Function
        Else
            Easp.Use "fso"
            If Easp.Fso.IsFile(UpPic) Then
                If Easp.Fso.IsFile(Replace(UpPic, ".", "s.")) Then
                    PicTemp = Replace(UpPic, ".", "s.")
                Else
                    PicTemp = UpPic
                End If
            Else
                Exit Function
            End If
        End If
        GetSpic = PicTemp
    End Function

    '===============================================
    '函数名：IsImages
    '作  用：判断文件后缀是否是图片
    '参  数：Str		##### 要判断的值
    '示  例：IsImages("1.jpg") 返回：.jpg
    '返回值：False|True
    '===============================================

    Public Function IsImages(ByVal Str)
        Dim ReturnVal, strTemp, ExtTemp
        If (IsNull(Str) Or Str = "") Then
            ReturnVal = False
        Else
            Easp.Use("fso")
            strTemp = LCase(Str)
            ExtTemp = Easp.Fso.ExtOf(strTemp)
            If (ExtTemp = ".jpg" Or ExtTemp = ".jpeg" Or ExtTemp = ".png" Or ExtTemp = ".gif" Or ExtTemp = ".bmp") Then
                ReturnVal = True
            Else
                ReturnVal = False
            End If
        End If
        IsImages = ReturnVal
    End Function

    '========================================================
    '函数名：DateToInfo
    '作  用：给今天的信息的时间加信息
    '参  数：DateAndTime   ---- 原日期和时间
    '		 ToInfo		---- 需要加的信息
    '返回值：时间加红后的日期
    '========================================================

    Public Function DateToInfo(ByVal DateAndTime, ByVal ToInfo)
        Dim ShowDateMode
        If Not IsDate(DateAndTime) Then
            DateToInfo = ""
            Exit Function
        End If
        If DateDiff("d", Now(), CDate(DateAndTime)) < 0 Then
            ShowDateMode = ""
        Else
            ShowDateMode = ToInfo
        End If
        DateToInfo = ShowDateMode
    End Function

    '========================================================
    '函数名：DateToString
    '作  用：给今天的信息的时间加红,返回格式：yyyy-mm-dd
    '参  数：DateAndTime   ---- 原日期和时间
    '返回值：时间加红后的日期
    '========================================================

    Public Function DateToString(ByVal DateAndTime)
        Dim ShowDateMode
        If Not IsDate(DateAndTime) Then
            DateToString = Easp.DateTime(Now(), "yyyy-mm-dd")
            Exit Function
        End If
        If DateDiff("d", Now(), CDate(DateAndTime)) < 0 Then
            ShowDateMode = Easp.DateTime(DateAndTime, "yyyy-mm-dd")
        Else
            ShowDateMode = ShowColor(Easp.DateTime(DateAndTime, "yyyy-mm-dd"), "#ff0000")
        End If
        DateToString = ShowDateMode
    End Function

    '========================================================
    '函数名：TimeToString
    '作  用：给今天的信息的时间加红
    '参  数：DateAndTime	---- 原日期和时间
    '		 DateMode		---- 显示格式
    '返回值：时间加红后的日期
    '========================================================

    Public Function TimeToString(ByVal DateAndTime, ByVal DateMode)
        Dim ShowDateMode
        If Not IsDate(DateAndTime) Then
            DateToString = Easp.DateTime(Now(), DateMode)
            Exit Function
        End If
        If DateDiff("d", Now(), CDate(DateAndTime)) < 0 Then
            ShowDateMode = Easp.DateTime(DateAndTime, DateMode)
        Else
            ShowDateMode = ShowColor(Easp.DateTime(DateAndTime, DateMode), "#ff0000")
        End If
        TimeToString = ShowDateMode
    End Function

    '========================================================
    '函数名：GetSize
    '作  用：把数字转换为文件大小显示方式
    '参  数：iSize   ---- 数字大小
    '返回值：字节大小
    '========================================================

    Public Function GetSize(ByVal iSize)
        Dim sRet, KB, MB, S
        KB = 1024
        MB = KB * KB
        If Not IsNumeric(iSize) Then
            GetSize = "未知"
            Exit Function
        End If
        If iSize < KB Then
            sRet = iSize & " Bytes"
        Else
            S = iSize / KB
            If S < 10 Then
                sRet = FormatNumber(iSize / KB, 2, -1) & " KB"
            ElseIf S < 100 Then
                sRet = FormatNumber(iSize / KB, 1, -1) & " KB"
            ElseIf S < 1000 Then
                sRet = FormatNumber(iSize / KB, 0, -1) & " KB"
            ElseIf S < 10000 Then
                sRet = FormatNumber(iSize / MB, 2, -1) & " MB"
            ElseIf S < 100000 Then
                sRet = FormatNumber(iSize / MB, 1, -1) & " MB"
            ElseIf S < 1000000 Then
                sRet = FormatNumber(iSize / MB, 0, -1) & " MB"
            ElseIf S < 10000000 Then
                sRet = FormatNumber(iSize / MB / KB, 2, -1) & " GB"
            Else
                sRet = FormatNumber(iSize / MB / KB, 1, -1) & " GB"
            End If
        End If
        GetSize = sRet
    End Function

    '================================================
    '函数名：ReadFontMode
    '作  用：读取字体模式Font模式
    '参  数：Val			----原字符串
    '        ColorVal		-----颜色的值
    '        IsBoldVal		-----是否粗体
    '返回值：新字符串
    '================================================

    Public Function ReadFontMode(ByVal Val, ByVal ColorVal, ByVal IsBoldVal)
        Dim FontStr, ColorStr
        If Easp.IsN(Val) Then
            ReadFontMode = ""
            Exit Function
        End If
        If Easp.IsN(ColorVal) Then
            ColorStr = Val
        Else
            ColorStr = ShowColor(Val, ColorVal)
        End If
        If CmsFun.ChkNumEric(IsBoldVal) > 0 Then
            ReadFontMode = "<b>" & ColorStr & "</b>"
        Else
            ReadFontMode = ColorStr
        End If
    End Function

    '================================================
    '函数名：ReadCssFontMode
    '作  用：读取字体模式CSS模式
    '参  数：ColorVal		-----颜色的值
    '        IsBoldVal		-----是否粗体
    '返回值：新字符串
    '================================================

    Public Function ReadCssFontMode(ByVal ColorVal, ByVal IsBoldVal)
        Dim strTemp
        If (ColorVal <> "" Or IsBoldVal > 0) Then
            strTemp = " style="""
            If ColorVal <> "" Then
                strTemp = strTemp & "color:" & ColorVal & ";"
            End If
            If IsBoldVal > 0 Then
                strTemp = strTemp & "font-weight:bold;"
            End If
            strTemp = strTemp & """"
        Else
            strTemp = ""
        End If
        ReadCssFontMode = strTemp
    End Function

    '===============================================
    '函数名：MakeThumb
    '作  用：缩略图生成函数
    '参  数：生成文件全路径、保存文件全路径、限定宽度、限定高度、生成方式
    '示  例：MakeThumb("1.jpg","2.jpg",100,100,2)
    '返回值：缩略图相对路径
    '===============================================

    Public Function MakeThumb(ByVal OriginalPath, ByVal SaveNamePath, ByVal limitW, ByVal limitH, ByVal nType)
        If Easp.IsN(OriginalPath) Then
            Exit Function
        Else
            Dim FileExt, PicInfo, PicHeight, PicWidth
            If (limitW <= 0 Or limitH <= 0) Then
                Exit Function
            Else
                If Easp.IsInstall("Persits.Jpeg") Then
                    Easp.Use "fso"
                    If Easp.Fso.IsFile(OriginalPath) Then
                        FileExt = Easp.Fso.ExtOf(OriginalPath)
                        If (FileExt = ".jpg" Or FileExt = ".jpeg") Then
                            Set PicInfo = Server.CreateObject("Persits.Jpeg")
                            PicInfo.Open Server.MapPath(OriginalPath)
                            PicWidth = PicInfo.OriginalWidth
                            PicHeight = PicInfo.OriginalHeight
                            Set PicInfo = Nothing
                            If PicWidth < limitW And PicHeight < limitH Then
                                Exit Function
                            Else
                                Dim objJpeg, oh, ow
                                Set objJpeg = Server.CreateObject("Persits.Jpeg")
                                objJpeg.Open Server.MapPath(OriginalPath)
                                oh = objJpeg.OriginalHeight
                                ow = objJpeg.OriginalWidth
                                Select Case nType
                                    Case 0
                                        ' 限定宽高
                                        If limitW > 0 And limitH > 0 Then
                                            objJpeg.Width = limitW
                                            objJpeg.height = limitH
                                        End If
                                    Case 1
                                        ' 只限定宽度, 高度按比例
                                        If limitW > 0 Then
                                            objJpeg.Width = limitW
                                            objJpeg.height = oh / ow * limitW
                                        End If
                                    Case 2
                                        ' 只限定高度，宽度按比例
                                        If limitH > 0 Then
                                            objJpeg.height = limitH
                                            objJpeg.Width = ow / oh * limitH
                                        End If
                                    Case 3
                                        ' 按限定的宽高比裁切
                                        If limitW > 0 And limitH > 0 Then
                                            Dim lheight
                                            lheight = oh * limitW / ow
                                            If lheight<limitH Then
                                                objJpeg.Height = limitH
                                                objJpeg.Width = ow * objJpeg.Height / oh
                                            Else
                                                objJpeg.Width = limitW
                                                objJpeg.Height = oh * objJpeg.Width / ow
                                            End If
                                            objJpeg.Crop 0, 0, limitW, limitH
                                        End If
                                    Case Else
                                        Exit Function
                                End Select
                                objJpeg.Quality = 100
                                objJpeg.Interpolation = 1
                                objJpeg.Save Server.MapPath(SaveNamePath)
                                MakeThumb = SaveNamePath
                                Set objJpeg = Nothing
                            End If
                        Else
                            Exit Function
                        End If
                    Else
                        Exit Function
                    End If
                Else
                    Exit Function
                End If
            End If
        End If
    End Function

    Public Function CreateWaterMark(ByVal OriginalFile, ByVal LogoFilePath, ByVal LogoFilePosition)
        If Easp.IsInstall("Persits.Jpeg") Then
            Easp.Use "fso"
            If (Easp.IsN(OriginalFile) Or Not Easp.Fso.IsFile(OriginalFile)) Then
                Exit Function
            End If
            If (Easp.IsN(LogoFilePath) Or Not Easp.Fso.IsFile(LogoFilePath)) Then
                Exit Function
            End If
            Dim FileExt, LogoInfo, LogoWidth, LogoHeight
            FileExt = Easp.Fso.ExtOf(OriginalFile)
            If (FileExt = ".jpg" Or FileExt = ".jpeg" Or FileExt = "gif" Or FileExt = ".png") Then
                '============= 获取Logo图片的宽度高度
                Set LogoInfo = Server.CreateObject("Persits.Jpeg")
                LogoInfo.Open Easp.Fso.MapPath(LogoFilePath)
                LogoWidth = LogoInfo.OriginalWidth
                LogoHeight = LogoInfo.OriginalHeight
                Set LogoInfo = Nothing
                If (LogoWidth < 50 Or LogoHeight < 50) Then
                    Exit Function
                End If
                '=============================
                Dim Jpeg, JpegPath, PositionX, PositionY
                Set Jpeg = Server.CreateObject("Persits.Jpeg")
                JpegPath = Easp.Fso.MapPath(OriginalFile)
                Jpeg.Open JpegPath
                Jpeg.Interpolation = 1
                Jpeg.Quality = 100
                If (Jpeg.OriginalWidth < LogoWidth) Then
                    Exit Function
                Else
                    PositionX = GetSyPosX(LogoFilePosition, Jpeg.OriginalWidth, LogoWidth)
                    PositionY = GetSyPosY(LogoFilePosition, Jpeg.OriginalHeight, LogoHeight)
                    Jpeg.Canvas.DrawPNG PositionX, PositionY, Easp.Fso.MapPath(LogoFilePath)
                    Jpeg.Save Easp.Fso.MapPath(OriginalFile)
                End If
                Set Jpeg = Nothing
            End If
        End If
        CreateWaterMark = OriginalFile
    End Function

    Public Function CreateWaterMarkText(ByVal OriginalFile, ByVal PrintText, ByVal TextPos)
        If Easp.IsInstall("Persits.Jpeg") Then
            Easp.Use "fso"
            Dim MarkFile
            MarkFile = "/images/mark_text.png"
            If (Easp.IsN(OriginalFile) Or Not Easp.Fso.IsFile(OriginalFile)) Then
                Exit Function
            End If
            If (Easp.IsN(MarkFile) Or Not Easp.Fso.IsFile(MarkFile)) Then
                Exit Function
            End If
            Dim Jpeg, sys, FileExt
            FileExt = Easp.Fso.ExtOf(OriginalFile)
            If (FileExt = ".jpg" Or FileExt = ".jpeg" Or FileExt = "gif" Or FileExt = ".png") Then
                Set Jpeg = Server.CreateObject("Persits.Jpeg")
                Jpeg.Open Easp.Fso.MapPath(OriginalFile)
                Set sys = Server.CreateObject("Persits.Jpeg")
                sys.Open Easp.Fso.MapPath(MarkFile)
                Jpeg.DrawImage 0, Jpeg.height - sys.height, sys, 0.5, &Hf00000
                Set sys = Nothing
                Jpeg.Canvas.Font.Color = &HFFFFFF
                Jpeg.Canvas.Font.Family = "Tahoma"
                Jpeg.Canvas.Font.Size = 13
                Jpeg.Canvas.Font.Quality = 4
                If InStr(PrintText, "|") > 0 Then
                    Jpeg.Canvas.Print Jpeg.OriginalWidth - 100, Jpeg.OriginalHeight - 16, CStr(Split(PrintText, "|")(1))
                    Jpeg.Canvas.Print 5, Jpeg.OriginalHeight - 16, CStr(Split(PrintText, "|")(0))
                Else

                    If TextPos = 0 Then
                        Jpeg.Canvas.Print 5, Jpeg.OriginalHeight - 16, PrintText
                    Else
                        Jpeg.Canvas.Print Jpeg.OriginalWidth - 100, Jpeg.OriginalHeight - 16, PrintText
                    End If
                End If
                Jpeg.Interpolation = 1
                Jpeg.Quality = 100
                Jpeg.Save Easp.Fso.MapPath(OriginalFile)
                Set Jpeg = Nothing
            End If
        End If
        CreateWaterMarkText = OriginalFile
    End Function

    Private Function GetSyPosX(ByVal PosX, ByVal PicFileWidth , ByVal LogoFileWidth)
        Dim ReturnPosX
        Select Case PosX
            Case 1
                ReturnPosX = 10
            Case 2
                ReturnPosX = PicFileWidth - LogoFileWidth - 10
            Case 3
                ReturnPosX = 10
            Case 4
                ReturnPosX = PicFileWidth - LogoFileWidth - 10
            Case 5
                ReturnPosX = PicFileWidth \ 2 - LogoFileWidth \ 2
            Case Else
                ReturnPosX = PicFileWidth - LogoFileWidth - 10
        End Select
        GetSyPosX = ReturnPosX
    End Function

    Private Function GetSyPosY(ByVal PosY, ByVal PicFileHeight , ByVal LogoFileHeight)
        Dim ReturnPosY
        Select Case PosY
            Case 1
                ReturnPosY = 10
            Case 2
                ReturnPosY = 10
            Case 3
                ReturnPosY = PicFileHeight - LogoFileHeight - 10
            Case 4
                ReturnPosY = PicFileHeight - LogoFileHeight - 10
            Case 5
                ReturnPosY = PicFileHeight \ 2 - LogoFileHeight \ 2 - 10
            Case Else
                ReturnPosY = PicFileHeight - LogoFileHeight - 10
        End Select
        GetSyPosY = ReturnPosY
    End Function

    '========================================================
    '函数名：HtmlFileUrl
    '功  能：取出文件的路径
    '参  数：
    '		1、ClassPath ：文件夹路径
    '		2、HtmlFileName ：自定义文件名
    '		3、Id ：内容ID
    '调 用：HtmlFilePath(fname)
    '========================================================

    Public Function HtmlFileUrl(ByVal ClassPath, ByVal HtmlFileName, ByVal Id)
        Dim TempFileName
        If Easp.IsN(HtmlFileName) Then
            TempFileName = Id
        Else
            TempFileName = HtmlFileName
        End If
        HtmlFileUrl = ClassPath & TempFileName &".html"
    End Function

    '========================================================
    '函数名：GetClassVal
    '功  能：获取大类所以小类ID（包含大类本身）
    '参  数：
    '		1、ChannelId		##### 频道ID
    '		2、ClassId			##### 分类ID
    '调 用：GetClassVal(ChannelId,ClassId)
    '========================================================

    Public Function GetClassVal(ByVal ChannelId, ByVal ClassId)
        Dim TempStr, oRs
        If ChannelId = 0 And Easp.IsN(ClassId) Then
            TempStr = ""
        Else
            Set oRs = Easp.db.GR(TablePrefix & "Type:ChildIdAll:1", " ChannelId = "& ChannelId &" And Id = " & ClassId & " ", "")
            If Easp.IsN(oRs) Then
                TempStr = ""
            Else
                TempStr = oRs(0)
            End If
            Easp.C oRs
        End If
        GetClassVal = TempStr
    End Function

    '========================================================
    '函数名：GetChannelField
    '功  能：根据频道ID，字段返回字段的值
    '参  数：
    '		1、ChannelId		##### 频道ID
    '		1、FieldVal			##### 字段名
    '调 用：GetChannelField(ByVal ChannelId, ByVal FieldVal)
    '========================================================

    Public Function GetChannelField(ByVal ChannelId, ByVal FieldVal)
        Dim Id, oRs, StrTemp
        Id = ChkNumEric(ChannelId)
        If Id = 0 Then
            StrTemp = ""
        Else
            Set oRs = Easp.db.GR(TablePrefix & "Channel:"& FieldVal &":1", " Id = "& Id &" ", "")
            If Easp.IsN(oRs) Then
                StrTemp = ""
            Else
                StrTemp = oRs(0)
            End If
            Easp.db.C oRs
        End If
        GetChannelField = StrTemp
    End Function

End Class

%>