📄 ycms.asp
字号:
<%
Function YCMS_japan(str)
If str="" Then Exit Function
str=Replace(str,"ガ","ガ")
str=Replace(str,"ギ","ギ")
str=Replace(str,"ア","ア")
str=Replace(str,"ゲ","ゲ")
str=Replace(str,"ゴ","ゴ")
str=Replace(str,"ザ","ザ")
str=Replace(str,"ジ","ジ")
str=Replace(str,"ズ","ズ")
str=Replace(str,"ゼ","ゼ")
str=Replace(str,"ゾ","ゾ")
str=Replace(str,"ダ","ダ")
str=Replace(str,"ヂ","ヂ")
str=Replace(str,"ヅ","ヅ")
str=Replace(str,"デ","デ")
str=Replace(str,"ド","ド")
str=Replace(str,"バ","バ")
str=Replace(str,"パ","パ")
str=Replace(str,"ビ","ビ")
str=Replace(str,"ピ","ピ")
str=Replace(str,"ブ","ブ")
str=Replace(str,"ブ","ブ")
str=Replace(str,"プ","プ")
str=Replace(str,"ベ","ベ")
str=Replace(str,"ペ","ペ")
str=Replace(str,"ボ","ボ")
str=Replace(str,"ポ","ポ")
str=Replace(str,"ヴ","ヴ")
YCMS_japan=str
End Function
Dim userid,username,useradmin,userpass,title
userid=DecodeCookie(Request.Cookies(site&"login")("userid"))
username=DecodeCookie(Request.Cookies(site&"login")("username"))
userpass=DecodeCookie(Request.Cookies(site&"login")("userpass"))
useradmin=DecodeCookie(Request.Cookies(site&"login")("useradmin"))
Function YCMS_print(str)
Response.write(str)
End Function
Function YCMS_url(url)
Response.redirect(url)
End Function
Function YCMS_sql(sql)
If IsNull(sql) Or sql="" Then
Exit Function
End If
YCMS_sql=conn.execute(sql)
End Function
Set LoadSet=Conn.Execute("Select webset From [YCMS_set]")
Dim webset(20)
For i=0 To 19
webset(i)=Split(LoadSet("webset"),"@@@")(i)
Next
Set LoadSet=Nothing
Function YCMS_DisplayIp(thisip)
dim MyIp:MyIp=split(trim(thisip),".")
YCMS_DisplayIp=MyIp(0)&"."&MyIp(1)&".*.*"
End Function
Function Load_Cache()
Dim webskin(29)
Set LoadSkin=Conn.Execute("Select * From [YCMS_skin] where id="&webset(5))
webskin(1)=LoadSkin("id")
webskin(2)=LoadSkin("skin_name")
webskin(3)=LoadSkin("skin_index")
webskin(4)=LoadSkin("skin_link")
webskin(5)=Split(LoadSkin("skin_inc"),"$$$$$")(0)
webskin(6)=Split(LoadSkin("skin_inc"),"$$$$$")(1)
webskin(7)=Split(LoadSkin("skin_news"),"$$$$$")(0)
webskin(8)=Split(LoadSkin("skin_news"),"$$$$$")(1)
webskin(9)=Split(LoadSkin("skin_art"),"$$$$$")(0)
webskin(10)=Split(LoadSkin("skin_art"),"$$$$$")(1)
webskin(11)=Split(LoadSkin("skin_pic"),"$$$$$")(0)
webskin(12)=Split(LoadSkin("skin_pic"),"$$$$$")(1)
webskin(13)=Split(LoadSkin("skin_dj"),"$$$$$")(0)
webskin(14)=Split(LoadSkin("skin_dj"),"$$$$$")(1)
webskin(15)=Split(LoadSkin("skin_down"),"$$$$$")(0)
webskin(16)=Split(LoadSkin("skin_down"),"$$$$$")(1)
webskin(17)=Split(LoadSkin("skin_book"),"$$$$$")(0)
webskin(18)=Split(LoadSkin("skin_book"),"$$$$$")(1)
webskin(19)=Split(LoadSkin("skin_book"),"$$$$$")(2)
webskin(20)=Split(LoadSkin("skin_other"),"$$$$$")(0)
webskin(21)=Split(LoadSkin("skin_other"),"$$$$$")(1)
webskin(22)=Split(LoadSkin("skin_other"),"$$$$$")(2)
webskin(23)=Split(LoadSkin("skin_other"),"$$$$$")(3)
webskin(24)=Split(LoadSkin("skin_user"),"$$$$$")(0)
webskin(25)=Split(LoadSkin("skin_user"),"$$$$$")(1)
webskin(26)=Split(LoadSkin("skin_user"),"$$$$$")(2)
webskin(27)=Split(LoadSkin("skin_user"),"$$$$$")(3)
webskin(28)=Split(LoadSkin("skin_user"),"$$$$$")(4)
Set LoadSkin=Nothing
Dim Cache_tmp(29)
Cache_tmp(0)=Date()
For i=1 to 28
Cache_tmp(i)=webskin(i)
Next
Application.Lock()
Application(site&"cache")=Cache_tmp
Application.UnLock()
End Function
If IsCache()=False Then
Call Load_Cache()
End If
Dim YCMS_skin(28)
Dim l
For l=1 To 28
YCMS_skin(l)=Application(site&"cache")(l)
Next
Function IsCache()
if IsArray(Application(site&"cache"))=False then
IsCache=False
Exit Function
end if
if Application(site&"cache")(0)=Date() Then
IsCache=True
Exit Function
else
IsCache=False
exit function
End if
End Function
Function YCMS_open()
If Request.servervariables("http_x_forwarded_for")<>"" then
YCMS_url("Error.asp?action=stop&text="&Server.UrlEncode(YCMS_Encode("对不起，本站禁止代理IP访问!")))
End If
'If DateDiff("s",Request.Cookies(site&"recome")("vitistime"),Now())<3 Then
'YCMS_Print("<meta http-equiv='refresh' content='3;URL="&Request.ServerVariables("Http_REFERER")&"'>")
'YCMS_Print("本站已经启动防刷新机制,3秒后自动跳转到历史页...")
'Response.End
'End IF
'Response.Cookies(site&"recome")("vitistime")=Now()
If Split(webset(12),"|")(0)=1 then
YCMS_url("Error.asp?action=stop&text="&Server.UrlEncode(YCMS_Encode("网站暂时维护中。。。")))
response.End()
End If
Dim request_ip,re_ip
request_ip=request.servervariables("remote_addr")
re_ip=split(webset(17),"|")
If webset(17)<>"" Then
for i=0 to ubound(re_ip)
If right(re_ip(i),1)="*" then
If left(re_ip(i),6)=left(request_ip,6) then
YCMS_url("Error.asp?action=stop&text="&Server.UrlEncode(YCMS_Encode("对不起，您所在的IP网段已经全部封锁！")))
response.End()
End If
elseIf re_ip(i)=request_ip then
YCMS_url("Error.asp?action=stop&text="&Server.UrlEncode(YCMS_Encode("对不起，您的IP已封锁!")))
response.End()
End If
Next
End If
Dim Sql_In,Sql_Data
Sql_In=split("'| |and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare","|")
If Request.QueryString<>"" then
for each Sql_Get in Request.QueryString
for Sql_Data=0 to ubound(Sql_In)
If instr(LCase(Request.QueryString(Sql_Get)),Sql_In(Sql_Data))>0 then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("对不起！请不要在参数中包含非法字符尝试注入！")))
Response.End()
End If
next
next
End If
End Function
Function e(O)
Dim I,II,III
For I=chr(49) To Len(O)
If Mid(O,I,chr(49))<>Chr(8) Then
II=Asc(Mid(O,I,chr(49)))-chr(53)
If II>126 Then
II=II-CInt(chr(57)&chr(55))
Elseif II<32 Then
II=II+CInt(chr(57)&chr(55))
End If
III=III&Chr(II)
Else
III=III&Vbcrlf
End If
Next
e=III
End Function
Function YCMS_post(postname,poststr,postclass,bigpostlenth,smallpostlenth)
dim post_sql
if poststr="" then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 的参数不能为空！")))
Response.End()
end if
If bigpostlenth<>0 then
If YCMS_StrLen(poststr)>bigpostlenth then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 的参数位数不能大于"&bigpostlenth&"位！")))
Response.End()
End If
End If
If smallpostlenth<>0 then
If YCMS_StrLen(poststr)<smallpostlenth then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 的参数位数不能小于"&smallpostlenth&"位！")))
Response.End()
End If
End If
If postclass=0 then
poststr=trim(replace(poststr,"'",""))
If lcase(poststr)="<p> </p>" or lcase(poststr)="<p></p>" or lcase(poststr)="<br>" then
poststr=""
End If
post_sql=split(";|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare|'","|")
for i=0 to ubound(post_sql)
If instr(LCase(poststr),post_sql(i))<>0 then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 中含有非法字符！")))
Response.End()
End If
next
elseIf postclass<>0 then
If poststr="" then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 不能为空！")))
Response.End()
elseIf not isnumeric(poststr) then
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("["&postname&"] 不是数字型！")))
Response.End()
End If
else
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("调用过程出错！请检查参数！")))
Response.End()
End If
YCMS_post=YCMS_japan(poststr)
End Function
Function YCMS_Encode(str)
dim tmp
tmp=replace(str,"<","<")
tmp=replace(tmp,">",">")
tmp=replace(tmp,"'","")
tmp=replace(tmp,"char(34)","")
YCMS_Encode=tmp
End Function
Function YCMS_badwords(str)
Dim tmp,i
tmp=Split(webset(15),"|")
For i=0 to ubound(tmp)
If Trim(tmp(i))<>"" Then
str=replace(str,tmp(i),"<font color='red'>***</font>")
End if
Next
YCMS_badwords=str
End Function
Function YCMS_code()
If CStr(Trim(Session("code")))<>CStr(Trim(Request.form("code"))) then
Session("code")=""
YCMS_url("Error.asp?action=back&text="&Server.UrlEncode(YCMS_Encode("对不起！请正确填写验证码！")))
Response.End()
End If
End Function
Function YCMS_time(o,oo)
Dim yy,mm,dd,hh,mmm,mmmm
yy=Right(Year(o),2)
If Len(month(o))=1 Then:mm="0"&month(o):Else:mm=month(o):End If
If Len(day(o))=1 Then:dd="0"&day(o):Else:dd=day(o):End If
If Len(hour(o))=1 Then:hh="0"&hour(o):Else:hh=hour(o):End If
If Len(minute(o))=1 Then:mmm="0"&minute(o):Else:mmm=minute(o):End If
select case oo
case 1
YCMS_time=yy&"年"&mm&"月"&dd&"日"
case 2
YCMS_time=yy&"年"&mm&"月"&dd&"日"&hh&"时"
case 3
YCMS_time=yy&"年"&mm&"月"&dd&"日"&hh&"时"&mmm&"分"
case 4
YCMS_time=yy&"年"&mm&"月"&dd&"日"&hh&"时"&mmm&"分"&second(o)&"秒"
case 5
YCMS_time=hh&"时"&mmm&"分"&second(o)&"秒"
case 6
YCMS_time=mm&"-"&dd
case 7
YCMS_time=yy&"-"&mm&"-"&dd&"-"
case Else
YCMS_time=yy&"/"&mm&"/"&dd&""
End select
End Function
Function YCMS_cut(Str,StrLen)
Dim l,t,c,i
l=Len(str)
t=0
For i=1 To l
c=AscW(Mid(str,i,1))
If c<0 Or c>255 Then t=t+2 Else t=t+1
IF t>=StrLen Then
YCMS_cut=left(Str,i)&"..."
Exit For
Else
YCMS_cut=Str
End If
Next
End Function
Function YCMS_StrLen(Str)
Dim l,t,c,i
l=Len(str)
t=0
For i=1 To l
c=AscW(Mid(str,i,1))
If c<0 Or c>255 Then
t=t+2
Else
t=t+1
End if
Next
YCMS_StrLen=t
End Function
Function CodeCookie(str)
Dim i,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,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 YCMS_logined()
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 [YCMS_user] where ispass=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(site&"login")("userid")=""
Response.Cookies(site&"login")("username")=""
Response.Cookies(site&"login")("userpass")=""
Response.Cookies(site&"login")("useradmin")=""
End If
YCMS_logined=logined
End Function
Function YCMS_where(placename,placelink)
Dim lastip,newip,tongji
set tongji=server.createobject("adodb.recordset")
tongji.open "select * from [YCMS_tongji]",conn,1,3
If request.cookies(site&"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(site&"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
tongji.close
set tongji=Nothing
dim yecaouser,onlinesql
If username="" then
yecaouser="游客"
else
yecaouser=username
End If
statuserid=replace(Request.ServerVariables("REMOTE_HOST"),".","")
Response.Cookies(site&"online")("onlineid")=statuserid
set rs=conn.execute("select id from [YCMS_online] where id="&cstr(request.cookies(site&"online")("onlineid")))
If rs.eof and rs.bof then
onlinesql="insert into [YCMS_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
onlinesql="update [YCMS_online] set lastime=now(),UserName='"&yecaouser&"',placename='"&placename&"',placelink='"&placelink&"',browser='"&Request.ServerVariables("HTTP_USER_AGENT")&"' where id="&cstr(request.cookies(site&"online")("onlineid"))
End If
YCMS_sql(onlinesql)
'更新最高在线
if conn.execute("select count(*) from [YCMS_online]")(0)>conn.execute("select toponline from [YCMS_tongji]")(0) then
conn.execute("update [YCMS_tongji] set toponline="&CInt(conn.execute("select count(*) from [YCMS_online]")(0)))
end if
set rs=nothing
YCMS_sql("Delete FROM YCMS_online WHERE DATEDIfF('s', lastime, now())>"&webset(10)&"*60")
End Function
Function YCMS_TT(tab)
set rs=server.CreateObject("adodb.recordset")
rs.open tab,conn,1,1
YCMS_TT=rs.recordcount
rs.close:set rs=Nothing
End Function
Function ContentPage(Pageid,Pagecontent)
Dim tmp
If Instr(Pagecontent,"[page]")<=0 Then
tmp=Pagecontent
Else
Dim SplitContent,Page,LastPage
SplitContent=split(Pagecontent,"[page]")
Page=trim(Request.QueryString("NextPage"))
LastPage=Ubound(SplitContent)+1
If Page="" Then
Page=1
Else
Page=Cint(Trim(Page))
End If
If Page<1 Then
Page=1
ElseIf Page>LastPage Then
Page=LastPage
End If
tmp=SplitContent(Page-1)
tmp=tmp&"<p align='center'>"
If Page>1 then
tmp=tmp&"<a href='?id="&Pageid&"&NextPage="&Page-1&"'>上一页</a> "
End If
For i=1 to LastPage
If i=Page then
tmp=tmp&"<span style='color:#f00;font-weight:bold;'>["&cstr(i)&"]</span> "
Else
tmp=tmp&"<a href='?id="&Pageid&"&NextPage="&i&"'>["&i&"]</a> "
End If
Next
If Page<LastPage then
tmp=tmp&" <a href='?id="&Pageid&"&NextPage="&Page+1&"'>下一页</a>"
End If
tmp=tmp&"</p>"
End If
ContentPage=playimg(tmp)
End Function
Function playimg(pic)
Set re=new RegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="<img(.[^>]*)>"
playimg=re.replace(pic,"<img onclick='window.open(this.src);' onload='resizepic(this)' onmousewheel='return bbimg(this)' alt='点击在新窗口中打开图片' class='img' $1 />")
Set re=Nothing
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -