function.asp

网站整站

set rs1=nothing
rs.movenext
loop
else
YC("<center>数据读取中...</center>")
end if
rs.close
set rs=nothing
end Function
function bigclass(bigclassname,url)
bigsql="select id,classname from ["&bigclassname&"] where class=0"
set rsbig=conn.execute(bigsql)
if not rsbig.bof and not rsbig.eof then
do while not rsbig.eof
YC("<p class=""right_title"">")
YC("<script type=""text/javascript"">yecaotitle(""right"",""<a href='"&url&".asp?action=small&id="&rsbig("id")&"'>"&rsbig("classname")&"</a>&nbsp;(")
select case bigclassname
     case "YC_newsclass"
call classdata(1,"YC_news",rsbig("id"))
     case "YC_artclass"
call classdata(1,"YC_art",rsbig("id"))
     case "YC_downclass"
call classdata(1,"YC_down",rsbig("id"))
     case "YC_picclass"
call classdata(1,"YC_pic",rsbig("id"))
     case "YC_djclass"
call classdata(1,"YC_dj",rsbig("id"))	   
end select
YC(")"","""&url&".asp?action=small&id="&rsbig("id")&""");</script></p>")
YC("<div class=""right_content"">")
select case bigclassname
       case "YC_newsclass"
call newsclass(rsbig("id"),1)

       case "YC_artclass"
call artclass(rsbig("id"),1)

       case "YC_downclass"
call downclass(rsbig("id"),1)

       case "YC_picclass"
call picclass(rsbig("id"),1)

       case "YC_djclass"
call djclass(rsbig("id"),1)		   
end select
YC("</div>")
rsbig.movenext
loop
else
YC("<p><br /><br /><center>目前没有任何分类！</center><br /><br /></p>")
end if
rsbig.close
set rsbig=nothing
end function
function smallclass(smallclassname,url,smallclassid)
smallsql="select id,classname from ["&smallclassname&"] where class="&smallclassid&""
set rssmall=conn.execute(smallsql)
if not rssmall.bof and not rssmall.eof then
do while not rssmall.eof
YC("<p class=""right_title"">")
YC("<script type=""text/javascript"">yecaotitle(""right"",""<a href='"&url&".asp?action=list&class="&rssmall("id")&"'>"&rssmall("classname")&"</a>&nbsp;(")
select case smallclassname
     case "YC_newsclass"
call classdata(2,"YC_news",rssmall("id"))
     case "YC_artclass"
call classdata(2,"YC_art",rssmall("id"))
     case "YC_downclass"
call classdata(2,"YC_down",rssmall("id"))
     case "YC_picclass"
call classdata(2,"YC_pic",rssmall("id"))
     case "YC_djclass"
call classdata(2,"YC_dj",rssmall("id"))	   
end select
YC(")"","""&url&".asp?action=list&class="&rssmall("id")&""");</script></p>")
YC("<div class=""right_content"">")
select case smallclassname
     case "YC_newsclass"
call newsclass(rssmall("id"),2)
     case "YC_artclass"
call artclass(rssmall("id"),2)
     case "YC_downclass"
call downclass(rssmall("id"),2)
     case "YC_picclass"
call picclass(rssmall("id"),2)
     case "YC_djclass"
call djclass(rssmall("id"),2)	   
end select
YC("</div>")
rssmall.movenext
loop
else
YC("<p><br /><br /><center>目前没有任何分类！</center><br /><br /></p>")
end if
rssmall.close
set rssmall=nothing
end function
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
function JoinChar(strUrl)
	if strUrl="" then
	JoinChar=""
	exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
	if InStr(strUrl,"?")>1 then
	if InStr(strUrl,"&")<len(strUrl) then 
	JoinChar=strUrl & "&"
	else
	JoinChar=strUrl
	end if
	else
	JoinChar=strUrl & "?"
	end if
	else
	JoinChar=strUrl
	end if
end function
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
Function JPE(byval JP)
If JP="" Then Exit Function
JP=Replace(JP,"ガ","&#12460;")
JP=Replace(JP,"ギ","&#12462;")
JP=Replace(JP,"ア","&#12450;")
JP=Replace(JP,"ゲ","&#12466;")
JP=Replace(JP,"ゴ","&#12468;")
JP=Replace(JP,"ザ","&#12470;")
JP=Replace(JP,"ジ","&#12472;")
JP=Replace(JP,"ズ","&#12474;")
JP=Replace(JP,"ゼ","&#12476;")
JP=Replace(JP,"ゾ","&#12478;")
JP=Replace(JP,"ダ","&#12480;")
JP=Replace(JP,"ヂ","&#12482;")
JP=Replace(JP,"ヅ","&#12485;")
JP=Replace(JP,"デ","&#12487;")
JP=Replace(JP,"ド","&#12489;")
JP=Replace(JP,"バ","&#12496;")
JP=Replace(JP,"パ","&#12497;")
JP=Replace(JP,"ビ","&#12499;")
JP=Replace(JP,"ピ","&#12500;")
JP=Replace(JP,"ブ","&#12502;")
JP=Replace(JP,"ブ","&#12502;")
JP=Replace(JP,"プ","&#12503;")
JP=Replace(JP,"ベ","&#12505;")
JP=Replace(JP,"ペ","&#12506;")
JP=Replace(JP,"ボ","&#12508;")
JP=Replace(JP,"ポ","&#12509;")
JP=Replace(JP,"ヴ","&#12532;")
JPE=JP
End Function
function isInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
       isInteger=false
       exit function
       end if
       str=cstr(para)
       if trim(str)="" then
       isInteger=false
       exit function
       end if
       l=len(str)
       for i=1 to l
       if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
       isInteger=false 
       exit function
       end if
       next
       isInteger=true
       if err.number<>0 then err.clear
end function
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 then
	IsValidEmail = false
	exit function
	end if
	if InStr(email, "..") > 0 then
	IsValidEmail = false
	end if
end function

sub NowWhere(placename,placelink)
dim yecaouser
if username="" then 
yecaouser="游客"
else
yecaouser=username
end if
statuserid=replace(Request.ServerVariables("REMOTE_HOST"),".","")	
Response.Cookies("YCMSonline")("onlineid")=statuserid
sql="select id from [YC_online] where id="&cstr(request.cookies("YCMSonline")("onlineid"))
set rs=conn.execute(sql)
if rs.eof and rs.bof then
sql="insert into YC_online(id,UserName,ip,browser,startime,lastime,placename,placelink) values ("&statuserid&",'"&yecaouser&"','"&Request.ServerVariables("REMOTE_HOST")&"','"&Request.ServerVariables("HTTP_USER_AGENT")&"',now(),now(),'"&placename&"','"&placelink&"')"
else
sql="update [YC_online] set lastime=now(),UserName='"&yecaouser&"',placename='"&placename&"',placelink='"&placelink&"',browser='"&Request.ServerVariables("HTTP_USER_AGENT")&"' where id="&cstr(request.cookies("YCMSonline")("onlineid"))
end if
conn.execute(sql)
set rs=nothing
sql="Delete FROM YC_online WHERE DATEDIFF('s', lastime, now())>"&kicktime&"*60"
Conn.Execute(sql)
end sub
sub YCMSonline()

sql="select * from [YC_tongji]"
set tongji=server.createobject("adodb.recordset")
tongji.open sql,conn,1,3

if request.cookies(yecaocookies&"tongji")=fail then
lastip=tongji("lastip")
newip=request.servervariables("remote_addr")

if cstr(month(tongji("date")))<>cstr(month(date())) then
tongji("date")=date()
tongji("yesterday")=tongji("today")
tongji("bmonth")=tongji("month")
tongji("month")=1
tongji("today")=1
tongji.update
else

if cstr(day(tongji("date")))<>cstr(day(date())) then
tongji("date")=date()
tongji("yesterday")=tongji("today")
tongji("today")=1
tongji.update
end if
response.cookies(yecaocookies&"tongji")=true
end if

tongji("lastip")=newip
tongji("total")=tongji("total")+1
tongji("today")=tongji("today")+1
tongji("month")=tongji("month")+1
tongji.update
end if
YC("总量："&tongji("total")&"人</a>&nbsp;")
YC("昨日："&tongji("yesterday")&"人</a>&nbsp;")
YC("今日："&tongji("today")&"人</a>&nbsp;")
tongji.close
set tongji=nothing
YC("<a href=""showonline.asp"">在线：")
sql="Select * from [YC_online]"
set online=server.createobject("adodb.recordset")
online.open sql,conn,1,1
YC(online.recordcount)
dim toponline
if online.recordcount>conn.execute("select toponline from [YC_tongji]")(0) then
conn.execute("update [YC_tongji] set toponline='"&online.recordcount&"'")
end if
YC("人</a>")
online.close
set online=nothing
end sub
function checklogined()
dim logined,rslogin,sqllogin
logined=true
if username="" then
logined=false
elseif userpass="" then
logined=false
elseif useradmin="" then
logined=false
end if
if logined=true then
sql="select id,user_name,user_pass,user_admin from [YC_user] where pass=1 and id="&userid&""
set rs=conn.execute(sql)
if rs.eof and rs.bof then
logined=false 
else
if username<>rs("user_name") then
logined=false
elseif userpass<>rs("user_pass") then
logined=false
elseif useradmin<>rs("user_admin") then
logined=false
else
logined=true
end if
end if
end if
if logined=false then
Response.Cookies(yecaocookies)("userid")=""
Response.Cookies(yecaocookies)("username")=""
Response.Cookies(yecaocookies)("userpass")=""
Response.Cookies(yecaocookies)("useradmin")=""
end if
checklogined=logined
end function
Function CodeCookie(str)
Dim i
Dim StrRtn
For i = Len(Str) to 1 Step -1
StrRtn = StrRtn & Ascw(Mid(Str,i,1))
If (i <> 1) Then StrRtn = StrRtn & "a"
Next
CodeCookie=StrRtn
End Function
	
Function DecodeCookie(Str)
Dim i
Dim StrArr,StrRtn
StrArr = Split(Str,"a")
For i = 0 to UBound(StrArr)
If isNumeric(StrArr(i)) = True Then
StrRtn = Chrw(StrArr(i)) & StrRtn
Else
StrRtn = Str
Exit Function
End If
Next
DecodeCookie=StrRtn
End Function
function showtitle(tab,byid)
sql="select title from ["&tab&"] where id="&byid
set rs=conn.execute(sql)
showtitle=rs("title")
rs.close
set rs=nothing
end function
%>