" end if end sub function CheckUserLogined() dim Logined,Password,rsLogin,sqlLogin Logined=True UserName=request.cookies("asp1632")("UserName") Password=request.cookies("asp1632")("Password") UserLevel=request.cookies("asp1632")("UserLevel") if UserName="" then Logined=False end if if Password="" then Logined=False end if if UserLevel="" then Logined=False UserLevel=9999 end if if Logined=True then username=replace(trim(username),"'","") password=replace(trim(password),"'","") UserLevel=Cint(trim(UserLevel)) set rsLogin=server.createobject("adodb.recordset") sqlLogin="select * from " & db_User_Table & " where " & db_User_LockUser & "=0 and " & db_User_Name & "='" & username & "' and " & db_User_Password & "='" & password &"'" rsLogin.open sqlLogin,Conn_User,1,1 if rsLogin.bof and rsLogin.eof then Logined=False else if password<>rsLogin(db_User_Password) or UserLevel
| " if ShowTotal=true then strTemp=strTemp & "共 " & totalnumber & " " & strUnit & " " end if strUrl=JoinChar(sfilename) if CurrentPage<2 then strTemp=strTemp & "首页 上一页 " else strTemp=strTemp & "首页 " strTemp=strTemp & "上一页 " end if if n-currentpage<1 then strTemp=strTemp & "下一页 尾页" else strTemp=strTemp & "下一页 " strTemp=strTemp & "尾页" end if strTemp=strTemp & " 页次：" & CurrentPage & "/" & n & "页 " strTemp=strTemp & " " & maxperpage & "" & strUnit & "/页" if ShowAllPages=True then strTemp=strTemp & " 转到：" end if strTemp=strTemp & " |
![](" & rsAD("ImgUrl") & ")
0 then AD = AD & " width='" & rsAD("ImgWidth") & "'"
if rsAD("ImgHeight")>0 then AD = AD & " height='" & rsAD("ImgHeight") & "'"
AD = AD & " border='0'>"
end if
if ADtype=0 then
if session("PopAD"&rsAD("ID")&ChannelID)<>True then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
popleft=arrsetting(0)
poptop=arrsetting(1)
end if
response.write ""
session("PopAD"&rsAD("ID")&ChannelID)=True
end if
elseif ADtype=1 then
response.write AD
exit do
elseif ADtype=2 then
response.write AD
exit do
elseif ADtype=3 then
response.write AD
exit do
elseif ADtype=4 then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
floatleft=arrsetting(0)
floattop=arrsetting(1)
end if
response.write "" & AD & "
"
call FloatAD()
exit do
elseif ADtype=5 then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
fixedleft=arrsetting(0)
fixedtop=arrsetting(1)
end if
response.write "" & AD & "
"
call FixedAD()
exit do
end if
rsAD.movenext
loop
end if
rsAD.close
set rsAD=nothing
end sub
sub ShowTopUser(UserNum)
if UserNum<=0 or UserNum>100 then UserNum=10
dim sqlTopUser,rsTopUser,i
sqlTopUser="select top " & UserNum & " * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc," & db_User_ID & " asc"
set rsTopUser=server.createobject("adodb.recordset")
rsTopUser.open sqlTopUser,Conn_User,1,1
if rsTopUser.bof and rsTopUser.eof then
response.write "没有任何用户"
else
response.write "| 名次 | 用户名 | 文章数 |
| " & cstr(i) & " | " & rsTopUser(db_User_Name) & " | " & rsTopUser(db_User_ArticleChecked) & " |
" end if loop end if end if rsChild.close set rsChild=nothing end sub sub ShowArticle(TitleLen) if TitleLen<0 or TitleLen>200 then TitleLen=50 end if sqlArticle=sqlArticle & "select A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Keyword,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType," sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.elite2,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl,A.filename,A.filepath from Article A" sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 " if SpecialID>0 then sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID end if if ClassId>0 then sqlArticle=sqlArticle & " and A.ClassID=" & ClassID end if sqlArticle=sqlArticle & " order by A.OnTop desc,A.ArticleID desc" Set rsArticle= Server.CreateObject("ADODB.Recordset") rsArticle.open sqlArticle,conn,1,1 'set rsArticle=conn.execute("RGetArticleList2 " & SpecialID & "," & ClassID) if rsArticle.bof and rsArticle.eof then totalput=0 response.Write("
"
end if
strTemp= strTemp & "" response.write strTemp rsArticle.movenext i=i+1 if i>=MaxPerPage then exit do loop end sub sub ShowPicArticle(intClassID,ArticleNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,Hot,elite2) dim sqlPic,i,tClass,trs,arrClassID sqlPic="select top 4 A.ArticleID,A.ClassID,A.Title,A.filepath,A.filename," sqlPic=sqlPic & " A.Hot,A.Passed,A.DefaultPicUrl from Article A" sqlPic=sqlPic & " where A.Deleted=0 and DefaultPicUrl<>''" if intClassID>0 then set tClass=conn.execute("select ClassID,Child,ParentPath from ArticleClass2 where ClassID=" & intClassID) if not(tClass.bof and tClass.eof) then if tClass(1)>0 then arrClassID=ClassID set trs=conn.execute("select ClassID from ArticleClass2 where ParentID=" & tClass(0) & " or ParentPath like '%" & tClass(2) & "," & tClass(0) & ",%' and Child=0") do while not trs.eof arrClassID=arrClassID & "," & trs(0) trs.movenext loop set trs=nothing sqlPic=sqlPic & " and A.ClassID in (" & arrClassID & ")" else sqlPic=sqlPic & " and A.ClassID=" & tClass(0) end if set trs=nothing else sqlPic=sqlPic & " and A.ClassID=" & tClass(0) end if set tClass=nothing end if sqlPic=sqlPic & " and A.Hits>=500" sqlPic=sqlPic & " order by A.ArticleID desc" set rsPic=Server.CreateObject("ADODB.Recordset") rsPic.open sqlPic,conn,1,1 strPic= "
 没有任何图片文章 | "
else
i=0
do while not rsPic.eof
strPic=strPic & "" call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight) strPic=strPic & " | " rsPic.movenext i=i+1 if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "
没有任何图片文章 | "
else
i=0
do while not rsPic.eof
strPic=strPic & "" call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight) strPic=strPic & " | " rsPic.movenext i=i+1 if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "
"
end if
strPic=strPic & "" & TitleStr & "" end sub %> <% '出国频道===》AbroadFunction.asp 'order by 固顶 时间 desc function gotTopic(str,strlen) if str="" then gotTopic="" exit function end if dim l,t,c, i str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<") l=len(str) t=0 for i=1 to l c=Abs(Asc(Mid(str,i,1))) if c>255 then t=t+2 else t=t+1 end if if t>=strlen then gotTopic=left(str,i) & "…" exit for else gotTopic=str end if next gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<") end function Function ShowNews(IClassID,RecordNum) '针对每个项目的新闻 IClassID = Replace(cint(IClassID),"'","") RecordNum = Replace(cint(RecordNum),"'","") If IClassID <> "" and RecordNum <> "" Then Set rsArticle2= Server.CreateObject("ADODB.Recordset") set tClass=Server.CreateObject("ADODB.Recordset") 'IClassID '显示文章列表的classid If ChildID <> "" Then ChildID= "" End if set tClass=conn.execute("select ClassID from ArticleClass2 where ParentID=" & IClassID ) do while not tClass.eof if ChildID="" then ChildID=tClass(0) else ChildID=ChildID & "," & tClass(0) end if tClass.movenext loop tClass.close arrClassID=ChildID sql="select top "&RecordNum&" A.ArticleID,A.ClassID,A.Title,A.UpdateTime," sql=sql & "A.Hits,A.OnTop,A.passed,A.filename,A.filepath,A.TitleFontColor,A.IncludePic from Article A" sql=sql & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 and A.ClassID " sql=sql & "in (" & arrClassID & ") order by A.OnTop desc,A.ArticleID desc,A.Hits desc" 'Response.Write(sql) rsArticle2.open sql,conn,1,1 if rsArticle2.bof and rsArticle2.eof then response.write arrClassID else do while not rsArticle2.eof strTemp1 = "
" & vbcrlf strErr=strErr & "
| 错误信息 |
| 产生错误的可能原因：" & errmsg &" |
| << 返回上一页 |
" & vbcrlf strSuccess=strSuccess & "
| 恭喜你！ |
" & SuccessMsg &" |
"
end if
end sub
sub ShowBanner()
if BannerUrl<>"" then
if lcase(right(BannerUrl,3))="swf" then
Response.Write ""
else
response.Write "没有通告
" else AnnounceCount=rsAnnounce.recordcount if ShowType=1 then do while not rsAnnounce.eof response.Write " " & rsAnnounce("title") & "" & rsAnnounce("Author") & "
" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "" rsAnnounce.movenext i=i+1 if i"
loop
else
do while not rsAnnounce.eof
response.Write " " & rsAnnounce("title") & " [" & rsAnnounce("Author") & " " & FormatDateTime(rsAnnounce("DateAndTime"),1) & "] "
rsAnnounce.movenext
loop
end if
end if
rsAnnounce.close
set rsAnnounce=nothing
end sub
sub ShowFriendSite(LinkType,SiteNum,Cols,ShowType)
dim sqlLink,rsLink,SiteCount,i,j,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=strLink & "" '新增代码
elseif ShowType=3 then
strLink=strLink & ""
end if
response.write strLink
if ShowType=1 then call RollFriendSite() '新增代码
rsLink.close
set rsLink=nothing
end sub
sub RollFriendSite()
%>
<%
end sub
sub ShowGoodSite(SiteNum)
dim sqlLink,rsLink,SiteCount,i,strLink
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
strLink=strLink & ""
set rsLink=conn.execute("RGetGoodSite")
if rsLink.bof and rsLink.eof then
for i=1 to SiteNum
strLink=strLink & "
"
response.write strLink
rsLink.close
set rsLink=nothing
end sub
sub Bottom()
dim strTemp
strTemp="
"
response.write strTemp
end sub
sub ShowUserLogin()
dim strLogin
if CheckUserLogined()=False then
strLogin="" & vbcrlf
strLogin=strLogin & "
" & vbcrlf
response.write strLogin
%>
<%
Else
response.write "欢迎您！" & UserName & "，好久不见！"
if ChargeType=1 then
if UserPoint>0 then
response.write ""
if UserPoint<=10 then
response.write "
" end if else response.write "" response.write "" end if else if ValidDays>0 then response.write "有效期
有效天数： " & ValidDays & " 天" if ValidDays<=10 then response.write "
你的有效期时间已不长，请及时联系我们进行充值！" end if else response.write "有效期
有效天数： " & ValidDays & " 天" response.write "
你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。" end if end if response.write "
用户控制面板：
" & vbcrlf response.write " 进社区求助" & vbcrlf response.write " 我的日记本
" & vbcrlf response.write " 主页投稿" & vbcrlf response.write " 投稿管理
" & vbcrlf response.write " 人才登录" & vbcrlf response.write " 语音聊天
" & vbcrlf response.write " 商城购物" & vbcrlf response.write " 我的订单
" & vbcrlf response.write " 个人信息" & vbcrlf response.write " 注销登录
" & vbcrlf dim MessagePOP MessagePop=1 response.write " 发短消息 " if Cint(newincept())>Cint(0) then response.write ""
if MessagePop=1 then%>
<%end if%>
收件箱
(<%=newincept()%>)
<% else %>
收件箱 (0)
<%
end if
response.write "
" end if end sub sub ShowTopUser(UserNum) if UserNum<=0 or UserNum>100 then UserNum=10 dim sqlTopUser,rsTopUser,i sqlTopUser="select top " & UserNum & " * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc," & db_User_ID & " asc" set rsTopUser=server.createobject("adodb.recordset") rsTopUser.open sqlTopUser,Conn_User,1,1 if rsTopUser.bof and rsTopUser.eof then response.write "没有任何用户" else response.write "
"
end if
set rsTopUser=nothing
end sub
sub ShowAllUser()
select case OrderType
case 1
sqlUser="select top 500 * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc"
case 2
sqlUser="select top 500 * from " & db_User_Table & " order by " & db_User_RegDate & " desc"
case 3
sqlUser="select top 500 * from " & db_User_Table & " order by " & db_User_ID & " desc"
case 4
sqlUser="select top 500 * from " & db_User_Table & " order by diaryNum desc"
case 5
sqlUser="select top 500 * from " & db_User_Table & " order by diaryVisit desc"
end select
set rsUser=server.createobject("adodb.recordset")
rsUser.open sqlUser,Conn_User,1,1
if rsUser.bof and rsUser.eof then
totalput=0
response.write "
没有任何用户 "
else
totalput=rsUser.recordcount
if currentPage=1 then
call ShowUserList()
else
if (currentPage-1)*MaxPerPage（点击用户名可查看该用户文集，点击用户日记数可查看该用户的公开日记）
"
response.write ""
response.write "" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "" rsAnnounce.movenext i=i+1 if i
"
elseif ShowType=3 then
strLink=strLink & "
 |
"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & " "
else
strLink=strLink & " |
|
| " strTemp= strTemp & "| 设"&"为"&"首"&"页 | " strTemp= strTemp & "加"&"入"&"收"&"藏 | " strTemp= strTemp & "联"&"系"&"站"&"长 | " strTemp= strTemp & "友"&"情"&"链"&"接 | " strTemp= strTemp & "版"&"权"&"申"&"明 | " strTemp= strTemp & "管"&"理"&"登"&"录 | " strTemp= strTemp & " |
| "
strTemp= strTemp & Copyright
strTemp= strTemp & " 站长：" & WebmasterName & ""
if ShowRunTime="Yes" then
strTemp= strTemp & " 页"&"面"&"执"&"行"&"时"&"间：" & CStr(FormatNumber((Timer-BeginTime)*1000,2)) & "毫秒"
end if
strTemp= strTemp & " " strTemp= strTemp & " |
" end if else response.write "" response.write "" end if else if ValidDays>0 then response.write "有效期
有效天数： " & ValidDays & " 天" if ValidDays<=10 then response.write "
你的有效期时间已不长，请及时联系我们进行充值！" end if else response.write "有效期
有效天数： " & ValidDays & " 天" response.write "
你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。" end if end if response.write "
用户控制面板：
" & vbcrlf response.write " 进社区求助" & vbcrlf response.write " 我的日记本
" & vbcrlf response.write " 主页投稿" & vbcrlf response.write " 投稿管理
" & vbcrlf response.write " 人才登录" & vbcrlf response.write " 语音聊天
" & vbcrlf response.write " 商城购物" & vbcrlf response.write " 我的订单
" & vbcrlf response.write " 个人信息" & vbcrlf response.write " 注销登录
" & vbcrlf dim MessagePOP MessagePop=1 response.write " 发短消息 " if Cint(newincept())>Cint(0) then response.write "
" end if end sub sub ShowTopUser(UserNum) if UserNum<=0 or UserNum>100 then UserNum=10 dim sqlTopUser,rsTopUser,i sqlTopUser="select top " & UserNum & " * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc," & db_User_ID & " asc" set rsTopUser=server.createobject("adodb.recordset") rsTopUser.open sqlTopUser,Conn_User,1,1 if rsTopUser.bof and rsTopUser.eof then response.write "没有任何用户" else response.write "
| 名次 | 用户名 | 文章数 |
| " & cstr(i) & " | " & rsTopUser(db_User_Name) & " | " & rsTopUser(db_User_ArticleChecked) & " |
| 用户名 | 性别 | 注册日期 | 文章数 | 日记数 | 日记访问量 | ||||||||
| 用户名 | 性别 | 注册日期 | 文章数 | ||||||
| " & rsUser(db_User_Name) & " | " if rsUser(db_User_Sex)="1" then response.write "男" else response.write "女" end if 'response.write " | " & rsUser(db_User_id) & " | " response.write " | " 'if rsUser(db_User_id)<>"" then 'response.write rsUser(db_User_id) 'else 'response.write "未填" 'end if 'response.write "" 'skying 2006_updateBBs Begin 'if rsUser(db_User_Msn)<>"" then ' response.write rsUser(db_User_Msn) 'else ' response.write "未填" 'end if 'response.write " | " 'if rsUser(db_User_Homepage)<>"" and rsUser(db_User_Homepage)<>"http://" then ' response.write "点此访问" 'else ' response.write "未填" 'end if 'skying 2006_updateBBs End response.write " | " & FormatDateTime(rsUser(db_User_RegDate),2) & " | " & rsUser(db_User_ArticleChecked) & " | " response.write "" & rsUser("diaryNum") & " | " & rsUser("diaryVisit") & " |
" rsGuest.movenext Loop end if rsGuest.close set rsGuest=nothing end sub sub ShowAD(ADType) dim sqlAD,rsAD,AD,arrSetting,popleft,poptop,floatleft,floattop,fixedleft,fixedtop 'sqlAD="select * from Advertisement2 where IsSelected=1" 'sqlAD=sqlAD & " and (ChannelID=0 or ChannelID=" & ChannelID & ")" 'sqlAD=sqlAD & " and ADType=" & ADtype & " order by ID Desc" 'set rsAD=server.createobject("adodb.recordset") 'rsAD.open sqlAD,conn,1,1 set rsAD=conn.execute("RGetADList " & ChannelID & "," & ADType) if not rsAd.bof and not rsAD.eof then do while not rsAD.eof if rsAD("isflash")=true then AD= "" else AD ="
0 then AD = AD & " width='" & rsAD("ImgWidth") & "'"
if rsAD("ImgHeight")>0 then AD = AD & " height='" & rsAD("ImgHeight") & "'"
AD = AD & " border='0'>"
end if
if ADtype=0 then
if session("PopAD"&rsAD("ID")&ChannelID)<>True then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
popleft=arrsetting(0)
poptop=arrsetting(1)
end if
response.write ""
session("PopAD"&rsAD("ID")&ChannelID)=True
end if
elseif ADtype=1 then
response.write AD
exit do
elseif ADtype=2 then
response.write AD
exit do
elseif ADtype=3 then
response.write AD
exit do
elseif ADtype=4 then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
floatleft=arrsetting(0)
floattop=arrsetting(1)
end if
response.write "" & AD & "
"
call FloatAD()
exit do
elseif ADtype=5 then
if instr(rsAD("ADSetting"),"|")>0 then
arrSetting=split(rsAD("ADSetting"),"|")
fixedleft=arrsetting(0)
fixedtop=arrsetting(1)
end if
response.write "" & AD & "
"
call FixedAD()
exit do
end if
rsAD.movenext
loop
end if
rsAD.close
set rsAD=nothing
end sub
sub FloatAD()
%>
<%
end sub
sub FixedAD()
%>
<%
end sub
sub FixedAD1()
%>
<%
end sub
'=================================================
'过程名：WriteToHtml(Fpath,Templet)
'作 用：生成JS文件
'参 数：Fpath ----JS文件名及路径
' Templet ----要生成文件的内容
'=================================================
sub WriteToHtml(Fpath,Templet)
dim fs,f
Set fs = CreateObject("Scripting.FileSystemObjectfl")
Set f = fs.CreateTextFile(Server.MapPath(Fpath), True)
f.write(Templet)
f.close
Set f = nothing
Set fs = nothing
Response.Write "" end sub '================================================= '过程名：delHtml(Fpath) '作 用：删除文件 '参 数：Fpath ----JS文件名及路径 '================================================= sub delHtml(Fpath) dim i Set fs = CreateObject("Scripting.FileSystemObjectfl") if fs.FileExists(server.mappath(fpath&".htm")) then fs.deletefile(server.mappath(fpath&".htm")) for i=2 to 20 if fs.FileExists(server.mappath(fpath&"-"&i&".htm")) then fs.deletefile(server.mappath(fpath&"-"&i&".htm")) Response.Write "
" else exit for end if next Response.Write "
" else response.write "
" end if Set fs = nothing end sub sub opentemple(whichfile) dim thisfile whichfile=server.mappath(whichfile) Set fs = CreateObject("Scripting.FileSystemObjectfl") Set thisfile = fs.OpenTextFile(whichfile, 1, False) toptemplet=thisfile.readall thisfile.Close set fs=nothing end sub %> <% sub Admin_ShowRootClass() dim sqlRoot,rsRoot sqlRoot="select ClassID,ClassName,RootID,Child From ArticleClass2 where ParentID=0 and LinkUrl='' order by RootID" Set rsRoot= Server.CreateObject("ADODB.Recordset") rsRoot.open sqlRoot,conn,1,1 if rsRoot.bof and rsRoot.eof then response.Write("还没有任何栏目，请首先添加栏目。") else response.write "| " do while not rsRoot.eof if rsRoot(2)=RootID then response.Write("" & rsRoot(1) & " | ") tID=rsRoot(0) tChild=rsRoot(3) else response.Write("" & rsRoot(1) & " | ") end if rsRoot.movenext loop end if rsRoot.close set rsRoot=nothing end sub sub Admin_ShowClass_Option(ShowType,CurrentID) if ShowType=0 then response.write "" end if dim rsClass,sqlClass,strTemp,tmpDepth,i dim arrShowLine(20) for i=0 to ubound(arrShowLine) arrShowLine(i)=False next sqlClass="Select * From ArticleClass2 order by RootID,OrderID" set rsClass=server.CreateObject("adodb.recordset") rsClass.open sqlClass,conn,1,1 if rsClass.bof and rsClass.bof then response.write "" else dim UserLevel UserLevel=request.cookies("asp1632")("UserLevel") if UserLevel="" then UserLevel=5000 else UserLevel=Cint(UserLevel) end if do while not rsClass.eof tmpDepth=rsClass("Depth") if rsClass("NextID")>0 then arrShowLine(tmpDepth)=True else arrShowLine(tmpDepth)=False end if if ShowType=1 then if rsClass("LinkUrl")<>"" then strTemp="