function.asp

此文件为一个电子同学录

<%
'---------------------检查用户名密码-------------------------------
function Checkin(s) 
s=trim(s) 
s=replace(s," ","&amp;nbsp;") 
s=replace(s,"'","&amp;#39;") 
s=replace(s,"""","&amp;quot;") 
s=replace(s,"&lt;","&amp;lt;") 
s=replace(s,"&gt;","&amp;gt;") 
Checkin=s 
end function 
'--------------------------------------------
Rem 过滤SQL非法字符
function checkStr(str)
	if isnull(str) then
		checkStr = ""
		exit function 
	end if
	checkStr=replace(str,"'","''")
end function

'-------------------------------------

Rem 过滤HTML代码
function HTMLEncode(fString)
if not isnull(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> ")

    HTMLEncode = fString
end if
end function

'--------------------------------------
Rem 过滤表单字符
function HTMLcode(fString)
if not isnull(fString) then
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
    fString = Replace(fString, CHR(10), "<BR>")
    HTMLcode = fString
end if
end function

'---------------------检查真实姓名----------------------------
   function isChinese(para)
       on error resume next
       dim str
       dim i
       if isNUll(para) then 
          isChinese=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isChinese=false
          exit function
       end if
       for i=1 to len(str)
		   c=asc(mid(str,i,1))
             if c>=0 then 
			 isChinese=false 
              exit function
           end if
       next
       isChinese=true
       if err.number<>0 then err.clear
   end function

'---------------------检查用户Email-------------------------------
function IsValidEmail(email)
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 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if

end function



'---------------------用户星级-------------------------------
function  star(money)
    if money>10000 then
	star="<img src=digits/level7.gif>"
    elseif money>8000 then
        star="<img src=digits/level6.gif>"
    elseif money>5000 then
	star="<img src=digits/level5.gif>"
    elseif money>1000 then
 	star="<img src=digits/level4.gif>"
    elseif money>500 then
	star="<img src=digits/level3.gif>"
    elseif money>200 then
	star="<img src=digits/level2.gif>"
    else
        star="<img src=digits/level1.gif>"
    end if
end function

'---------------------用户资料-------------------------------
function  week(time)
          week = weekday(time,vbMonday)
    select case week
            case 1
              week = "星期一"
            case 2
              week = "星期二"
            case 3
              week = "星期三"
            case 4
              week = "星期四"
            case 5
              week = "星期五"
            case 6
              week = "星期六"
            case 7
              week = "星期日"
           end select
end function
	

'---------------------生日-------------------------------
function astro(bmonth,bday)
	select case bmonth
	case 1
		if bday>=21 then
			astro="水瓶座"
		else
			astro="魔羯座"
		end if
	case 2
		if bday>=20 then
			astro="双鱼座"
		else
			astro="水瓶座"
		end if
	case 3
		if bday>=21 then
			astro="白羊座"
		else
			astro="双鱼座"
		end if
	case 4
		if bday>=21 then
			astro="金牛座"
		else
			astro="白羊座"
		end if
	case 5
		if bday>=22 then
			astro="双子座"
		else
			astro="金牛座"
		end if
	case 6
		if bday>=22 then
			astro="巨蟹座"
		else
			astro="双子座"
		end if
	case 7
		if bday>=23 then
			astro="狮子座"
		else
			astro="巨蟹座"
		end if
	case 8
		if bday>=24 then
			astro="处女座"
		else
			astro="狮子座"
		end if
	case 9
		if bday>=24 then
			astro="天秤座"
		else
			astro="处女座"
		end if
	case 10
		if bday>=24 then
			astro="天蝎座"
		else
			astro="天秤座"
		end if
	case 11
		if bday>=23 then
			astro="射手座"
		else
			astro="天蝎座"
		end if
	case 12
		if bday>=22 then
			astro="魔羯座"
		else
			astro="射手座"
		end if
	case else
		astro=""
	end select
end function

'----------------------------用户来源---------------------------------
function ipsource(sip)
    if isnumeric(left(sip,2)) then
	set iprs=server.createobject("adodb.recordset")
    if sip="127.0.0.1" then sip="192.168.0.1"
	str1=left(sip,instr(sip,".")-1)
		sip=mid(sip,instr(sip,".")+1)
	str2=left(sip,instr(sip,".")-1)
		sip=mid(sip,instr(sip,".")+1)
	str3=left(sip,instr(sip,".")-1)
	str4=mid(sip,instr(sip,".")+1)
    if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then

    else
    	num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
	ipsql="select Top 1 country,city from address where ip1 <="&num&" and ip2 >="&num&""
	iprs.open ipsql,conn,1,1
	     if iprs.eof and iprs.bof then 
		country="亚洲"
		city=""
	     else
		country=iprs("country")
		city=iprs("city")
	     end if
	iprs.close
	set iprs=nothing
     end if
	ipsource=country&city
     else
	ipsource="未知"
     end if
end function

'---------------------错误输出-------------------------------
sub error(errmsg)

    response.write"<LINK href=style.css type=text/css rel=stylesheet>"
    response.write"<body background=images/bg1.gif><br><br><table cellpadding=0 cellspacing=1 border=0 width=610  bgcolor=#ce0000>"
    response.write"<tr><th height=25>错 误 信 息</th></tr>"
    response.write"<tr><td bgcolor=#ffffff height=30><b>产生错误的可能原因:</b><br>"&errmsg&"</td></tr>"
    response.write"<tr align=center><td  height=30 bgcolor=#efefef><input type=button onclick=""javascript:history.back()"" value=""返 回"">