📄 syscode.asp
字号:
sRet=sRet & "</ul>" & Vbcrlf
sRet = sRet & oblog.GetNickNameById (arrayList,i,teamid&postnum&l&u&t)
End if
GetPosts=sRet
End Function
'最受欢迎的用户,计算方法
'user_siterefu_num+comment_count*1.5+message_count*1.5+sub_num*3
'访问数+回复数*1.5+留言数*1.5+被订阅数*3
't 是否显示用户头像
Function GetHotUsers(n,t)
Dim rs, userurl,userico,i
set rs=oblog.execute("select top "&n&" username,nickname,blogname,userid,user_dir,user_domain,user_domainroot,user_folder,user_icon1 from [oblog_user] where lockuser=0 and isdel=0 order by (user_siterefu_num+comment_count*1.5+message_count*1.5+sub_num*3) desc,userid DESC")
GetHotUsers = Vbcrlf & "<ul>" & Vbcrlf
While Not rs.EOF
If oblog.cacheConfig(5) = 1 Then
userurl = "http://" & Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
Else
userurl = rs("user_dir") & "/" & rs("user_folder") & "/index." & f_ext
End If
If t=1 Then userico="<img src=""" & OB_IIF(rs(8),"images/ico_default.gif") & """ width=""48"" height=""48"" border=""0"" /><br />"
GetHotUsers=GetHotUsers&"<li><a href="&userurl&" target=""_blank"" title=""" & rs(2)& """>"&userico& rs(2)&"</a></li>" & vbcrlf
rs.MoveNext
Wend
GetHotUsers=GetHotUsers&"</ul>" & Vbcrlf
Set rs = Nothing
End Function
'随机调用博客链接,这里只调头像,博客名会默认显示在提示那里.
'show_rnduser(调用条数,图片高度,图片宽度,是否只调用推荐/活跃,多少天内登录过的活跃用户,是否只调用有自定义头像的用户)
'是否只调用推荐/活跃 1 只是推荐 10 只是推荐男生博客 11 只是推荐女生博客 2 按最后登录时间过滤 20按登录时间过滤男生 21按登录时间过滤女生
'是否只调用有自定义头像的用户 0 否 1 是
'$show_rnduser(40,48,48,2,30,1)$
Function GetRndUser(num,width,height,types,dht,ishaveface)
Dim rs,sql,Utype,UFdate,RndOrderBy,userurl
UFdate = int(dht)
If Err Then Err.clear:UFdate = 30
If Is_Sqldata = 1 Then
RndOrderBy = " Order By Newid()"
Else
Randomize
RndOrderBy = " Order By Rnd(-(UserID+"&Rnd()&"))"
End If
If ishaveface = "1" Then RndOrderBy=" and not(user_icon1 is null or user_icon1='') " & RndOrderBy
Select Case types
Case "1"
Utype= " and user_isbest=1"
Case "10"
Utype= " and user_isbest=1 and sex=1"
Case "11"
Utype= " and user_isbest=1 and sex=0"
Case "2"
Utype= " and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
Case "20"
Utype= " and sex=1 and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
Case "21"
Utype= " and sex=0 and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
End Select
Set rs=oblog.execute("select top "&num&" username,nickname,blogname,userid,user_dir,user_domain,user_domainroot,user_folder,user_icon1 from [oblog_user] where lockuser=0 and isdel=0 and (blog_password is null or blog_password='') "&Utype&" "&RndOrderBy)
GetRndUser = Vbcrlf & "<ul id=""showrnduser"">" & Vbcrlf
While Not rs.EOF
If oblog.cacheConfig(5) = 1 Then
userurl = "http://" & Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
Else
userurl = rs("user_dir") & "/" & rs("user_folder") & "/index." & f_ext
End If
GetRndUser=GetRndUser&"<li><a href="""&userurl&""" target=""_blank"" title=""" & rs(2)& """><img src=""" & OB_IIF(rs(8),"images/ico_default.gif") & """ width="""&width&""" height=""" & height & """ border=""0"" title="""&rs(2)&"""/></a></li>" & vbcrlf
rs.MoveNext
Wend
GetRndUser=GetRndUser&"</ul>" & Vbcrlf
Set rs = Nothing
End Function
function TreeClass(n)
dim Table_Name,wsql,toptitle,fname
select case n
case "user"
Table_Name="oblog_userclass"
wsql=""
toptitle="用户类别"
fname="listblogger.asp?usertype="
case "log"
Table_Name="oblog_logclass"
wsql=" where idType=0 "
toptitle="日志类别"
fname="list.asp?classid="
case "photo"
Table_Name="oblog_logclass"
wsql=" where idType=1 "
toptitle="相片类别"
fname="photo.asp?classid="
case "group"
Table_Name="oblog_logclass"
toptitle=oblog.CacheConfig(69)& "类别"
wsql=" where idType=2 "
fname="groups.asp?classid="
end select
dim sqlClass,rsClass,D_String
sqlClass="select id,parentid,classname From "&Table_Name&wsql&" order by RootID,OrderID"
set rsClass=oblog.execute(sqlClass)
'把查询到的内容存放到字符串里,在JS中调用该字符串
do while not rsClass.eof
D_String=D_String&"|"&rsClass("id")&","&rsClass("parentid")&",<a href='"&fname & rsClass("id") & "'>"&rsClass("classname")&"</a>,0"
rsClass.movenext
loop
TreeClass="<script src='inc/tree.js'></script><script language='javascript' type='text/javascript'>var J_String,J_First,J_Second;var i,j;d = new dTree('d');d.add(0,-1,'<strong>"&toptitle&"</strong>');J_String="""&D_String&""";J_First=J_String.split('|');for(i=0;i<J_First.length;i++){J_Second=J_First[i].split(',');d.add(J_Second[0],J_Second[1],J_Second[2],'',J_Second[3]);}document.write(d);</script>"
set rsClass=nothing
end function
'获得辩论列表
'n:显示条数;
'l:字符数目;
's:显示类型,1最新/2参与人数最多
Function GetArgueList(n,l,s)
Dim sRet,Sql,rs,sState
If s="1" Then
'最新
Sql="select top " & n & " argueid,topic,a_ico,actions,actions1,actions2,actions3 From oblog_argue Where istate=2 Order By argueid Desc"
Else
'最热的
Sql="select top " & n & " argueid,topic,a_ico,actions,actions1,actions2,actions3 From oblog_argue Where istate=2 Order By actions Desc"
End If
'Response.Write Sql
Set rs=oblog.Execute(Sql)
Do While Not rs.Eof
sRet=sRet & "<li><a href=""bl.asp?cmd=show&blid=" & rs("argueid") & """ target=""_blank"">" & Left(rs("topic"),l) & "</a><br/><font color=""red"">正</font> " & rs("actions1") & " <font color=""blue"">反</font> " & rs("actions2") & " <font color=""green"">参与</font> " & rs("actions") & "</li>"
rs.Movenext
Loop
Set rs=Nothing
GetArgueList=sRet
sRet=""
End Function
Function GetTemplate(n)
Dim sRet,Sql,rs
sql="SELECT TOP "&n&" * FROM oblog_userskin WHERE ispass=1 ORDER BY Id DESC"
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open sql ,CONN,1,1
If Not RS.Eof Then
While Not rs.EOF
sRet = sRet &"<!-- 最新模板 -->"&vbcrlf
sRet = sRet &"<div id=""NewSkin"">"&vbcrlf
sRet = sRet &" <div class=""SkinImg""><a href=""showskin.asp?id="&rs("id")&""" target =""_blank""><img src="""&rs("skinpic")&""" alt="""&rs("userskinname")&""" /></a></div>"&vbcrlf
sRet = sRet &" <div class=""Skinname""><a href=""showskin.asp?id="&rs("id")&""" target =""_blank"">"&rs("userskinname")&"</a></div>"&vbcrlf
sRet = sRet &"</div>"&vbcrlf
sRet = sRet &"<!-- 最新模板 END -->"&vbcrlf
rs.MoveNext
Wend
End If
GetTemplate = sRet
sRet = ""
End Function
Function GetAlbum(n,l)
Dim sRet,Sql,rs
Dim Imgsrc,Preimgsrc,fso
Set fso = Server.CreateObject(oblog.CacheCompont(1))
Sql = "SELECT TOP "&N&" c.photo_path,c.subjectid,c.subjectlognum,userid,subjectname FROM "
Sql = Sql &" oblog_subject AS c "
Sql = Sql &" WHERE c.subjecttype = 1 AND (c.ishide = 0 OR c.ishide IS NULL)"
If L = 0 Then
Sql = Sql &" ORDER BY c.subjectid DESC"
Else
Sql = Sql &" ORDER BY c.views DESC,c.subjectid DESC"
End If
' OB_DEBUG SQL,1
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open sql ,CONN,1,1
If Not RS.Eof Then
sRet = "<!-- 相册标签 -->"&vbcrlf
sRet = sRet &"<div id=""NewPhotoAlbum"">"&vbcrlf
While Not rs.EOF
Imgsrc=RS(0)
If Not IsNull(Imgsrc) Then
Preimgsrc=Replace(Imgsrc,Right(Imgsrc,3),"Jpg")
Preimgsrc=Replace(Preimgsrc,Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")),"Pre"&Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")))
If Not Fso.Fileexists(Server.Mappath(Preimgsrc)) Then
Preimgsrc=Imgsrc
End If
End if
sRet = sRet &" <div class=""NewPhotoAlbum"">"&vbcrlf
sRet = sRet &" <div class=""NewPhotoAlbumImg""><a href=""go.asp?albumid="&rs(3)&""" target = ""_blank""><img src="""&Proico(Preimgsrc,4)&""" /></a></div>"&vbcrlf
sRet = sRet &" <div class=""NewPhotoAlbumName""><a href=""go.asp?albumid="&rs(3)&""" target = ""_blank"">"&rs("subjectname")&"</a></div>"&vbcrlf
sRet = sRet &" </div>"&vbcrlf
RS.MoveNext
Wend
sRet = sRet &"</div>"&vbcrlf
sRet = sRet &"<!-- 相册标签 END -->"&vbcrlf
End If
GetAlbum = sRet
sRet = ""
End Function
Function GetPic(n,l)
Dim sRet,Sql,rs
Dim Imgsrc,Preimgsrc,fso
Set fso = Server.CreateObject(oblog.CacheCompont(1))
Sql = "SELECT TOP "&N&" photo_path,photo_title,fileid FROM oblog_album "
Sql = Sql &" WHERE (ishide = 0 OR ishide IS NULL)"
If L = 0 Then
Sql = Sql &" ORDER BY photoID DESC"
ElseIf l = 1 Then
Sql = Sql &" ORDER BY views DESC,photoID DESC"
Else
Sql = Sql &" ORDER BY commentnum DESC,photoID DESC"
End If
' OB_DEBUG SQL,1
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open sql ,CONN,1,1
If Not RS.Eof Then
sRet = "<!-- 相片标签 -->"&vbcrlf
sRet = sRet &"<div id=""NewPhoto"">"&vbcrlf
While Not rs.EOF
Imgsrc=RS(0)
Preimgsrc=Replace(Imgsrc,Right(Imgsrc,3),"Jpg")
Preimgsrc=Replace(Preimgsrc,Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")),"Pre"&Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")))
If Not Fso.Fileexists(Server.Mappath(Preimgsrc)) Then
Preimgsrc=Imgsrc
End If
sRet = sRet &" <div class=""NewPhoto"">"&vbcrlf
sRet = sRet &" <div class=""NewPhotoImg""><a href=""go.asp?fileid="&rs(2)&""" target = ""_blank""><img src="""&Proico(Preimgsrc,4)&""" /></a></div>"&vbcrlf
sRet = sRet &" <div class=""NewPhotoName""><a href=""go.asp?fileid="&rs(2)&""" target = ""_blank"">"&OB_IIF(rs(1),"无标题")&"</a></div>"&vbcrlf
sRet = sRet &" </div>"&vbcrlf
RS.MoveNext
Wend
sRet = sRet &"</div>"&vbcrlf
sRet = sRet &"<!-- 相片标签 END -->"&vbcrlf
End If
GetPic = sRet
sRet = ""
End Function
Function GetDiggs(n,l)
Dim sRet,Sql,rs,ClassName
Dim arrayList,i
ReDim arrayList(n-1)
Sql = "SELECT TOP "&N&" diggnum,diggurl,diggtitle,addtime,author,authorid FROM oblog_userdigg "
Sql = Sql &" WHERE istate = 1 "
If L = 0 Then
Sql = Sql &" ORDER BY DiggID DESC"
ClassName = "NewDIGG"
ElseIf l = 1 Then
Sql = Sql &" ORDER BY diggnum DESC,DiggID DESC"
ClassName = "DIGGTop"
Else
Sql = Sql &" ORDER BY lastdiggtime DESC"
End If
' OB_DEBUG SQL,1
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open sql ,CONN,1,1
If Not RS.Eof Then
i = 0
sRet = "<!-- DIGG标签 -->"&vbcrlf
sRet = sRet &"<div id="""&ClassName&""">"&vbcrlf
While Not rs.EOF
arrayList(i) = rs("authorid")
sRet = sRet &" <div class="""&ClassName&""">"&vbcrlf
sRet = sRet &" <span class=""DIGGNumber"">"&rs(0)&"</span>"&vbcrlf
sRet = sRet &" <span class=""DIGGTitle""><a href="""&rs(1)&""" title="""&rs(2)&""">"&rs(2)&"</a></span>"&vbcrlf
If l = 0 Then
sRet = sRet &" <span class=""DIGGTime"">"&rs(3)&"</span>"&vbcrlf
sRet = sRet &" <span class=""DIGGUser""><a href=""go.asp?userid="&rs(5)&"""><span name=""nickname_"&rs("authorid")&""" id=""nickname_"&rs("authorid")&""">"&rs("authorid")&"</span></a></span>"&vbcrlf
End If
sRet = sRet &" </div>"&vbcrlf
i = i + 1
RS.MoveNext
Wend
sRet = sRet &"</div>"&vbcrlf
sRet = sRet &"<!-- DIGG标签 END -->"&vbcrlf
sRet = sRet & oblog.GetNickNameById (arrayList,i,n&l)
End If
GetDiggs = sRet
sRet = ""
End Function
Function GetUserDiggs(n,l)
Dim sRet,Sql,rs
Sql = "SELECT TOP "&N&" userid,User_Icon1,username,nickname,diggs FROM "
Sql = Sql &" oblog_user "
Sql = Sql &" WHERE lockuser=0 AND isdel=0 "
If L = 0 Then
Sql = Sql &" ORDER BY diggs DESC,userid DESC"
Else
Sql = Sql &" ORDER BY userid DESC"
End If
' OB_DEBUG SQL,1
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open sql ,CONN,1,1
If Not RS.Eof Then
sRet = "<!-- DIGG标签 -->" & vbcrlf
sRet = sRet &"<div id=""DIGGMostUser"">" & vbcrlf
While Not rs.EOF
sRet = sRet &" <div class=""DIGGMostUser"">" & vbcrlf
sRet = sRet &" <div class=""DIGGMostUserIco""><a href=""go.asp?userid="&rs(0)&""" target = ""_blank""><img src="""&Proico(rs(1),1)&""" alt="""&OB_IIF(rs(3),rs(2))&""" /></a></div>" & vbcrlf
sRet = sRet &" <div class=""DIGGMostUserName""><a href=""go.asp?userid="&rs(0)&""" title=""alt="""&OB_IIF(rs(3),rs(2))&""""" target = ""_blank"">"&OB_IIF(rs(3),rs(2))&"</a>被推荐<span title="""&OB_IIF(rs(4),0)&""">"&OB_IIF(rs(4),0)&"</span>次</div>" & vbcrlf
sRet = sRet &" </div>" & vbcrlf
RS.MoveNext
Wend
sRet = sRet &"</div>" & vbcrlf
sRet = sRet &"<!-- DIGG标签 END -->" & vbcrlf
End If
GetUserDiggs = sRet
sRet = ""
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -