function.asp

1

'**************************************************
'函数名：yonghuguolv
'作  用：将html 标记替换成 能在IE显示的HTML
'参  数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
function yonghuguolv(fString)
If not isnull(fString) then
    fString = replace(fString, "<", "&lt;")
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "'", "'")
    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>")
    yonghuguolv = fString
End If
End function

function HTMLEncode(fString)
If not isnull(fString) then
    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> ")
    HTMLEncode = fString
End If
End function

'**************************************************
'函数名：GetStrLen
'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Function GetStrLen(str)
    On Error Resume Next
    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
        GetStrLen = t
    Else
        GetStrLen = Len(str)
    End If
    If Err.Number <> 0 Then Err.Clear
End Function


'**************************************************
'函数名：nohtml
'作  用：过滤html 元素
'参  数：str ---- 要过滤字符
'返回值：没有html 的字符
'**************************************************
Function nohtml(ByVal str)
    If IsNull(str) Or Trim(str) = "" Then
        nohtml = ""
        Exit Function
    End If
    regEx.Pattern = "(\<.[^\<]*\>)"
    str = regEx.Replace(str, "")
    regEx.Pattern = "(\<\/[^\<]*\>)"
    str = regEx.Replace(str, "")
    str = Replace(str, "'", "")
    str = Replace(str, Chr(34), "")
    str = Replace(str, vbCrLf, "")
    str = Trim(str)
    nohtml = str
End Function


'**************************************************
'函数名：GetSubStr
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'        strlen ----截取长度
'        bShowPoint ---- 是否显示省略号
'返回值：截取后的字符串
'**************************************************
Function GetSubStr(ByVal str, ByVal strlen, bShowPoint)
    If str = "" Then
        GetSubStr = ""
        Exit Function
    End If
    Dim l, t, c, i, strTemp    
    str =Replace(nohtml(UCase(str)),UCase("&nbsp;"),"")
    l = Len(str)
    t = 0
    strTemp = str
    strlen = FY_CLng(strlen)
    If strlen<>0 Then
    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 l>strlen And bShowPoint = True Then
        strTemp = strTemp & "..."
    End If
    Else
    strTemp=str
    End if
    GetSubStr = strTemp
End Function

'==================================================
'函数名：ScriptHtml
'作  用：过滤html标记
'参  数：iConStr  ------ 要过滤的字符串
'参  数：TagName ------ 字符串种型
'参  数：FType   ------ 过滤的类型
'==================================================
Function ScriptHtml(ByVal iConStr, TagName, FType)
    Dim ConStr
    ConStr = iConStr
    Select Case FType
    Case 1
        regEx.Pattern = "<" & TagName & "([^>])*>"
        ConStr = regEx.Replace(ConStr, "")
    Case 2
        regEx.Pattern = "<" & TagName & "([^>])*>[\s\S]*?</" & TagName & "([^>])*>"
        ConStr = regEx.Replace(ConStr, "")
    Case 3
        regEx.Pattern = "<" & TagName & "([^>])*>"
        ConStr = regEx.Replace(ConStr, "")
        regEx.Pattern = "</" & TagName & "([^>])*>"
        ConStr = regEx.Replace(ConStr, "")
    End Select
    ScriptHtml = ConStr
End Function

'**************************************************
'函数名：IsValidEmail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'        False ----Email地址不合法
'**************************************************
Function IsValidEmail(Email)
    regEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
    IsValidEmail = regEx.Test(Email)
End Function

'**************************************************
'函数名：IsValidStr
'作  用：检查字符是否在有效范围内
'参  数：str ----要检查的字符
'返回值：True  ----字符合法
'        False ----字符不合法
'**************************************************
Function IsValidStr(ByVal str)
    Dim i, c
    For i = 1 To Len(str)
        c = LCase(Mid(str, i, 1))
        If InStr("abcdefghijklmnopqrstuvwxyz1234567890", c) <= 0 Then
            IsValidStr = False
            Exit Function
        End If
    Next
    If IsNumeric(Left(str, 1)) Then
        IsValidStr = False
    Else
        IsValidStr = True
    End If
End Function

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},Http://,/,\,;,:," & 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

'**************************************************
'函数名：IsValidStr
'作  用：检查字符是否在有效范围内
'参  数：str ----要检查的字符
'返回值：True  ----字符合法
'        False ----字符不合法
'**************************************************
Function IsValidStr(ByVal str)
    Dim i, c
    For i = 1 To Len(str)
        c = LCase(Mid(str, i, 1))
        If InStr("abcdefghijklmnopqrstuvwxyz1234567890", c) <= 0 Then
            IsValidStr = False
            Exit Function
        End If
    Next
    If IsNumeric(Left(str, 1)) Then
        IsValidStr = False
    Else
        IsValidStr = True
    End If
End Function

'**************************************************
'函数名：GetRndNum
'作  用：产生制定位数的随机数
'参  数：iLength ---- 随即数的位数
'返回值：随机数
'**************************************************
Function GetRndNum(iLength)
    Dim i, str1
    For i = 1 To (iLength \ 5 + 1)
        Randomize
        str1 = str1 & CStr(CLng(Rnd * 90000) + 10000)
    Next
    GetRndNum = Left(str1, iLength)
End Function

'**************************************************
'函数名：FY_Replace
'作  用：容错替换
'参  数：expression ---- 主数据
'        find ---- 被替换的字符
'        replacewith ---- 替换后的字符
'返回值：容错后的替换字符串,如果 replacewith 空字符,被替换的字符 替换成空
'**************************************************
Function FY_Replace(ByVal expression, ByVal find, ByVal replacewith)
    If IsNull(expression) Or IsNull(find) Then
        FY_Replace = expression
    ElseIf IsNull(replacewith) Then
        FY_Replace = Replace(expression, find, "")
    Else
        FY_Replace = Replace(expression, find, replacewith)
    End If
End Function

'**************************************************
'函数名：FY_CLng
'作  用：将字符转为整型数值
'参  数：str1 ---- 字符
'返回值：如果传入的参数不是数值，返回0，其他情况返回对应的数值
'**************************************************
Function FY_CLng(ByVal str1)
    If IsNumeric(str1) Then
        FY_CLng = Fix(CDbl(str1))
    Else
        FY_CLng = 0
    End If
End Function

Sub PageControl(iCount,pagecount,page,table_style,font_style)
'生成上一页下一页链接
Dim query, a, x, temp,b
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("<table " & Table_style & ">" & vbCrLf )
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+ this.page.value;return false;""><TR>" & vbCrLf )
Response.Write("<TD align=right>" & vbCrLf )
Response.Write(font_style & vbCrLf )
If page<=1 then
Response.Write ("首页 " & vbCrLf)
Response.Write ("上一页 " & vbCrLf)
Else
Response.Write("<A HREF=" & action & "?" & temp & "Page=1>首页</A> " & vbCrLf)
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A> " & vbCrLf)
End If
If page>=pagecount then
Response.Write ("下一页 " & vbCrLf)
Response.Write ("尾页 " & vbCrLf)
Else
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A> " & vbCrLf)
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">尾页</A> " & vbCrLf)
End If
Response.Write(" 页次：" & page & "/" & pageCount & "页" &  vbCrLf)
Response.Write(" 共有" & iCount & "个记录" &  vbCrLf)
Response.Write("转到<select name=""select"" class=wenbenkuang onChange=""if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}"">")
for b=1 to pageCount
Response.Write("<option value="&action&"?"&temp&"Page="&b&"")
if b=page then
Response.Write(" selected")
end if
Response.Write(">第"&b&"页</option>" & vbCrLf )
If b>pageCount then exit for
next
Response.Write("</select></TR>" & vbCrLf )
Response.Write("</table>" & vbCrLf )
End Sub
'前台的
'生成上一页下一页链接
'FY_Class_Url(频道ID,当前页码)
Public Function List_PageControl(iCount,pagecount,page,table_style,font_style,FY_List_BM_C)
List_PageControl="<table " & Table_style & ">" & vbCrLf
List_PageControl=List_PageControl&"<TR>" & vbCrLf
List_PageControl=List_PageControl&"<TD align=right>" & vbCrLf
List_PageControl=List_PageControl&""&font_style & vbCrLf 
If page<=1 then
List_PageControl=List_PageControl&"首页 " & vbCrLf
List_PageControl=List_PageControl&"上一页 " & vbCrLf
Else
List_PageControl=List_PageControl&"<A HREF=" & FY_Class_Url(FY_List_BM_C,1)& ">首页</A> " & vbCrLf
List_PageControl=List_PageControl&"<A HREF=" & FY_Class_Url(FY_List_BM_C,Page-1) & ">上一页</A> " & vbCrLf
End If
If page>=pagecount then
List_PageControl=List_PageControl&"下一页 " & vbCrLf
List_PageControl=List_PageControl&"尾页 " & vbCrLf
Else
List_PageControl=List_PageControl&"<A HREF=" & FY_Class_Url(FY_List_BM_C,Page+1) & ">下一页</A> " & vbCrLf
List_PageControl=List_PageControl&"<A HREF=" & FY_Class_Url(FY_List_BM_C,pagecount) & ">尾页</A> " & vbCrLf
End If
List_PageControl=List_PageControl&" 页次：" & page & "/" & pageCount & "页" & vbCrLf
List_PageControl=List_PageControl&" 共有" & iCount & "篇小说 " & vbCrLf
List_PageControl=List_PageControl&" 转到<select name=""select"" class=wenbenkuang onChange=""if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}""> " & vbCrLf
Dim b
for b=1 to pageCount
List_PageControl=List_PageControl&"<option value="&FY_Class_Url(FY_List_BM_C,b)&""
if b=page then
List_PageControl=List_PageControl&" selected"
end if
List_PageControl=List_PageControl&">第"&b&"页</option>" & vbCrLf
If b>pageCount then exit for
next
List_PageControl=List_PageControl&"</select></TR>" & vbCrLf
List_PageControl=List_PageControl&"</table>" & vbCrLf
End Function

'**************************************************
'函数名：Jencode
'作  用：替换日文，片假名
'参  数：iStr----内容
'返回值：替换后的内容
'**************************************************
Function Jencode(byVal iStr)
dim Jencode_F,Jencode_i
  Jencode_F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_
    chr(-23118),chr(-23114),chr(-23112),chr(-23110),_
    chr(-23099),chr(-23097),chr(-23095),chr(-23075),_
    chr(-23079),chr(-23081),chr(-23085),chr(-23087),_
    chr(-23052),chr(-23076),chr(-23078),chr(-23082),_
    chr(-23084),chr(-23088),chr(-23102),chr(-23104),_
    chr(-23106),chr(-23108))
  for Jencode_i=0 to 25
   iStr=FY_Replace(iStr,Jencode_F(Jencode_i),"")
  next
  Jencode=iStr
End Function
%>