📄 cl_function_public.asp
字号:
else
for i=1 to TopNum
sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
if i mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
next
end if
end if
rsLink.Close:Set rsLink=Nothing
else
sqlLink = rsLink.GetRows(-1)
rsLink.Close:Set rsLink=Nothing
SiteCount=Ubound(sqlLink,2)
if ShowType=3 then
for i = 0 to SiteCount
sValue=sValue & "<option value=""" & sqlLink(3,i) & """>" & sqlLink(2,i) & "</option>"
next
else
if LinkType=1 then
for i = 0 to SiteCount
sValue=sValue & "<td><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>"
if sqlLink(5,i)="" or sqlLink(5,i)="http://" then
sValue=sValue & "<img src=""" & Cl.WebDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt="""" />"
else
sValue=sValue & "<img src=""" & sqlLink(5,i) & """ width=""88"" height=""31"" border=""0"" alt="""" />"
end if
sValue=sValue & "</a></td>"
if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
next
if SiteCount < TopNum-1 then
for i=SiteCount+1 to TopNum-1
sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank""><img src=""" & Cl.WebDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt=""点击申请"" /></a></td>"
if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
next
end if
else
for i = 0 to SiteCount
sValue=sValue & "<td><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>" & sqlLink(2,i) & "</a></td>"
if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
next
if SiteCount < TopNum-1 then
for i=SiteCount+1 to TopNum-1
sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
next
end if
end if
end if
sqlLink=Empty
end if
ShowLinkSite=Replace(strLink,"{$tempvalue}",sValue)
End Function
'滚动显示友情链接站点
Function RollFriendLink()
Dim sTemp
sTemp="<script type=""text/javascript"">" & vbcrlf
sTemp=sTemp & "<!--" & vbcrlf
sTemp=sTemp & "var rollspeed=30" & vbcrlf
sTemp=sTemp & "rolllink2.innerHTML=rolllink1.innerHTML //克隆rolllink1为rolllink2" & vbcrlf
sTemp=sTemp & "function Marquee(){" & vbcrlf
sTemp=sTemp & "if(rolllink2.offsetTop-rolllink.scrollTop<=0) //当滚动至rolllink1与rolllink2交界时" & vbcrlf
sTemp=sTemp & "rolllink.scrollTop-=rolllink1.offsetHeight //rolllink跳到最顶端" & vbcrlf
sTemp=sTemp & "else{" & vbcrlf
sTemp=sTemp & "rolllink.scrollTop++" & vbcrlf
sTemp=sTemp & "}" & vbcrlf
sTemp=sTemp & "}" & vbcrlf
sTemp=sTemp & "var MyMar=setInterval(Marquee,rollspeed) //设置定时器" & vbcrlf
sTemp=sTemp & "rolllink.onmouseover=function() {clearInterval(MyMar)}//鼠标移上时清除定时器达到滚动停止的目的" & vbcrlf
sTemp=sTemp & "rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}//鼠标移开时重设定时器" & vbcrlf
sTemp=sTemp & "//-->" & vbcrlf
sTemp=sTemp & "</script>"
RollFriendLink=sTemp
End Function
'=========================================================
'ShowTopUser(TopNum,ShowType,OrderType)
'显示用户排行:显示数量，排列方式（1文章数，其它为注册时间）
'TopNum ----- 最多显示多少个
'ShowType ----- 排列方式
' ----- 0(用户ID)
' ----- 1(资料)
' ----- 2(金钱)
' ----- 3(点数)
' ----- 4(登录次数)
' ----- 5(等级)
' ----- 6(新增用户)
'OrderType ----- 排序方式（0,降序，其他升序）
'=========================================================
Function ShowTopUser(Byval TopNum,Byval ShowType,Byval OrderType)
TopNum = Cl.GetClng(TopNum)
ShowType = Cl.GetClng(ShowType)
OrderType = Cl.GetClng(OrderType)
If TopNum = 0 then TopNum = 10
if OrderType=0 then
OrderType="Desc"
Else
OrderType="Asc"
End if
Dim sqlTop,rsTop,i,ts,ls
sqlTop="Select Top "&TopNum&" " & Db.UserID & "," & Db.UserName & "," & Db.UserPassWord & ","&Db.UserReName&"," & Db.UserEmail & "," & Db.UserSex & "," & Db.UserFace & "," & Db.UserFaceWidth & "," & Db.UserFaceHeight & "," & Db.UserIM & "," & Db.UserJoinDate & "," & Db.UserLastLogin & "," & Db.UserLogins & "," & Db.UserQuestion & "," & Db.UserAnswer & "," & Db.UserLastIP & "," & Db.DataCount & "," & Db.UserGroupID & "," & Db.UserPoint & "," & Db.UserMoney & "," & Db.ChargeType & "," & Db.BeginDate & "," & Db.ValidNum & " from " & Db.UserTable & " where " & Db.UserLock & "=0 "
Select Case ShowType
Case 0
sqlTop= sqlTop & " Order by " & Db.UserID & " "&OrderType&"":ts="用户ID":ls=0
Case 1
sqlTop= sqlTop & " Order by " & Db.DataCount & " "&OrderType&"," & Db.UserID & " Asc":ts="发表":ls=16
Case 2
sqlTop= sqlTop & " Order by " & Db.UserMoney & " "&OrderType&"," & Db.UserID & " Asc":ts="金钱":ls=19
Case 3
sqlTop= sqlTop & " Order by " & Db.UserPoint & " "&OrderType&"," & Db.UserID & " Asc":ts="点数":ls=18
Case 4
sqlTop= sqlTop & " Order by " & Db.UserLogins & " "&OrderType&"," & Db.UserID & " Asc":ts="登录":ls=12
Case 5
sqlTop= sqlTop & " Order by " & Db.UserGroupID & " "&OrderType&"," & Db.UserID & " Asc":ts="等级":ls=17
Case Else
sqlTop= sqlTop & " Order by " & Db.UserID & " Desc":ts="注册":ls=10
End Select
set rsTop=Cl.Execute_U(sqlTop)
if rsTop.bof and rsTop.eof then
ShowTopUser = "没有任何用户"
rsTop.Close : Set rsTop=Nothing : Exit Function
end if
sqlTop = rsTop.GetRows(-1)
rsTop.Close : Set rsTop=Nothing
Dim sTemp
sTemp="<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td align=""left"" width=""40"">名次</td><td align=""left"">用户名</td><td align=""right"">"&ts&"</td></tr>"
if ls=10 then
For i=0 to Ubound(sqlTop,2)
sTemp=sTemp & "<tr><td align=""center"">" & (i+1) & "</td><td align=""left""><a href="""&Cl.WebDir&"User/Info.asp?UserID=" & sqlTop(0,i) & """>" & sqlTop(1,i) & "</a></td><td align=""right"">" & formatdatetime(sqlTop(ls,i),2)& "</td></tr>"
next
else
For i=0 to Ubound(sqlTop,2)
sTemp=sTemp & "<tr><td align=""center"">" & (i+1) & "</td><td align=""left""><a href="""&Cl.WebDir&"User/Info.asp?UserID=" & sqlTop(0,i) & """>" & sqlTop(1,i) & "</a></td><td align=""right"">" & sqlTop(ls,i) & "</td></tr>"
next
end if
sTemp=sTemp & "<tr><td align=""right"" colspan=""3""><a href="""&Cl.WebDir&"User/List.asp"">more...</a></td></tr>"
sTemp=sTemp & "</table>"
ShowTopUser=sTemp
sqlTop=Empty
End Function
'=====================================================
'ShowGuest(TopNum,TitleLen,ShowReply)
'参数：
' TopNum ----- 显示记录数
' TitleLen ----- 标题字节数
' ShowReply ----- 是否显示已回复字样（True为是）
'=====================================================
Function ShowGuest(Byval TopNum,Byval TitleLen,Byval ShowReply)
TopNum=Cl.GetClng(TopNum)
TitleLen=Cl.GetClng(TitleLen)
ShowReply=Cl.GetCBool(ShowReply)
if TopNum=0 then TopNum=8
dim sqlGuest,rsGuest
sqlGuest="select top "&TopNum&" UserID,UserName,GuestId,GuestTitle,GuestTime,ReplyCount from Cl_Guest where Status=1 order by GuestID desc"
Set rsGuest= Cl.Execute(sqlGuest)
if rsGuest.bof and rsGuest.eof then
ShowGuest="没有任何留言"
rsGuest.Close:Set rsGuest=Nothing:Exit Function
End if
sqlGuest=RsGuest.GetRows(-1)
rsGuest.Close:Set rsGuest=Nothing
dim i,sTemp
sTemp="<ul>"
for i=0 to Ubound(sqlGuest,2)
sTemp=sTemp & "<li><span class=""title""><a href="""&Cl.WebDir&"GuestBook/Show.asp?GuestID="&sqlGuest(2,i)&""" target=""_blank"">"
sTemp=sTemp & Cl.GotTopic(sqlGuest(3,i),TitleLen)
sTemp=sTemp & "</a></span>"
if ShowReply then
sTemp=sTemp & "<span class=""replycount"">"&sqlGuest(5,i)&"</span>"
end If
sTemp=sTemp & "</li>"
Next
ShowGuest=sTemp & "</ul>"
sqlGuest=Empty
End Function
'==================================================================
'过程：ShowAD(sAdID,sType,sAct,sWidth,sHeight)
'参数：
' sAdID ------ ADID
' sType ------ 0=图片，1=代码
' sAct ------ 0=普通，1=弹出，2=浮动，3=固定
' sWidth ------ 宽度
' sHeight ------ 高度
'==================================================================
Function ShowAD(Byval sAdID,Byval sType,Byval sAct,Byval sWidth,Byval sHeight)
dim sqlAD,rsAD,sTempAD
On Error Resume Next
sAdID = Clng(sAdID)
sType = Clng(sType)
sAct = Clng(sAct)
sWidth = Clng(sWidth)
sHeight = Clng(sHeight)
if Err then Err.Clear : ShowAD="ShowAD参数错误。" : Exit Function
On Error GoTo 0
if sAdID>0 then
sqlAD="Select ID,AdName,AdLinkUrl,AdImgUrl,ImgWidth,ImgHeight,IsFlash,ADType,AdAct,ADSetting from Cl_Ads where ID=" & sAdID & " and IsUse=1"
else
sqlAD="Select Top 1 ID,AdName,AdLinkUrl,AdImgUrl,ImgWidth,ImgHeight,IsFlash,ADType,AdAct,ADSetting from Cl_Ads where AdAct=" & sAct & " and IsUse=1 and AdType="&sType&""
end if
Set rsAD=Cl.Execute(sqlAD)
if rsAd.bof and rsAD.eof then
rsAD.Close : Set rsAD=Nothing
ShowAD = "" : Exit Function
end if
Select Case rsAd(7)
Case 0
if sWidth = 0 then sWidth = rsAd(4)
if sHeight = 0 then sHeight= rsAd(5)
if rsAd(6)=true then
sTempAD = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""" & sWidth & """ height=""" & sHeight & """>"
sTempAD = sTempAD & "<param name=""movie"" value=""" & rsAd(3) & """><param name=""quality"" value=""high""><embed src=""" & rsAd(3) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & sWidth & """ height=""" & sHeight & """>"
sTempAD = sTempAD & "</embed></object>"
else
sTempAd = "<a href=""" & rsAd(2) & """ target=""_blank"" title=""" & rsAd(1) & """><img src=""" & rsAd(3) & """ width=""" & sWidth & """ height=""" & sHeight & """ border=""0"" alt="""" /></a>"
end if
'sTempAD = Replace(Replace(sTempAD,"'",""),vbcrlf,"\n")
Dim AdSetting
AdSetting = split(rsAd(9),"|")
if Clng(AdSetting(1)) = 0 then AdSetting(1) = 100
if Clng(AdSetting(2)) = 0 then AdSetting(2) = 100
Select Case rsAd(8)
Case 0
ShowAD = sTempAD
Case 1
ShowAD = Template.GetTemplate(Cl.GetDefaultTemplateID(-1,6,Template.ProjectID))
ShowAD = Replace(ShowAD,"{$adid}",sAdID)
ShowAD = Replace(ShowAD,"{$width}",sWidth)
ShowAD = Replace(ShowAD,"{$height}",sHeight)
ShowAD = Replace(ShowAD,"{$popleft}",AdSetting(1))
ShowAD = Replace(ShowAD,"{$poptop}",AdSetting(2))
ShowAD = "<script type=""text/javascript"">" & vbcrlf & Cl.ReplaceDir(ShowAD) & "</script>"
Case 2
ShowAD = "<div id=""FlAD_"&sAdID&""" style=""position:absolute; z-index:10;left: "&AdSetting(1)&"; top: "&AdSetting(2)&""">" & sTempAD & "</div>"
ShowAD = ShowAD & VbCrlf & "<script type=""text/javascript"">" & vbcrlf & Replace(Template.GetTemplate(Cl.GetDefaultTemplateID(-1,7,Template.ProjectID)),"{$adid}",sAdID) & "</script>"
Case 3
ShowAD = "<div id=""FixAD_"&sAdID&""" style=""position:absolute; z-index:10;left: "&AdSetting(1)&"; top: "&AdSetting(2)&""">" & sTempAD & "</div>"
ShowAD = ShowAD & VbCrlf & "<script type=""text/javascript"">" & vbcrlf & Replace(Template.GetTemplate(Cl.GetDefaultTemplateID(-1,8,Template.ProjectID)),"{$adid}",sAdID) & "</script>"
End Select
Case 1
ShowAD = Cl.ReplaceDir(rsAd(3))
Case Else
ShowAD = ""
End Select
rsAD.Close : Set rsAD=Nothing
End Function
'==================================================================
'过程：ShowComment(sChannelID,InfoID,TopNum)
'参数：
' sChannelID ------ 频道ID
' InfoID ------ 内容ID
' TopNum ------ 最多显示数
'==================================================================
Function ShowComment(Byval sChannelID,Byval InfoID,Byval TopNum)
Dim rsComment,sqlComment,rsCommentU,NoPassedNum,i
'NoPassedNum=Cl.Execute("Select Count(CommentID) from Cl_Comment where ChannelID="&sChannelID&" and InfoID=" & InfoID & " and Status=0")(0)
'if NoPassedNum="" then NoPassedNum=0
sChannelID = Cl.GetClng(sChannelID)
InfoID = Cl.GetClng(InfoID)
TopNum = Cl.GetClng(TopNum)
if TopNum > 0 And TopNum<20 then
sqlComment = "select top " & TopNum & " "
else
sqlComment = "select top 8 "
end if
sqlComment=sqlComment & " CommentID,InfoID,UserID,UserName,UserGroupID,UserEmail,CommentTime,CommentContent,Status from Cl_Comment where ChannelID="&sChannelID&" and InfoID=" & InfoID & " "
'if Cl.UserGroupID=1 then
'sqlComment=sqlComment & " order by CommentID desc"
'else
sqlComment=sqlComment & " and Status=1 order by CommentID desc"
'end if
Set rsComment = Cl.Execute(sqlComment)
if rsComment.bof and rsComment.eof then
'if NoPassedNum>0 then
' ShowComment="<li style=""text-align:right;"">待审评论 <b><font color=""#FF0033"">"&NoPassedNum&"</font></b> 条，请管理员 <a href="""&Cl.WebDir&"User/Login.asp""><font color=""#FF0033"">登录</font></a> 后操作！</li>"
'else
ShowComment="<li>没有任何评论</li>"
'end if
rsComment.close:set rsComment=Nothing
else
Set ClUbb=New Cls_UbbCode
Dim sTemp,UserIM
sTemp="<div class='commentlist'><ul>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -