"
else
strClassTree=strClassTree & "
"
end if
else
if arrShowLine(i)=True then
strClassTree=strClassTree & "
"
else
strClassTree=strClassTree & "
"
end if
end if
next
end if
if rsClass(6)>0 then
strClassTree=strClassTree & "
"
else
strClassTree=strClassTree & "
"
end if
if rsClass(5)="" then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
if rsClass(2)=0 then
strClassTree=strClassTree & "" & rsClass(1) & ""
else
strClassTree=strClassTree & rsClass(1)
end if
'if rsClass(5)<>"" then
' strClassTree=strClassTree & "(外)"
'end if
strClassTree=strClassTree & ""
if rsClass(6)>0 then
strClassTree=strClassTree & "（" & rsClass(6) & "）"
end if
strClassTree=strClassTree & "" rsClass.movenext loop end if rsClass.close set rsClass=nothing response.write strClassTree end sub '================================================= '过程名：ShowChildClass '作 用：显示当前栏目的下一级子栏目 '参 数：ShowType--------显示方式，1为竖向列表，2为横向列表 '================================================= sub ShowChildClass(ShowType) dim sqlChild,rsChild,i sqlChild="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From PhotoClass C" sqlChild= sqlChild & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & ClassID & " order by C.OrderID" Set rsChild= Server.CreateObject("ADODB.Recordset") rsChild.open sqlChild,conn,1,1 if rsChild.bof and rsChild.eof then response.write "没有任何子栏目" else if ShowType=1 then do while not rsChild.eof if rsChild(5)<>"" then response.write "
" rsChild.movenext loop else i=0 do while not rsChild.eof if rsChild(5)<>"" then response.write " " & rsChild(1) & "" else response.Write " " & rsChild(1) & "" end if if rsChild(6)>0 then response.write "(" & rsChild(6) & ")" end if rsChild.movenext i=i+1 if i mod 5=0 then response.write "
" end if loop end if end if rsChild.close set rsChild=nothing end sub '================================================= '过程名：ShowClassNavigation '作 用：显示栏目导航 '参 数：无 '================================================= sub ShowClassNavigation() dim rsNavigation,sqlNavigation,strNavigation,PrevRootID,i sqlNavigation="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.RootID,C.LinkUrl,C.Child,C.Readme From PhotoClass C" sqlNavigation= sqlNavigation & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth<=1 order by C.RootID,C.OrderID" Set rsNavigation= Server.CreateObject("ADODB.Recordset") rsNavigation.open sqlNavigation,conn,1,1 if rsNavigation.bof and rsNavigation.eof then response.write "没有任何栏目" else strNavigation="
| 【" & rsNavigation(1) & "】 | "
PrevRootID=rsNavigation(4)
rsNavigation.movenext
i=1
do while not rsNavigation.eof
if PrevRootID=rsNavigation(4) then
if i mod 6=0 then
strNavigation=strNavigation & " " end if strNavigation=strNavigation & "" & rsNavigation(1) & " " i=i+1 else strNavigation=strNavigation & " |
| 【" & rsNavigation(1) & "】 | " i=1 end if PrevRootID=rsNavigation(4) rsNavigation.movenext loop strNavigation=strNavigation & " |
" rsCount.close sqlCount="select count(PhotoID) from Photo where Passed=False and Deleted=False" rsCount.open sqlCount,conn,1,1 response.write "待审图片：" & rsCount(0) & "个
" rsCount.close sqlCount="select count(CommentID) from PhotoComment" rsCount.open sqlCount,conn,1,1 response.write "评论总数：" & rsCount(0) & "条
" rsCount.close sqlCount="select count(SpecialID) from Special" rsCount.open sqlCount,conn,1,1 response.write "专题总数：" & rsCount(0) & "个
" rsCount.close sqlCount="select count(" & db_User_ID & ") from " & db_User_Table & "" rsCount.open sqlCount,Conn_User,1,1 response.write "注册用户：" & rsCount(0) & "名
" rsCount.close sqlCount="select sum(Hits) from Photo" rsCount.open sqlCount,conn,1,1 response.write "图片查看：" & rsCount(0) & "人次
" rsCount.close set rsCount=nothing end sub '================================================= '过程名：ShowPhoto '作 用：分页显示图片标题等信息 '参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowPhoto(TitleLen,strClassID) if TitleLen<0 or TitleLen>200 then TitleLen=50 end if sqlPhoto="select P.PhotoID,P.ClassID,C.ClassName,L.LayoutFileName,P.PhotoName,P.PhotoUrl_Thumb,P.Author,P.AuthorEmail,P.Keyword,P.UpdateTime,P.Editor,P.Hits,P.DayHits,P.WeekHits,P.MonthHits,P.PhotoSize,P.OnTop,P.Elite,P.Passed,P.Stars,P.PhotoLevel,P.PhotoPoint from Photo P" sqlPhoto=sqlPhoto & " inner join (PhotoClass C inner join Layout L on C.LayoutID=L.LayoutID) on P.ClassID=C.ClassID where P.Deleted=False and P.Passed=True " 'if SpecialID>0 then ' sqlPhoto=sqlPhoto & " and P.SpecialID=" & SpecialID 'end if if instr(strClassID,",")>0 then sqlPhoto=sqlPhoto & " and P.ClassID in (" & strClassID & ")" else sqlPhoto=sqlPhoto & " and P.ClassID=" & Clng(strClassID) end if if keyword<>"" then select case strField case "PhotoName" sqlPhoto=sqlPhoto & " and P.PhotoName like '%" & keyword & "%' " case "PhotoIntro" sqlPhoto=sqlPhoto & " and P.PhotoIntro like '%" & keyword & "%' " case "Author" sqlPhoto=sqlPhoto & " and P.Author like '%" & keyword & "%' " case "Editor" sqlPhoto=sqlPhoto & " and P.Editor like '%" & keyword & "%' " case else sqlPhoto=sqlPhoto & " and P.PhotoName like '%" & keyword & "%' " end select end if sqlPhoto=sqlPhoto & " order by P.OnTop,P.PhotoID desc" Set rsPhoto= Server.CreateObject("ADODB.Recordset") rsPhoto.open sqlPhoto,conn,1,1 if rsPhoto.bof and rsPhoto.eof then totalput=0 response.Write("
| "
response.write " |  |
 | |
| 没有图片 | " else i=0 do while not rsNew.eof if i>0 and i mod 4=0 then response.write "||||
"
response.write "
| "
i=i+1
rsNew.movenext
loop
end if
response.write "||||
" rsTop.movenext loop end if rsTop.close set rsTop=nothing end sub '================================================= '过程名：ShowTopDay '作 用：显示本日下载TOP N，N由参数PhotoNum指定 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowTopDay(PhotoNum,TitleLen) dim sqlTop,rsTop if PhotoNum>0 and PhotoNum<=100 then sqlTop="select top " & PhotoNum else sqlTop="select top 10 " end if sqlTop=sqlTop & " S.PhotoID,S.PhotoName,S.PhotoVersion,S.Author,S.Keyword,S.UpdateTime,S.Editor,S.Hits,S.DayHits,S.WeekHits,S.MonthHits,S.PhotoSize,S.PhotoLevel,S.PhotoPoint from Photo S where S.Deleted=False and S.Passed=True And datediff('D',LastHitTime,now())<=0 order by S.DayHits desc,S.PhotoID desc" Set rsTop= Server.CreateObject("ADODB.Recordset") rsTop.open sqlTop,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=100 if rsTop.bof and rsTop.eof then response.write "
" rsTop.movenext loop end if rsTop.close set rsTop=nothing end sub '================================================= '过程名：ShowTopWeek '作 用：显示本周下载TOP N，N由参数PhotoNum指定 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowTopWeek(PhotoNum,TitleLen) dim sqlTop,rsTop if PhotoNum>0 and PhotoNum<=100 then sqlTop="select top " & PhotoNum else sqlTop="select top 10 " end if sqlTop=sqlTop & " S.PhotoID,S.PhotoName,S.PhotoVersion,S.Author,S.Keyword,S.UpdateTime,S.Editor,S.Hits,S.DayHits,S.WeekHits,S.MonthHits,S.PhotoSize,S.PhotoLevel,S.PhotoPoint from Photo S where S.Deleted=False and S.Passed=True And datediff('ww',LastHitTime,now())<=0 order by S.WeekHits desc,S.PhotoID desc" Set rsTop= Server.CreateObject("ADODB.Recordset") rsTop.open sqlTop,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=100 if rsTop.bof and rsTop.eof then response.write "
" rsTop.movenext loop end if rsTop.close set rsTop=nothing end sub '================================================= '过程名：ShowTopMonth '作 用：显示本月下载TOP N，N由参数PhotoNum指定 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowTopMonth(PhotoNum,TitleLen) dim sqlTop,rsTop if PhotoNum>0 and PhotoNum<=100 then sqlTop="select top " & PhotoNum else sqlTop="select top 10 " end if sqlTop=sqlTop & " S.PhotoID,S.PhotoName,S.PhotoVersion,S.Author,S.Keyword,S.UpdateTime,S.Editor,S.Hits,S.DayHits,S.WeekHits,S.MonthHits,S.PhotoSize,S.PhotoLevel,S.PhotoPoint from Photo S where S.Deleted=False and S.Passed=True And datediff('m',LastHitTime,now())<=0 order by S.MonthHits desc,S.PhotoID desc" Set rsTop= Server.CreateObject("ADODB.Recordset") rsTop.open sqlTop,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=100 if rsTop.bof and rsTop.eof then response.write "
" rsTop.movenext loop end if rsTop.close set rsTop=nothing end sub '================================================= '过程名：ShowHot '作 用：显示热门下载 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowHot(PhotoNum,TitleLen) dim sqlHot,rsHot if PhotoNum>0 and PhotoNum<=100 then sqlHot="select top " & PhotoNum else sqlHot="select top 10 " end if sqlHot=sqlHot & " P.PhotoID,P.PhotoName,P.PhotoUrl_Thumb,P.Author,P.Keyword,P.UpdateTime,P.Editor,P.Hits,P.DayHits,P.WeekHits,P.MonthHits,P.PhotoSize,P.PhotoLevel,P.PhotoPoint from Photo P where P.Deleted=False and P.Passed=True And P.Hits>=" & HitsOfHot sqlHot=sqlHot & " order by P.PhotoID desc" Set rsHot= Server.CreateObject("ADODB.Recordset") rsHot.open sqlHot,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=50 if rsHot.bof and rsHot.eof then response.write "
" rsHot.movenext loop end if rsHot.close set rsHot=nothing end sub '================================================= '过程名：ShowElite '作 用：显示推荐图片 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowElite(PhotoNum,TitleLen) dim sqlElite,rsElite if PhotoNum>0 and PhotoNum<=100 then sqlElite="select top " & PhotoNum else sqlElite="select top 10 " end if sqlElite=sqlElite & " P.PhotoID,P.PhotoName,P.PhotoUrl_Thumb,P.Author,P.Keyword,P.UpdateTime,P.Editor,P.Hits,P.DayHits,P.WeekHits,P.MonthHits,P.PhotoSize,P.PhotoLevel,P.PhotoPoint from Photo P where P.Deleted=False and P.Passed=True And P.Elite=True " sqlElite=sqlElite & " order by P.PhotoID desc" Set rsElite= Server.CreateObject("ADODB.Recordset") rsElite.open sqlElite,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=50 if rsElite.bof and rsElite.eof then response.write "
" rsElite.movenext loop end if rsElite.close set rsElite=nothing end sub '================================================= '过程名：ShowCorrelative '作 用：显示相关图片 '参 数：PhotoNum ----最多显示多少个图片 ' TitleLen ----标题最多字符数，一个汉字=两个英文字符 '================================================= sub ShowCorrelative(PhotoNum,TitleLen) dim rsCorrelative,sqlCorrelative dim strKey,arrKey,i if PhotoNum>0 and PhotoNum<=100 then sqlCorrelative="select top " & PhotoNum else sqlCorrelative="Select Top 5 " end if strKey=mid(rs("Keyword"),2,len(rs("Keyword"))-2) if instr(strkey,"|")>1 then arrKey=split(strKey,"|") strKey="((S.Keyword like '%|" & arrKey(0) & "|%')" for i=1 to ubound(arrKey) strKey=strKey & " or (S.Keyword like '%|" & arrKey(i) & "|%')" next strKey=strKey & ")" else strKey="(S.Keyword like '%|" & strKey & "|%')" end if sqlCorrelative=sqlCorrelative & " S.PhotoID,S.PhotoName,S.PhotoVersion,S.Author,S.Keyword,S.UpdateTime,S.Editor,S.Hits,S.PhotoSize,S.PhotoLevel,S.PhotoPoint from Photo S Where S.Deleted=False and S.Passed=True and " & strKey & " and S.PhotoID<>" & PhotoID & " Order by S.PhotoID desc" Set rsCorrelative= Server.CreateObject("ADODB.Recordset") rsCorrelative.open sqlCorrelative,conn,1,1 if TitleLen<0 or TitleLen>255 then TitleLen=50 if rsCorrelative.bof and rsCorrelative.Eof then response.write "没有相关图片" else do while not rsCorrelative.eof response.Write "
" rsCorrelative.movenext loop end if rsCorrelative.close set rsCorrelative=nothing end sub '================================================= '过程名：ShowComment '作 用：显示相关评论 '参 数：CommentNum ----最多显示多少个评论 '================================================= sub ShowComment(CommentNum) dim rsComment,sqlComment,rsCommentUser if CommentNum>0 and CommentNum<=100 then sqlComment="select top " & CommentNum else sqlComment="select top 10 " end if sqlComment=sqlComment & " * from PhotoComment where PhotoID=" & PhotoID & " order by CommentID desc" Set rsComment= Server.CreateObject("ADODB.Recordset") rsComment.open sqlComment,conn,1,1 if rsComment.bof and rsComment.eof then response.write " 没有任何评论" else response.write "
| "
if rsComment("UserType")=1 then
response.write " | 评分："&rsComment("Score")&"分 |
| "
response.write " " & rsComment("Content") & " " if rsComment("ReplyContent")<>"" then response.write " ★ 管理员『" & rsComment("ReplyName") & "』于 " & rsComment("ReplyTime") & " 回复道： " & rsComment("ReplyContent") & " " end if response.write " | |
| " response.write "查看关于此文章的所有评论" response.write " | |