<% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// 作者: 朱煊(zx.asd)&(sipo)&(月上之木) '// 版权所有: RainbowSoft Studio '// 技术支持: rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_system_wap.asp '// 开始时间: 2006-03-19 '// 最后修改: 2011-08-03 '// 备注: WAP函数模块 '/////////////////////////////////////////////////////////////////////////////// '********************************************************* ' 目的: 主页 '********************************************************* Function WapMain() '列表页模板暂不考虑 Response.Write WapExport(Request("page"),Request("cate"),Request("auth"),Request("date"),Request("tags"),ZC_DISPLAY_MODE_ALL) Response.Write WapExportBar(Request("page"),intPageCount,Request("cate"),Request("auth"),Request("date"),Request("tags"),Request("q")) WapNav() End Function '********************************************************* ' 目的: 搜索 '********************************************************* Function WapSearch() Response.Write WapExport(Request("page"),Request("cate"),Request("auth"),Request("date"),Request("tags"),ZC_DISPLAY_MODE_SEARCH) Response.Write WapExportBar(Request("page"),intPageCount,Request("cate"),Request("auth"),Request("date"),Request("tags"),Request("q")) WapNav() End Function '********************************************************* ' 目的: 底部导航 '********************************************************* Function WapNav() Response.Write "

" Response.Write "

" If BlogUser.Level>3 Then Response.Write ""&ZC_MSG009&"|" End If Response.Write ""&ZC_MSG027&"|" ' Response.Write "

" If Not ZC_DISPLAY_CATE_ALL_WAP Then Response.Write ""&ZC_MSG214&"|" End If ' Response.Write "

7 "&ZC_MSG029&"

" If BlogUser.Level<=3 Then Response.Write ""&ZC_MSG168&"|" End If ' Response.Write "

9 "&ZC_MSG213&"

" Response.Write "电脑版" Response.Write "

" &WapCheckLogin Response.Write "

" End Function '********************************************************* ' 目的: 查看分类 '********************************************************* Function WapCate() Dim Category Response.Write WapTitle(ZC_MSG214,"") Response.Write "

"&Category.ID&"."&TransferHTML(Category.Name,"[html-format]")&"("&Category.Count&")

" WapNav() End Function '********************************************************* ' 目的: 最新发表 '********************************************************* Function WapPrev() Response.Write WapTitle(ZC_MSG032,"") Response.Write "

" & LoadFromFile(BlogPath & "/INCLUDE/previous.asp","utf-8") & "" WapNav() End Function '********************************************************* ' 目的: 查看站点统计 '********************************************************* Function WapStat() Response.Write WapTitle(ZC_MSG026,"") Response.Write "

" & LoadFromFile(BlogPath & "/INCLUDE/statistics.asp","utf-8") & "" WapNav() End Function '********************************************************* ' 目的: 查看标题-页头 '********************************************************* Public Function WapTitle(strCom,strBrowserTitle) If strBrowserTitle="" Then strBrowserTitle=strCom WapTitle = "" &strBrowserTitle& ""&vbCrLf WapTitle = WapTitle & ""&vbCrLf WapTitle = WapTitle & ""&vbCrLf WapTitle = WapTitle & "

"&ZC_BLOG_TITLE&"

" If ZC_DISPLAY_CATE_ALL_WAP Then Dim Category WapTitle = WapTitle & "

" WapTitle = WapTitle & ""&ZC_MSG213&"|" Categorys(0).Count=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Article] WHERE [log_Level]>1 AND [log_Type]=0 AND [log_CateID]=0")(0) For Each Category in Categorys If IsObject(Category) Then If Category.Count>0 Then WapTitle = WapTitle & ""&TransferHTML(Category.Name,"[html-format]")&"|" End If End If Next WapTitle = Left(WapTitle, Len(WapTitle)-8) & "

" End If If IsEmpty(Request.QueryString("act")) Then WapTitle = WapTitle & "" End If If strCom<>"" Then WapTitle = WapTitle & "

"&strCom&"

" End Function '********************************************************* ' 目的: Wap页面地址 '********************************************************* Function WapUrlStr() WapUrlStr=BlogHost&ZC_FILENAME_WAP End Function '********************************************************* ' 目的: 登录页面 '********************************************************* Function WapLogin() Dim u,p u=Request.Form("username") p=Request.Form("password") Call CheckParameter(u,"sql",Empty) Call CheckParameter(p,"sql",Empty) BlogUser.LoginType="Self" BlogUser.Name=u BlogUser.PassWord=BlogUser.GetPasswordByMD5(md5(p)) If IsEmpty(u) OR IsEmpty(p) Then If Request.Form("sig")=1 Then Response.Write WapTitle(ZC_MSG010,ZC_MSG009) Else Response.Write WapTitle(ZC_MSG009,"") End If Response.Write " " Else Response.Cookies("username")=escape(u) Response.Cookies("username").Expires=Date+30 Response.Cookies("username").Path = "/" If BlogUser.Verify=False Then Call ShowError(8) Else Response.Cookies("password")=BlogUser.PassWord Response.Cookies("password").Expires=Date+30 Response.Cookies("password").Path = "/" Response.Write WapMain() End If End If End Function '********************************************************* ' 目的: 检查登录 '********************************************************* Function WapCheckLogin() Dim s BlogUser.LoginType="Cookies" BlogUser.Verify s=BlogUser.FirstName&" "&ZVA_User_Level_Name(BlogUser.Level)&"" If BlogUser.ID<>0 Then s=s&" "&ZC_MSG020&"" Else s="" End If If s<>"" Then WapCheckLogin=s Else WapCheckLogin="" End If End Function '********************************************************* ' 目的: 退出登录 '********************************************************* Function WapLogout() Response.Cookies("username")="" Response.Cookies("password")="" Response.Cookies("username")=Empty Response.Cookies("password")=Empty Response.Cookies("username").expires = now-1 Response.Cookies("password").expires = now-1 Response.Write WapTitle(ZC_MSG020,"") Response.Redirect Request.ServerVariables("Http_Referer") End Function '********************************************************* ' 目的: 版权声明 '********************************************************* Function WapCopyRight() WapCopyRight=vbsunescape(Request.Cookies("username")) End Function '********************************************************* ' 目的: 删除文章 '********************************************************* Function WapDelArt() Dim ID,T ID=Request.QueryString("id") T=Request.QueryString("t") Response.Write WapTitle(ZC_MSG063&ZC_MSG048&" › "&T,"") '检查非法链接 Call CheckReference("") '检查权限 If Not CheckRights("ArticleDel") Then Call ShowError(6) '加入确认 If Request.QueryString("con")="Y" Then If DelArticle(Request.QueryString("id")) Then Call MakeBlogReBuild_Core() Response.Write "

"&ZC_MSG266&"

" Response.Write "

"&ZC_MSG213&"

" End if Else Dim strYUrl strYUrl=WapUrlStr &"?act=DelArt&id="&ID&"&con=Y" Response.Write "

确定 | 取消

" End If End Function '********************************************************* ' 目的: 删除评论 '********************************************************* Function WapDelCom() Dim ID,LOG_ID ID=Request.QueryString("id") LOG_ID=Request.QueryString("log_id") Response.Write WapTitle(ZC_MSG063&ZC_MSG013,"") '检查非法链接 Call CheckReference("") '检查权限 If Not CheckRights("CommentDel") Then Call ShowError(6) '加入确认 If Request.QueryString("con")="Y" Then Call DelComment(ID,LOG_ID) ' Call MakeBlogReBuild_Core() Dim strUrl strUrl=WapUrlStr &"?act=Com&id="&log_id Response.Write "

"&ZC_MSG266&"

" Response.Write "

"&ZC_MSG065&"

" Else Dim strYUrl strYUrl=WapUrlStr &"?act=DelCom&id="&ID&"&log_id="&LOG_ID&"&con=Y" Response.Write "

确定 | 取消

" End If End Function '********************************************************* ' 目的: 新建文章（编辑） '********************************************************* Function WapEdtArt() Dim Log_ID Log_ID=Request.QueryString("id") '检查非法链接 Call CheckReference("") '检查权限 If Not CheckRights("ArticleEdt") Then Call ShowError(6) Dim IsPage Dim IsAutoIntro Dim EditArticle ' If log_ID<>0 Then ' Set EditArticle=New TArticle ' EditArticle.LoadInfoByID(log_ID) ' End If Set EditArticle=New TArticle If Not IsEmpty(Request.QueryString("id")) Then If EditArticle.LoadInfobyID(Request.QueryString("id")) Then If EditArticle.AuthorID<>BlogUser.ID Then If CheckRights("Root")=False Then Call ShowError(6) End If End If ' If EditArticle.FType=ZC_POST_TYPE_PAGE Then IsPage=True If InStr(EditArticle.Content,EditArticle.Intro)>0 Then EditArticle.Intro="" Else Call ShowError(9) End If Response.Write WapTitle(ZC_MSG047,"") Else EditArticle.AuthorID=BlogUser.ID ' If IsPage=True THen EditArticle.FType=ZC_POST_TYPE_PAGE Response.Write WapTitle(ZC_MSG168,"") End If ' BlogTitle=EditArticle.HtmlUrl EditArticle.Content=UBBCode(EditArticle.Content,"[link][email][font][code][face][image][flash][typeset][media][autolink][key][link-antispam]") EditArticle.Title=UBBCode(EditArticle.Title,"[link][email][font][code][face][image][flash][typeset][media][autolink][key][link-antispam]") ' If InStr(EditArticle.Content,EditArticle.Intro)>0 Then IsAutoIntro=True ' If Len(EditArticle.Intro)="" Then IsAutoIntro=True EditArticle.Content=TransferHTML(Replace(EditArticle.Content,"",vbCrLf&"

"&vbCrLf ),"[html-japan]") EditArticle.Title=TransferHTML(EditArticle.Title,"[html-format]") Response.Write "

" Response.Write "" 'author Response.Write "" 'template Response.Write "" 'title Response.Write "

"&ZC_MSG060&" :

" 'alias Response.Write "

"&ZC_MSG147&" :

" 'tags Response.Write "

"&ZC_MSG138&":

" 'cate Response.Write "

"&ZC_MSG012&": " 'level Response.Write "

" 'upload Response.Write "" 'istop Response.Write "

"&ZC_MSG051&" : " If EditArticle.Istop Then Response.Write "" Else Response.Write "

" End If Response.Write "" Response.Write "

"&ZC_MSG055&" :
" Response.Write ""&EditArticle.Content&"

" Dim idis:idis="block" If Len(EditArticle.Intro)=0 Then idis="none" Response.Write "

"&ZC_MSG016&" :
" Response.Write ""&EditArticle.Intro&"

" Response.Write "

" End Function '********************************************************* ' 目的: 文章发表 '********************************************************* Function WapPostArt() If PostArticle() Then Response.Write "

"&ZC_MSG266&"

" Call MakeBlogReBuild_Core() End If Response.Redirect WapUrlStr End Function '********************************************************* ' 目的: 添加评论（编辑） '********************************************************* Function WapAddCom(PostType) If ZC_WAPCOMMENT_ENABLE=False Then Call ShowError(40): Exit Function Dim log_ID,par_ID,Author,Content,Email,HomePage log_ID=Request.QueryString("inpid") Call CheckParameter(log_ID,"int",0) par_ID=Request.QueryString("parid") Call CheckParameter(par_ID,"int",0) If Request.Cookies("chkRemember")="true" Then Author=unescape(Request.Cookies("username")) Email=Request.Cookies("inpEmail") HomePage=Request.Cookies("inpHomePage") End If If log_ID=0 Then Call ShowError(3): Exit Function Dim Article If log_ID<>0 Then Set Article=New TArticle If Article.LoadInfoByID(log_ID) Then If Article.Level=1 Then Response.Write WapTitle(ZVA_Article_Level_Name(1),"")&ZVA_ErrorMsg(9):Exit Function If Article.Level=2 Then If Not CheckRights("Root") Then If (Article.AuthorID<>BlogUser.ID) Then Response.Write WapTitle(ZVA_Article_Level_Name(2),"")&ZVA_ErrorMsg(6):Exit Function End If End If End If End If Response.Write WapTitle(Article.Title &" › "& ZC_MSG024,"") Set Article=Nothing If PostType<>0 Then Response.Write "

"&ZVA_ErrorMsg(PostType)&"

" End If Response.Write "

" '添加回复 If par_ID<>0 Then Dim objComment Set objComment=New TComment If objComment.LoadInfoByID(par_ID) Then Dim User,s s = objComment.Author GetUser() For Each User in Users If IsObject(User) Then If User.ID<>0 And User.ID=objComment.AuthorID Then s = User.FirstName Exit For End If End If Next Response.Write "

"&ZC_MSG149&": "&s&""&ZC_MSG264&"

" Response.Write " " End If Set objComment=Nothing End If If (PostType<>31) And (BlogUser.Level<=3) Then Response.Write "

"&ZC_MSG001&": "&BlogUser.FirstName&"

" Response.Write " " Response.Write " " Else Response.Write "

"&ZC_MSG001&":

" If PostType=6 Then Response.Write "

"&ZC_MSG002&":

" End If If Request("m")="y" Then Response.Write "

"&ZC_MSG053&":

" Response.Write "

网站:

" Else Response.Write "

更多选项

" End If End If Response.Write "

" Response.Write "

"&ZC_MSG065&"

" Response.Write "

" End Function '********************************************************* ' 目的: 评论发表 2012.9.4 '********************************************************* Function WapPostCom() If ZC_WAPCOMMENT_ENABLE=False Then Call ShowError(40): Exit Function Call GetUser() 'PostComment(strKey,intRevertCommentID) Dim objComment Dim objArticle Set objComment=New TComment Set objArticle=New TArticle objComment.log_ID=Request.QueryString("inpid") objComment.AuthorID=BlogUser.ID '添加回复 objComment.ParentID=Request.Form("parid") Call CheckParameter(objComment.ParentID,"int",0) objComment.Author=Request.Form("inpName") objComment.Content=Request.Form("txaArticle") objComment.Email=Request.Form("inpEmail") objComment.HomePage=Request.Form("inpHomePage") If Not CheckRegExp(objComment.Author,"[username]") Then Call WapAddCom(15) :Exit Function IF Len(objComment.Content)=0 Or Len(objComment.Content)>ZC_CONTENT_MAX Then Call WapAddCom(46) :Exit Function End If IF Len(objComment.Email)>0 Then If Not CheckRegExp(objComment.Email,"[email]") Then Call WapAddCom(29) Exit Function End If End If IF Len(objComment.HomePage)>0 Then If InStr(objComment.HomePage,"http")=0 Then objComment.HomePage="http://" & objComment.HomePage If Not CheckRegExp(objComment.HomePage,"[homepage]") Then Call WapAddCom(30) :Exit Function End If If Request.Cookies("chkRemember")="true" Then Response.Cookies("username")=escape(Request.Form("inpName")) Response.Cookies("username").Expires=Date+30 Response.Cookies("inpHomePage")=objComment.HomePage Response.Cookies("inpEmail")=objComment.Email If Not IsEmpty(Request.Form("inpPass")) Then Response.Cookies("password")=BlogUser.GetPasswordByMD5(md5(Request.Form("inpPass"))) Response.Cookies("password").Expires=Date+30 Call WapCheckLogin End If End If '接口 Call Filter_Plugin_PostComment_Core(objComment) If objComment.IsThrow=True Then Call ShowError(14) If objComment.AuthorID>0 Then objComment.Author =Users(objComment.AuthorID).Name objComment.EMail =Users(objComment.AuthorID).Email objComment.HomePage=Users(objComment.AuthorID).HomePage End If Dim objUser For Each objUser in Users If IsObject(objUser) Then If (UCase(objUser.Name)=UCase(objComment.Author)) And (objUser.ID<>objComment.AuthorID) Then WapAddCom(31) End If Next If objComment.Post Then If objArticle.LoadInfoByID(objComment.log_ID) Then Call BuildArticle(objArticle.ID,False,False) BlogReBuild_Comments Call BlogReBuild_Default WapPostCom=True '接口 Call Filter_Plugin_PostComment_Succeed(objComment) End If End if Response.Write WapTitle(ZC_MSG024,"")&"

"&ZC_MSG266&"

" Response.Write ""&ZC_MSG065&ZC_MSG048&"" Response.Redirect WapUrlStr &"?act=Com&id="&objComment.log_ID ' Response.Write " | "&ZC_MSG212&"" Set objComment=Nothing End Function '********************************************************* ' 目的: 查看评论 2012.10.6 '********************************************************* Function WapCom() Dim i,s,rs,CurrentPage,log_ID CurrentPage=Request.QueryString("page") log_ID=Request.QueryString("id") Call CheckParameter(CurrentPage,"int",1) Call CheckParameter(log_ID,"int",0) Dim Article,User If log_ID<>0 Then Set Article=New TArticle If Article.LoadInfoByID(log_ID) Then If Article.Level=1 Then Response.Write WapTitle(ZVA_Article_Level_Name(1),"")&ZVA_ErrorMsg(9):Exit Function If Article.Level=2 Then If Not CheckRights("Root") Then If (Article.AuthorID<>BlogUser.ID) Then Response.Write WapTitle(ZVA_Article_Level_Name(2),"")&ZVA_ErrorMsg(6):Exit Function End If End If End If End If Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn If log_ID=0 Then objRS.Source="SELECT blog_Comment.* , blog_Article.log_ID, blog_Article.log_Title FROM blog_Comment INNER JOIN blog_Article ON blog_Comment.log_ID = blog_Article.log_ID WHERE blog_Comment.comm_IsCheck=0 ORDER BY blog_Comment.comm_PostTime DESC" Response.Write WapTitle(ZC_MSG027,"") Else objRS.Source="SELECT blog_Comment.* , blog_Article.log_ID, blog_Article.log_Title FROM blog_Comment INNER JOIN blog_Article ON blog_Comment.log_ID = blog_Article.log_ID WHERE (blog_Comment.comm_IsCheck=0 AND blog_Comment.log_ID="&log_ID&") ORDER BY blog_Comment.comm_PostTime DESC" ' Response.Write WapTitle(""& Article.title &"›"&ZC_MSG013) Response.Write WapTitle(Article.title&"›"&ZC_MSG013,"") End If objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then Response.Write "

"&s&"

"& ZC_MSG256 If ZC_WAPCOMMENT_ENABLE Then Response.Write " | "&ZC_MSG024&"

"&i&"

下一页 | " End If PageBar=PageBar&"上一页 | "&CurrentPage&"/"&intPageCount ElseIf (CurrentPage mod intPageCount)<>0 Then If PageBar<>"" Then PageBar=PageBar&" | " PageBar=PageBar&"下一页 | "&CurrentPage&"/"&intPageCount Else PageBar="" End If End If strC=strC&"

"&PageBar&"

" If log_ID<>0 Then strC=strC&"

"&ZC_MSG024&"

" Response.Write strC WapNav() End Function '********************************************************* ' 目的: 查看文章 '********************************************************* Function WapView() Dim Article,ZC_SINGLE_START,CurrentPage,i,log_ID CurrentPage=Request.QueryString("page") log_ID=Request.QueryString("id") Call CheckParameter(CurrentPage,"int",1) Call CheckParameter(log_ID,"int",0) If log_ID=0 Then Call ShowError(3) : Exit Function Set Article=New TArticle If Article.LoadInfoByID(log_ID) Then Article.Template="WAP_SINGLE" If Article.Level=1 Then Response.Write WapTitle(ZVA_Article_Level_Name(1),"")&ZVA_ErrorMsg(9):Exit Function If Article.Level=2 Then If Not CheckRights("Root") Then If (Article.AuthorID<>BlogUser.ID) Then Response.Write WapTitle(ZVA_Article_Level_Name(2),"")&ZVA_ErrorMsg(6):Exit Function End If End If Response.Write WapTitle(Article.Title,"") Dim ArticleContent,PageCount,PageBar ArticleContent=Article.Content If ZC_DISPLAY_MODE_ALL_WAP Then ArticleContent=TransferHTML(UBBCode(ArticleContent,"[face][link][autolink][font][code][image][typeset][media][flash][key][upload]"),"[html-japan][vbCrlf][upload]") ArticleContent=TransferHTML(ArticleContent,"[closehtml]") Else PageCount = Int(Len(ArticleContent)/ZC_SINGLE_SIZE_WAP) + 1 ZC_SINGLE_START=CLng((CurrentPage-1)*ZC_SINGLE_SIZE_WAP+1) If ZC_SINGLE_START<1 Then ZC_SINGLE_START=1 ArticleContent=TransferHTML(ArticleContent,"[html-format][wapnohtml][nbsp-br]") ArticleContent=Mid(ArticleContent,ZC_SINGLE_START,ZC_SINGLE_SIZE_WAP) ArticleContent=TransferHTML(ArticleContent,"[closehtml]") If CurrentPage>1 Then PageBar="«上一页" If CurrentPage下一页»" End IF ElseIf CurrentPage"" Then PageBar=PageBar&" | " PageBar=PageBar&"下一页»" Else PageBar="" End If ArticleContent=ArticleContent&"

"&PageBar&"

" End If If Article.Export(ZC_DISPLAY_MODE_ALL) Then Article.Build Article.html=Replace(Article.html,"<#article/pagecontent#>",ArticleContent) Article.html=Replace(Article.html,"<#ZC_FILENAME_WAP#>",WapUrlStr) Article.html=Replace(Article.html,"<#article/wapmutuality#>",WapRelateList(Article.ID,Article.Tag)) If BlogUser.Level<=3 Then Article.html=Replace(Article.html,"<#adbegin#>","") Article.html=Replace(Article.html,"<#adend#>","") Else Dim objRegExp Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="<#adbegin#>([\s\S]*)<#adend#>" Article.html= objRegExp.Replace(Article.html,"") End If Response.Write Article.html End If End If End Function '********************************************************* ' 目的: 相关文章 '********************************************************* Function WapRelateList(intID,Tag) If (intID=0) Or ZC_WAP_MUTUALITY_LIMIT=0 Then Exit Function If Tag<>"" Then Dim strCC_Count,strCC_ID,strCC_Name,strCC_Url,strCC_PostTime,strCC_Title Dim strCC Dim i Dim j Dim objRS Dim strSQL Dim strWapMutuality strWapMutuality = GetTemplate("TEMPLATE_WAP_ARTICLE_MUTUALITY") ' Call Add_Action_Plugin("Action_Plugin_System_Initialize","Call Wap_addMutualityTemplate()") Dim strOutput strOutput="" Set objRS=Server.CreateObject("ADODB.Recordset") strSQL="SELECT TOP "& ZC_WAP_MUTUALITY_LIMIT &" [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop],[log_Template],[log_FullUrl],[log_Type],[log_Meta] FROM [blog_Article] WHERE ([log_Type]=0) And ([log_Level]>2) AND [log_ID]<>"& intID strSQL = strSQL & " AND (" Dim aryTAGs,s s=Replace(Tag,"}","") aryTAGs=Split(s,"{") For j = LBound(aryTAGs) To UBound(aryTAGs) If aryTAGs(j)<>"" Then strSQL = strSQL & "([log_Tag] Like '%{"&FilterSQL(aryTAGs(j))&"}%')" If j=UBound(aryTAGs) Then Exit For If aryTAGs(j)<>"" Then strSQL = strSQL & " OR " End If Next strSQL = strSQL & ")" strSQL = strSQL + " ORDER BY [log_PostTime] DESC " Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source=strSQL objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then Dim objArticle For i=1 To ZC_WAP_MUTUALITY_LIMIT '相关文章数目 Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13),objRS(14),objRS(15),objRS(16),objRS(17))) Then strCC_Count=strCC_Count+1 strCC_ID=objArticle.ID strCC_Url=objArticle.Url strCC_PostTime=objArticle.PostTime strCC_Title=objArticle.Title strCC=strWapMutuality strCC=Replace(strCC,"<#article/mutuality/id#>",strCC_ID) strCC=Replace(strCC,"<#article/mutuality/posttime#>",strCC_PostTime) strCC=Replace(strCC,"<#article/mutuality/name#>",strCC_Title) strCC=Replace(strCC,"<#ZC_FILENAME_WAP#>",WapUrlStr) strOutput=strOutput & strCC End If Set objArticle=nothing objRS.MoveNext If objRS.eof Then Exit For Next End if objRS.Close() Set objRS=Nothing End If WapRelateList= strOutput End Function '********************************************************* ' 目的: 查看文章列表 '********************************************************* Function WapExport(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim i,j,s,intWapCount Dim objRS Dim objArticle Dim q,Search Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) '添加搜索 If intType=ZC_DISPLAY_MODE_SEARCH Then q=TransferHTML(Request("q"),"[nohtml]") q=Trim(q) If Len(q)=0 Then Search=True:Exit Function '过滤SQL q=FilterSQL(q) intWapCount = ZC_SEARCH_COUNT Else intWapCount = ZC_DISPLAY_COUNT_WAP End If Dim Title Title="" Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop],[log_Template],[log_FullUrl],[log_Type],[log_Meta] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>1) AND ([log_Type]="&ZC_POST_TYPE_ARTICLE&")" '添加搜索 If intType=ZC_DISPLAY_MODE_SEARCH Then objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop],[log_Template],[log_FullUrl],[log_Type],[log_Meta] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>2)" If ZC_MSSQL_ENABLE=False Then objRS.Source=objRS.Source & "AND( (InStr(1,LCase([log_Title]),LCase('"&q&"'),0)<>0) OR (InStr(1,LCase([log_Intro]),LCase('"&q&"'),0)<>0) OR (InStr(1,LCase([log_Content]),LCase('"&q&"'),0)<>0) )" Else objRS.Source=objRS.Source & "AND( (CHARINDEX('"&q&"',[log_Title])<>0) OR (CHARINDEX('"&q&"',[log_Intro])<>0) OR (CHARINDEX('"&q&"',[log_Content])<>0) )" End If End If If Not IsEmpty(intCateId) Then objRS.Source=objRS.Source & "AND([log_CateID]="&intCateId&")" 'On Error Resume Next Title=Categorys(intCateId).Name Err.Clear End if If Not IsEmpty(intAuthorId) Then objRS.Source=objRS.Source & "AND([log_AuthorID]="&intAuthorId&")" 'On Error Resume Next Title=Users(intAuthorId).Name Err.Clear End if If IsDate(dtmYearMonth) Then Dim y Dim m Dim ny Dim nm If IsDate(dtmYearMonth) Then dtmYearMonth=CDate(dtmYearMonth) Else Call ShowError(3) End If y=year(dtmYearMonth) m=month(dtmYearMonth) ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 objRS.Source=objRS.Source & "AND([log_PostTime] BETWEEN #"&y&"-"&m&"-1# AND #"&ny&"-"&nm&"-1#)" Application.Lock If Year(dtmYearMonth)=Year(GetTime(now())) And Month(dtmYearMonth)=Month(GetTime(now())) Then 'Template_Calendar=Application(ZC_BLOG_CLSID & "CACHE_INCLUDE_CALENDAR") Template_Calendar=GetTemplate("CACHE_INCLUDE_CALENDAR") End If Application.UnLock Title=Year(dtmYearMonth) & " " & ZVA_Month(Month(dtmYearMonth)) End If If Not IsEmpty(strTagsName) Then 'On Error Resume Next Dim Tag For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(strTagsName) Then objRS.Source=objRS.Source & "AND([log_Tag] LIKE '%{" & Tag.ID & "}%')" End If End If Next Err.Clear Title=strTagsName End If Dim strDTitle If Title="" Then strDTitle=ZC_BLOG_TITLE '处理置顶 If (intType=ZC_DISPLAY_MODE_ALL And IsEmpty(intCateId) And IsEmpty(intAuthorId) And Not IsDate(dtmYearMonth) And IsEmpty(strTagsName)) Then objRS.Source=objRS.Source & " AND ([log_Istop]=0) " objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() '添加搜索 If intType=ZC_DISPLAY_MODE_SEARCH Then s=Replace(Replace(ZC_MSG086,"%s","" & TransferHTML(Replace(q,Chr(39)&Chr(39),Chr(39),1,-1,0),"[html-format]") & "",vbTextCompare,1),"%s","" & objRS.RecordCount & "",1,-1,0) strDTitle=ZC_MSG158 Title=s End If If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = intWapCount intPageCount=objRS.PageCount objRS.AbsolutePage = intPage For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13),objRS(14),objRS(15),objRS(16),objRS(17))) Then objArticle.SearchText=Request.QueryString("q") objArticle.Template="WAP_ARTICLE-MULTI" If objArticle.Export(intType)= True Then aryArticleList(i)=objArticle.html End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next Else WapExport= WapTitle(Title,strDTitle) &"

"& ZC_MSG256 &"

" Exit Function End If objRS.Close() Set objRS=Nothing Dim Template_Article_Multi Template_Article_Multi=Join(aryArticleList) '处理置顶 If (intType=ZC_DISPLAY_MODE_ALL And intPage=1 And IsEmpty(intCateId) And IsEmpty(intAuthorId) And Not IsDate(dtmYearMonth) And IsEmpty(strTagsName)) Then Template_Article_Multi=WapExportTop() & Template_Article_Multi ' Dim Template_Calendar ' If IsEmpty(Template_Calendar) Or Len(Template_Calendar)=0 Then ' Application.Lock ' Template_Calendar=Application(ZC_BLOG_CLSID & "CACHE_INCLUDE_CALENDAR") ' Application.UnLock ' End If Dim aryTemplateTagsName,aryTemplateTagsValue TemplateTagsDic.Item("BlogTitle")=Title aryTemplateTagsName=TemplateTagsDic.Keys aryTemplateTagsValue=TemplateTagsDic.Items j=UBound(aryTemplateTagsName) For i=0 to j Template_Article_Multi=Replace(Template_Article_Multi,"<#" & aryTemplateTagsName(i) & "#>",aryTemplateTagsValue(i)) Next Template_Article_Multi=Replace(Template_Article_Multi,"<#ZC_FILENAME_WAP#>",WapUrlStr) If BlogUser.Level<=3 Then Template_Article_Multi=Replace(Template_Article_Multi,"<#adbegin#>","") Template_Article_Multi=Replace(Template_Article_Multi,"<#adend#>","") Else Dim objRegExp Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="<#adbegin#>(.+)<#adend#>" Template_Article_Multi= objRegExp.Replace(Template_Article_Multi,"") End If WapExport= WapTitle(Title,strDTitle) & "

"&Template_Article_Multi&"" End Function '********************************************************* ' 目的: 查看置顶 '********************************************************* Function WapExportTop() Dim i Dim objRS Dim objArticle Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop],[log_Template],[log_FullUrl],[log_Type],[log_Meta] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>1) AND ([log_Type]="&ZC_POST_TYPE_ARTICLE&") AND ([log_Istop]<>0) " objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then For i = 1 To objRS.RecordCount ReDim Preserve aryArticleList(i) Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13),objRS(14),objRS(15),objRS(16),objRS(17))) Then objArticle.Template="WAP_ARTICLE-MULTI-ISTOP" If objArticle.Export(ZC_DISPLAY_MODE_ALL)= True Then aryArticleList(i)=objArticle.html End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next Else Exit Function End If objRS.Close() Set objRS=Nothing WapExportTop=Join(aryArticleList) End Function '********************************************************* ' 目的: 列表分页 '********************************************************* Function WapExportBar(intNowPage,intAllPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,strQuestion) Dim i Dim a,b,c Dim t Dim strPageBar,Template_PageBar Call CheckParameter(intNowPage,"int",1) t=t & "?" If Not IsEmpty(intCateId) Then t=t & "act=Main&cate=" & intCateId & "&" If Not IsEmpty(dtmYearMonth) Then t=t & "act=Main&date=" & Year(dtmYearMonth) & "-" & Month(dtmYearMonth) & "&" If Not IsEmpty(intAuthorId) Then t=t & "act=Main&auth=" & intAuthorId & "&" If Not (strTagsName="") Then t=t & "act=Main&tags=" & Server.URLEncode(strTagsName) & "&" If Not (strQuestion="") Then t=t & "act=Search&q=" & Server.URLEncode(strQuestion) & "&" If intAllPage>0 Then If ZC_DISPLAY_PAGEBAR_ALL_WAP Then If intAllPage>ZC_PAGEBAR_COUNT_WAP Then a=intNowPage-CLng((ZC_PAGEBAR_COUNT_WAP-1)/2) b=intNowPage+ZC_PAGEBAR_COUNT_WAP-CLng((ZC_PAGEBAR_COUNT_WAP-1)/2)-1 If a<=1 Then a=1:b=ZC_PAGEBAR_COUNT_WAP End If If b>=intAllPage Then b=intAllPage:a=intAllPage-ZC_PAGEBAR_COUNT_WAP+1 End If Else a=1:b=intAllPage End If strPageBar=" < " For i=a to b If i=intNowPage Then strPageBar=strPageBar&" "&i&" " Else strPageBar=strPageBar&" "&i&" " End If Next strPageBar=strPageBar&" > " Template_PageBar="

" & strPageBar & "

" Else If intNowPage>1 Then If intNowPage下一页 | " End If strPageBar=strPageBar&"上一页 | "&intNowPage&"/"&intAllPage ElseIf (intNowPage mod intPageCount)<>0 Then If strPageBar<>"" Then strPageBar=strPageBar&" | " strPageBar=strPageBar&"下一页 | "&intNowPage&"/"&intAllPage Else strPageBar="" End If Template_PageBar="

" & strPageBar & "

" End If End If WapExportBar=Template_PageBar End Function '********************************************************* ' 目的: 查看错误 '********************************************************* Public Function WapError() Dim ID ID=Request.QueryString("id") If Not IsNumeric(ID) Then ID=0 ElseIf CLng(ID)>Ubound(ZVA_ErrorMsg) Or CLng(ID)<0 Then ID=0 End If Response.Write WapTitle(ZVA_ErrorMsg(ID),"") & "

"&ZVA_ErrorMsg(ID)&" "&ZC_MSG065&"

" End Function '********************************************************* Function ShowError_WAP(id) Response.Redirect WapUrlStr&"?act=Err&id="&id End Function %>