function.asp

sfsfds设定方式分上述事实是事实是事实是事实是事实上

<%
'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
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 PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = CLng(str1)
    Else
        PE_CLng = 0
    End If
End Function

Function PE_CDbl(ByVal str1)
    If IsNumeric(str1) Then
        PE_CDbl = CDbl(str1)
    Else
        PE_CDbl = 0
    End If
End Function
'**************************************************
'函数名：IsValidEmail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'       False ----Email地址不合法
'**************************************************
Function IsValidEmail(email)
    Dim names, name, i, c
    IsValidEmail = True
    names = Split(email, "@")
    If UBound(names) <> 1 Then
       IsValidEmail = False
       Exit Function
    End If
    For Each name In names
        If Len(name) <= 0 Then
        IsValidEmail = 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
           IsValidEmail = False
           Exit Function
         End If
       Next
       If Left(name, 1) = "." Or Right(name, 1) = "." Then
          IsValidEmail = False
          Exit Function
       End If
    Next
    If InStr(names(1), ".") <= 0 Then
        IsValidEmail = False
       Exit Function
    End If
    i = Len(names(1)) - InStrRev(names(1), ".")
    If i <> 2 And i <> 3 And i <> 4 Then
       IsValidEmail = False
       Exit Function
    End If
    If InStr(email, "..") > 0 Then
       IsValidEmail = False
    End If
End Function
'**************************************************
'函数名：listunder
'作  用：分类菜单
'**************************************************
dim rssss(5)
function listunder(i)
	set rssss(i)=server.createobject("adodb.recordset")
	rssss(i).open "select classid,classname,verity from O3888_class where topclass="&rssss(i-1)("classid"),conn,1,3
	while not rssss(i).eof
		dim topclassname
		topclassname=""
		for x=0 to i-1
			topclassname=topclassname&rssss(x)("classname")&"＞"
		next

		fujia=""
		if rssss(i)("classid")=classid then fujia=" selected"

		response.write "<option"&fujia&" value='"&rssss(i)("classid")&"'>"&topclassname&""&rssss(i)("classname")&"("&rssss(i)("classid")&")</option>"&vbCrLf

		if i<Ubound(rssss) then
			call listunder(i+1)
		end if
		rssss(i).movenext
	wend
end function
'**************************************************
'函数名：cut
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       en   ----截取长度
'返回值：截取后的字符串
'**************************************************
function cut(str,en)
if len(str)>en then
cut=left(str,en)&".."
else
cut=str
end if
end function
'**************************************************
Function manage(html)
sql="select * from O3888_map"
set rs=conn.execute(sql)
if html="left" then Response.Write ""&rs("admin_left")&""
if html="main" then Response.Write ""&rs("admin_main")&""
if html="top" then Response.Write ""&rs("admin_top")&""
rs.close
set rs=nothing
End Function
'**************************************************
'函数名：iHTMLEncode
'作  用：用于发布信息的过滤
'参  数：fstring   ----原字符串
'返回值：过滤后的字符串
'**************************************************
	Public Function iHTMLEncode(fString)
		If Not IsNull(fString) Then
			fString = replace(fString, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")
			fString = Replace(fString, CHR(9), " ")
			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> ")
			iHTMLEncode = fString
		End If
	End Function
'**************************************************
Function reg(db)
sql="select * from O3888_title"
set rs=conn.execute(sql)
reg=rs("reg")
rs.close
set rs=nothing
if "079fa326b6494f81"=md5(Request.ServerVariables("server_name")) or reg=md5(Request.ServerVariables("server_name")) then
Response.Write ""
else
Response.End
end if
End Function
'**************************************************
'函数名：outcome
'作  用：用于提交结果页面
'参  数：outcomename   ----结果名称
'返回值：结果页面
'**************************************************
	function outcome(outcomename)
	Response.Write "<LINK REL='stylesheet' HREF='css.css' TYPE='text/css'>"
	Response.Write "<table width='55%' border='0' cellspacing='1' cellpadding='8' align='center' class='a'><p>　</p>"
	Response.Write "<tr><td align='center'><br><li>"&outcomename&"<br><br></td></tr>"
	Response.Write "<tr><td align='center'>[<A href='http://www.03888.com/' target=_blank>03888网址大全</A>]</td></tr>"
	Response.Write "</table>"
	End Function
'**************************************************
'函数名：strLength
'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Function strLength(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
        strLength = t
    Else
        strLength = Len(str)
    End If
    If Err.Number <> 0 Then Err.Clear
End Function
'**************************************************
'函数名：CheckAndCreateFolder
'作  用：检查某目录是否存在，不存在则创建目录
'**************************************************
Function CheckAndCreateFolder(FolderName) 
	fldr = Server.Mappath(FolderName) 
	Set fso = CreateObject("Scripting.FileSystemObject") 
	If Not fso.FolderExists(fldr) Then 
	fso.CreateFolder(fldr) 
	End If 
	Set fso = Nothing 
End Function
'**************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'       False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = Server.CreateObject(strClassString)
    If 0 = Err Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function

'**************************************************
%>