📄 function.asp
字号:
' AnnounceNum ----最多显示多少条公告
'==================================================
sub ShowAnnounce(ShowType,AnnounceNum)
dim sqlAnnounce,rsAnnounce,i
if AnnounceNum>0 and AnnounceNum<=10 then
sqlAnnounce="select top " & AnnounceNum
else
sqlAnnounce="select top 10"
end if
sqlAnnounce=sqlAnnounce & " * from Announce where IsSelected=True and (ChannelID=0 or ChannelID=" & ChannelID & ") and (ShowType=0 or ShowType=1) order by ID Desc"
Set rsAnnounce= nt2003.execute(sqlAnnounce)
if rsAnnounce.bof and rsAnnounce.eof then
AnnounceCount=0
response.write "<p>当前没有任何公告！</p>"
else
AnnounceCount=rsAnnounce.recordcount
if ShowType=1 then
do while not rsAnnounce.eof
response.Write " <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "'>" & rsAnnounce("title") & "</div><br><div align='right'>" & rsAnnounce("Author") & " <br>" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "</a>"
rsAnnounce.movenext
i=i+1
if i<AnnounceCount then response.write "<hr>"
loop
else
do while not rsAnnounce.eof
response.Write " <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "' >" & rsAnnounce("title") & " [" & rsAnnounce("Author") & " " & FormatDateTime(rsAnnounce("DateAndTime"),1) & "]</a> "
rsAnnounce.movenext
loop
end if
end if
rsAnnounce.close
set rsAnnounce=nothing
end sub
'==================================================
'过程名：ShowFriendSite
'作 用：显示友情链接站点
'参 数：LinkType ----链接方式，1为LOGO链接，2为文字链接
' SiteNum ----最多显示多少个站点
' Cols ----分几列显示
' ShowType ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框
'==================================================
Function ShowFriendSite(LinkType,SiteNum,Cols,ShowType)
dim sqlLink,rsLink,SiteCount,i,strLink
if LinkType<>1 and LinkType<>2 then
LinkType=1
else
LinkType=Cint(LinkType)
end if
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
if Cols<=0 or Cols>20 then
Cols=10
end if
if ShowType=1 then
strLink="<div id=rolllink style=overflow:hidden;height:100;width:130><div id=rolllink1>"
elseif ShowType=3 then
strLink="<select name='FriendSite' onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value=''>友情文字链接站点</option>"
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "<table width='100%' cellSpacing='5'><tr align='center' class='tdbg'>"
end if
sqlLink="select top " & SiteNum & " * from FriendSite where IsOK=True and LinkType=" & LinkType & " order by IsGood,id desc"
Set rsLink=Server.CreateObject("ADODB.Recordset")
rsLink.open sqlLink,conn,1,1
if rsLink.bof and rsLink.eof then
if ShowType=1 or ShowType=2 then
for i=1 to SiteNum
strLink=strLink & "<td><a href='FriendSiteReg.asp' target='_blank'>"
if LinkType=1 then
strLink=strLink & "<img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'>"
else
strLink=strLink & "点击申请"
end if
strLink=strLink & "</a></td>"
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
else
SiteCount=rsLink.recordcount
for i=1 to SiteCount
if ShowType=1 or ShowType=2 then
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & "<img src='images/nologo.gif' width='88' height='31' border='0'>"
else
strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
end if
strLink=strLink & "</a></td>"
else
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>" & rsLink("SiteName") & "</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
else
strLink=strLink & "<option value='" & rsLink("SiteUrl") & "'>" & rsLink("SiteName") & "</option>"
end if
rsLink.moveNext
next
if SiteCount<SiteNum and (ShowType=1 or ShowType=2) then
for i=SiteCount+1 to SiteNum
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td>"
else
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'>点击申请</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "</tr></table>"
end if
if ShowType=1 then
strLink=strLink & "</div><div id=rolllink2></div></div>"&vbnewline
elseif ShowType=3 then
strLink=strLink & "</select>"
end if
if ShowType=1 then
strLink=strLink & "<script>"&vbnewline
strLink=strLink & "var rollspeed=40"&vbnewline
strLink=strLink & "rolllink2.innerHTML=rolllink1.innerHTML"&vbnewline
strLink=strLink & "function Marquee(){"&vbnewline
strLink=strLink & "if(rolllink2.offsetTop-rolllink.scrollTop<=0)"&vbnewline
strLink=strLink & "rolllink.scrollTop-=rolllink1.offsetHeight"&vbnewline
strLink=strLink & "else{"&vbnewline
strLink=strLink & "rolllink.scrollTop++"&vbnewline
strLink=strLink & "}"&vbnewline
strLink=strLink & "}"&vbnewline
strLink=strLink & "var MyMar=setInterval(Marquee,rollspeed)"&vbnewline
strLink=strLink & "rolllink.onmouseover=function() {clearInterval(MyMar)}"&vbnewline
strLink=strLink & "rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}"&vbnewline
strLink=strLink & "</script>"&vbnewline
end if
rsLink.close
set rsLink=nothing
ShowFriendSite=strLink
end Function
sub ShowGoodSite(SiteNum)
dim sqlLink,rsLink,SiteCount,i,strLink
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
strLink=strLink & "<table width='100%' cellSpacing='5'>"
sqlLink="select top " & SiteNum & " * from FriendSite where IsOK=True and LinkType=1 and IsGood=True order by id desc"
set rsLink = nt2003.execute(sqlLink)
if rsLink.bof and rsLink.eof then
for i=1 to SiteNum
strLink=strLink & "<tr align='center'><td><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td></tr>"
next
else
SiteCount=rsLink.recordcount
for i=1 to SiteCount
strLink=strLink & "<tr align='center'><td><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & "<img src='images/nologo.gif' width='88' height='31' border='0'>"
else
strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
end if
strLink=strLink & "</a></td></tr>"
rsLink.moveNext
next
for i=SiteCount+1 to SiteNum
strLink=strLink & "<tr align='center'><td><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td></tr>"
next
end if
strLink=strLink & "</table>"
response.write strLink
rsLink.close
set rsLink=nothing
end sub
'==================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'==================================================
Function ShowUserLogin()
dim strLogin
if CheckUserLogined()=False or session("AdminName")<>"" then
if session("AdminName")="" then
strLogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
If UserTableType="MyPower" then
strLogin=strLogin & "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
Else
strLogin = strLogin & "<form action='"& forum_dir &"/Login2.asp?action=chk' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbCrLf
End if
strLogin=strLogin & "<tr><td height='25' align='right'>用户名称：</td><td height='25'><input name='UserName' type='text' id='UserName' size='10' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>登陆密码：</td><td height='25'><input name='Password' type='password' id='Password' size='10' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>附加验证：</td><td height='25'><input name='CheckCode' size='4' maxlength='4'> <img src='inc/checkcode.asp'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>Cookie：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbcrlf
strLogin=strLogin & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td></tr>" & vbcrlf
strLogin=strLogin & "<tr align='center'><td height='50' colspan='2'><input name='Login' type='submit' id='Login' value='登 陆'> <input name='Reset' type='reset' id='Reset' value='清 除'><br>" & vbcrlf
else
strLogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'><tr align='center'><td height='30' colspan='2'>" & vbcrlf
strLogin=strLogin & "<script language='javascript' src='Skin/51dsn03/time.js'></script>，<font color=#ff6600><b>" & session("AdminName") & vbcrlf
strLogin=strLogin & "</b></font><br>" & vbcrlf
strLogin=strLogin & "您的身份：网站管理员<br><br>" & vbcrlf
strLogin=strLogin & "[<b>管理控制面板</b>]<br>" & vbcrlf end if
if session("AdminName")="" then
strLogin=strLogin & "<a href='User_Reg.asp'>用户注册</a> " & vbcrlf
strLogin=strLogin & "<a href='User_GetPassword.asp'>忘记密码</a>" & vbcrlf
strLogin=strLogin & "</td></tr></form></table>" & vbcrlf
else '--snowice modify 管理员身份登陆以高级模式添加文章
strLogin=strLogin & "<a href='Admin_ArticleAdd2.asp' target='_blank'>添加文章</a>" & vbcrlf
strLogin=strLogin & " <a href='Admin_PhotoAdd.asp' target='_blank'>添加图片</a><br>" & vbcrlf
strLogin=strLogin & "<a href='Admin_SoftAdd.asp' target='_blank'>添加软件</a>" & vbcrlf
strLogin=strLogin & " <a href='Admin_AdminModifyPwd.asp' target='_blank'>修改密码</a><br>" & vbcrlf
strLogin=strLogin & "<a href=""JavaScript:openScript('Admin_Index.asp')"">进入后台</a>" & vbcrlf
strLogin=strLogin & " <a href='Admin_Logout.asp'>退出管理</a>" & vbcrlf
strLogin=strLogin & "<br></td></tr></form></table>" & vbcrlf
strLogin=strLogin & "<div align='center'><a href=""JavaScript:openScript2('sms_main.asp?action=new',500,400)"">发短消息</a> "
if Cint(newincept())>Cint(0) then
strLogin=strLogin & "<bgsound src=""images/mail.wav"" border=0>"
if nt2003.site_setting(36)=1 then strLogin=strLogin & "<script language=JavaScript>openScript2('sms_main.asp?action=read&id="&inceptid(1)&"&sender="&inceptid(2)&"',500,400)</script>"
strLogin=strLogin & "<a href='sms_user.asp?action=inbox'>收件信箱</a>"
strLogin=strLogin & "<a href=""javascript:openScript2('sms_main.asp?action=read&id="&inceptid(1)&"&sender="&inceptid(2)&"',500,400)""><font color=red>"&newincept()&"</font>新</a>"
else
strLogin=strLogin & "<a href='sms_user.asp?action=inbox'>收件箱</a><font color=gray>0新</font>"
end if
strLogin=strLogin & "</div>"
end if
Else
dim Rs_user
Set Rs_user= Server.CreateObject("ADODB.Recordset")
sql="select top 1 ArticlesReceive from "& db_User_Table&" where UserName='"&Request.cookies("asp163")("username")&"'"
Rs_user.open sql,conn_user,1,1
if not Rs_user.eof then
if len(Rs_user("ArticlesReceive"))>1 then
strLogin = "<script language=""javascript"">window.open('User_ReceiveArticlList.asp?ArticleIDs_Rcv="&Rs_user("ArticlesReceive")&"', 'QSLIST', 'width=460,height=300,resizable=0,scrollbars=no');</script>"
end if
end if
Rs_user.close
set Rs_user=nothing
strLogin = strLogin & "欢迎您，<font color=green><b>" & UserName & "</b></font>！"
strLogin = strLogin & "<br>您的身份："
if UserLevel=999 then
strLogin = strLogin & "注册用户"
elseif UserLevel=99 then
strLogin = strLogin & "收费用户"
elseif UserLevel=9 then
strLogin = strLogin & "VIP用户"
end if
strLogin = strLogin & "<br>计费方式："
if ChargeType=1 then
if UserPoint>0 then
strLogin = strLogin & "扣点数<br>可用点数： <b><font color=blue>" & UserPoint & "</font></b> 点"
if UserPoint<=10 then
strLogin = strLogin & "<br><font color=red>你的可用点数已不多，请及时联系我们进行充值！</font>"
end if
else
strLogin = strLogin & "扣点数<br>可用点数： <b><font color=red>" & UserPoint & "</font></b> 点"
strLogin = strLogin & "<br><font color=red>你的可用点数已经用完，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
end if
else
if ValidDays>0 then
strLogin = strLogin & "有效期<br>有效天数： <b><font color=blue>" & ValidDays & "</font></b> 天"
if ValidDays<=10 then
strLogin = strLogin & "<br><font color=red>你的有效期时间已不长，请及时联系我们进行充值！</font>"
end if
else
strLogin = strLogin & "有效期<br>有效天数： <b><font color=red>" & ValidDays & "</font></b> 天"
strLogin = strLogin & "<br><font color=red>你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
end if
end if
strLogin = strLogin & "<br><b>用户控制面板：</b><br>" & vbcrlf
strLogin = strLogin & " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleAdd')"">发表文章</a>" & vbcrlf
strLogin = strLogin & " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleManage')"">文章管理</a><br>" & vbcrlf
strLogin = strLogin & " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbcrlf
strLogin = strLogin & " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyInfo')"">个人信息</a><br>" & vbcrlf
strLogin=strLogin & " <a href=""JavaScript:openScript2('sms_main.asp?action=new',500,400)"">发短消息</a> "
if Cint(newincept())>Cint(0) then
strLogin=strLogin & "<bgsound src=""images/mail.wav"" border=0>"
if nt2003.site_setting(36)=1 then strLogin=strLogin & "<script language=JavaScript>openScript2('sms_main.asp?action=read&id="&inceptid(1)&"&sender="&inceptid(2)&"',500,400)</script>"
strLogin=strLogin & "<a href='sms_user.asp?action=inbox'>收件箱</a>"
strLogin=strLogin & "<a href=""javascript:openScript2('sms_main.asp?action=read&id="&inceptid(1)&"&sender="&inceptid(2)&"',500,400)""><font color=red>"&newincept()&"</font>新</a>"
else
strLogin=strLogin & "<a href='sms_user.asp?action=inbox'>收件箱</a><font color=gray>0 新</font>"
end if
strLogin = strLogin & "<br> <a href=""JavaScript:openScript2('User_cz.asp',500,400)"">在线充值</a>" & vbcrlf
strLogin = strLogin & " <a href='User_Logout.asp'>注销登录</a><br>" & vbcrlf
end if
ShowUserLogin=strLogin
end Function
'==================================================
'过程名：ShowTopUser
'作 用：显示用户排行，按已发表的文章数排序，若相等，再按注册先后顺序排序
'参 数：UserNum-------显示的用户个数
'==================================================
function ShowTopUser(UserNum)
dim sqlTopUser,rsTopUser,strrow,str⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -