www.gusucode.com > 易心博客[圣诞版] 3.5手动安装码程序 > wap.asp
<!--#include file="conn.asp"-->
<!--#include file="Ex_Cls/Ex_SkinCls.asp"-->
<!--#include file="Ex_Cls/Ex_RefreshCls.asp"-->
<!--#include file="Ex_Cls/Ex_SplitPageCls.asp"-->
<!--#include file="Ex_Cls/Ex_ImgCls.asp"-->
<!--#include file="Ex_Cls/Ex_FilterHtmlCls.asp"-->
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<%
Dim Title, Content, ExComm,Id, ClassId,Islogin
Set ExComm=new Ex_CommonCls
ExComm.GetConfigCache("adpwd,adname,runmode,ShowName,CmtPageSize,IsCheckCode,cmtmsgcheckre,iscmtmsgcheck,LogNum,blogname,BlogDescription,BlogKeyWord,IndexAddWord,blogurl,logourl,DefaultSkin,CopyRight,ListOrderType,logdefaultnum")
Id = CInt(Request.QueryString("id"))
If (0 =Id Or "" = Id ) And "" = request.querystring("action") Then
Title = Application(SN&"blogname")
Content = show_log("")
ElseIf request.querystring("action")="search" Then
Title = Application(SN&"blogname")
Content = show_log("")
ElseIf request.querystring("action")="save" Then
save
ElseIf request.querystring("action")="edit" Then
edit
ElseIf request.querystring("action")="loginform" Then
Content = loginform
ElseIf request.querystring("action")="login" Then
login
ElseIf request.querystring("action")="loginout" Then
loginout
ElseIf request.querystring("action")="addlogf" Then
content = addlogf
ElseIf request.querystring("action")="addlog" Then
addlog
Else
Title = Application(SN&"blogname")
Content = Show_LogMore("")
End If
%>
<title><%=Title%></title>
</head>
<body>
<%
If True <> checklogin Then
%>
<div>
<a href="wap.asp?loginhash=<%=Trim(request("loginhash"))%>">首页</a> <A HREF="wap.asp?action=loginform">管理</A>
</div>
<%
Else
%>
<div>
<a href="wap.asp?loginhash=<%=Trim(request("loginhash"))%>">首页</a> <A HREF="wap.asp?action=addlogf&loginhash=<%=Trim(request("loginhash"))%>">发布日志</A> <A HREF="wap.asp?action=loginout&loginhash=<%=Trim(request("loginhash"))%>">退出</A>
</div>
<%
End If
%>
<%=Content%>
</body>
</html>
<%
Function ShowMsg(msg, url)
If "" = url Then
url = Application(SN&"blogurl")
End If
response.write "<a href="""&url&"&loginhash="&Trim(request("loginhash"))&""">"&msg &"</a>"
End Function
'登录框
Function loginform
Dim html
html = html & "<form action=""wap.asp?action=login"" method=""post"">"
html = html & "帐号:<input name=""adname""><br/>密码:<input name=""adpwd"">"
html = html & "<br/><input type=""submit"" value=""登录"">"
html = html & "</form>"
loginform = html
End Function
'**********************************
'作 用：日志添加文本框
'**********************************
Function addlogf
dim html
Dim defaultRs,defaultSql
defaultSql="select ishide,istop,iscmt,copyright from Ex_LogDefault"
defaultRs=Conn.execute(defaultSql)
html = "<FORM METHOD=POST ACTION=""wap.asp?action=addlog&loginhash="&Trim(request("loginhash"))&"""><BR/>"
html = html & "分类:<select name=""classx"" id=""classx""><option value="""">选择分类</option>"&ExComm.GetClassSelectCache(0)&"</select><BR/>"
html = html & "标题:<INPUT TYPE=""text"" NAME=""title""><BR/>"
html = html & "Tags:<INPUT TYPE=""text"" NAME=""tags"" value=""标签之间用空格分开""><BR/>"
html = html & "内容:<TEXTAREA NAME=""Body"" ROWS="""" COLS=""""></TEXTAREA><BR/>"
'html = html & "照片:<INPUT TYPE=""file"" NAME=""pic""><BR/>"
html = html & "选项:查看<select name=""ishide"" id=""select2""><option value=""游客"">游客</option>"
html = html & "<option value=""会员"">会员</option>"
html = html & "<option value=""隐藏"">隐藏</option></select> "
html = html & "存为草稿<input name=""savedraft"" type=""checkbox"" id=""savedraft"" value=""0""><BR/>"
html = html & "<INPUT TYPE=""submit"" value=""发布"">"
html = html & "</FORM>"
addlogf = html
End Function
'**********************************
'作 用：添加日志
'**********************************
'插入标签
Sub InsertTag(ByVal Tags,Classid)
Dim I
Tags=Split(Tags," ")
For I=0 To UBound(Tags)
Conn.Execute "insert into Ex_tags (tagname,classid,times) values('"&Tags(I)&"',"&classid&",0)"
Next
End Sub
'*****************************
'截取日志摘要文字
'参数:str 日志内容
'****************************
Function GetAbstractHtml(ByVal str)
Dim Char,Temp,Arr,I,Content,Ln
Ln=CInt(Application(sn&"logdefaultnum"))
Content=ExComm.ClearHtml(Str)
If Len(Content)>Ln Then
Char=Mid(Content,Ln,1)
Arr=Split(Str,Char)
For I=0 To UBound(Arr)
Temp=Temp&Arr(I)&Char
If Len(ExComm.ClearHtml(Temp))>=Ln Then
GetAbstractHtml=Temp
Exit For
End If
Next
GetAbstractHtml=Temp
Else
GetAbstractHtml=Str
End If
End Function
'从新生成模板
Function RefreshTxtSkin
ExComm.ClearCaches(sn)
Dim ExSkin
Set ExSkin=new Ex_SkinCls
ExSkin.RefreshSkinCache
Set ExSkin=Nothing
End Function
'*****************************
'及时生成日志信息静态页
'参数:日志id
'****************************
Function CreateLOG(id)
Dim ExRefresh,I
ExComm.ClearCaches(sn)
RefreshTxtSkin
ExComm.GetConfigCache("*")
Set ExRefresh=new Ex_RefreshCls
If InStr(id,",")<>0 Then
Id=Split(id,",")
For I=0 To UBound(id)
ExRefresh.CreateView id(I)
Next
Else
ExRefresh.CreateView id
End If
End Function
'保存图片
Function ImgSave(formname,sUploadDir)
Dim oFile, sFileExt, sFileName,osize
Set ExFso=new Ex_FsoCls
ExFso.CreateRoute(sUploadDir)
' 建立上传对象
' 取得上传数据,限制最大上传
Set oFile = ExUpload.File(formname)
sFileExt = UCase(oFile.FileExt)
osize = oFile.Filesize
Dim sRnd
Randomize
sRnd = Int(900 * Rnd) + 100
sFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & sRnd & "." & sFileExt
If oFile.FileSize=0 Then
ImgSave=""
Else
oFile.SaveToFile Server.Mappath(sUploadDir & "\"& sFileName)
ImgSave=sUploadDir & "\"& sFileName
End If
Set oFile = Nothing
End Function
Function addlog
dim title,tags,classx,content,ishide,istop,iscmt,logpass,emotion,quote,submittime,Recommend,file_name '增加变量file_name用于接收日志静态文件名值 Modify by Hotlion at 2009-2-14
Dim strsql,rs,log_postyear,log_postmonth,log_postday,log_posthour,log_postmin,copyright,textnum,logtype,abstract
title=server.htmlencode(request.Form("title"))
tags=Trim(server.htmlencode(request.Form("tags")))
classx=request.Form("classx")
content=request.Form("body")
abstract=Request.Form("aBody")
ishide=request.Form("ishide")
istop=request.Form("istop")
iscmt="游客"
logpass=request.Form("logpass")
emotion=request.Form("emotion")
quote=request.Form("quote")
copyright=request.Form("copyright")
submittime=request.Form("submittime")
log_postyear=request.Form("selecty")
log_postmonth=request.Form("selectm")
log_postday=request.Form("selectd")
log_posthour=request.Form("selecth")
log_postmin=request.Form("selectmin")
textnum=request.Form("savedraft")
logtype=request.Form("logtype")
Recommend=Request.Form("recommend")
file_name=Request.Form("file_name")
If Tags="标签之间用空格分开" Then
Tags=""
End If
If Tags<>"" Then
InsertTag tags,classx
End If
If Year(submittime)<>log_postyear Or Month(submittime)<>log_postmonth Or Day(submittime)<>log_postday Then
Submittime=log_postyear&"-"&log_postmonth&"-"&log_postday&" "&log_posthour&":"&log_postmin&":"&Second(now)
End If
If Trim(textnum)="" Then
textnum=1
End If
strsql="select * from Ex_log"
set rs=server.CreateObject("adodb.recordset")
rs.open strsql,Conn,0,2
rs.addnew
rs("title")=title
rs("classid")=cint(classx)
If request("saveimg")="yes" Then
ExImg.imgPath="UpFile\"&Year(Now())&"\"&Month(Now())&""
ExFso.CreateRoute ExImg.imgPath
content=ExImg.ReplaceUrl(content)
End If
rs("submittime")=Now()
rs("log_postyear")=Year(now)
rs("log_postmonth")=Month(now)
rs("log_postday")=Day(now)
if tags<>"" then
rs("tags")=tags
end if
if ishide<>"" then
rs("ishide")=ishide
end if
if copyright="" then
rs("copyright")=false
end if
if istop<>"" then
rs("istop")=istop
end if
if iscmt<>"" then
rs("iscmt")=iscmt
end if
if logpass<>"" then
rs("logpass")=logpass
end if
if emotion<>"" then
rs("emotion")=emotion
end if
if quote<>"" then
rs("quote")=quote
end If
Dim ExHtml
Set ExHtml=new Ex_FilterHtmlCls
Abstract=Replace(Abstract,"<P> </P>","")
If Trim(Abstract)="" And InStr(content,"$ex_cut$")<>0 Then
Abstract=ExHtml.GetHtml(Mid(content,1,InStr(content,"$ex_cut$")-1))
ElseIf Trim(Abstract)="" And InStr(content,"$ex_cut$")=0 Then
Abstract=ExHtml.GetHtml(GetAbstractHtml(content))
End If
Rs("abstract")=Abstract
rs("content")=Replace(content,"$ex_cut$","")
rs("textnum")=textnum
rs("logtype")=logtype
Rs("recommend")=Recommend
Rs("file_name")=file_name '自定义文件名写入数据库 modify by Hotlion at 2009-2-14
rs.update
rs.close
set rs=Nothing
'引用开始
IF Quote<>"" Then
Dim TBlogID,TBlogTmp,tbCode,tbMessage
TBlogID=Conn.Execute("SELECT TOP 1 ID FROM Ex_log ORDER BY id DESC")(0)
If TBlogID>0 then
TBlogTmp=Split(Trackback(Quote, Application(sn&"blogurl")&"/blogview.asp?ID="&tblogid,Title, ExComm.CutStr(content,252),Application(sn&"blogname"),tags),"$$")
tbCode=TBlogTmp(0)
tbMessage=TBlogTmp(1)
End If
End If
Application.lock
Application(sn&"logtotal")=Application(sn&"logtotal")+1
Application.unlock
'静态生成
If ishide="游客" And textnum<>0 Then
Createlog Conn.execute("select max(id) from Ex_log")(0)
End If
'DelAutoSave
ShowMsg "日志添加成功,"&tbmessage&"","wap.asp?action=addlogf"
End Function
'**********************************
'作 用：登录状态检测
'**********************************
Function checklogin
Dim loginhash
loginhash=Trim(request("loginhash"))
If md5(Application(sn&"AdName")&Application(sn&"AdPwd")) = loginhash Then
checklogin = True
Else
checklogin = False
End If
End Function
'**********************************
'作 用：登录
'**********************************
Sub login
Dim Adname,AdPwd,loginhash
AdName=ExComm.G(Trim(request("Adname")))
AdPwd=md5(Trim(request("AdPwd")))
loginhash=Trim(request("loginhash"))
If md5(Application(sn&"AdName")&Application(sn&"AdPwd")) = loginhash Then
Application(SN&"islogin") = "yes"
Exit Sub
End If
If Trim(AdName)=CStr(Application(sn&"AdName")) And Trim(AdPwd)=CStr(Application(sn&"AdPwd")) Then
Response.Redirect(Application(sn&"blogurl")&"wap.asp?loginhash="&md5(Application(sn&"AdName")&Application(sn&"AdPwd")))
Else
response.write "登录失败"
End if
End Sub
'**********************************
'作 用：退出登录
'**********************************
Sub loginout
Dim loginhash
loginhash=Trim(request("loginhash"))
If md5(Application(sn&"AdName")&Application(sn&"AdPwd")) = loginhash Then
Application(SN&"islogin") = ""
Response.Redirect(Application(sn&"blogurl")&"wap.asp")
End If
End Sub
'**********************************
'作 用：显示日志列表
'**********************************
function show_log(ByVal ExSkin)
Dim temp,show_logcyc,rs,show_topic,show_more,show_loginfo,show_logtext,show_author,show_topictxt
Dim show_emot,show_addtime,show_logcls,show_topicurl
Dim action,classid
Dim Skin2,c_year,c_month,c_day
Dim ExNow,ViewType,OrderType,ContentType
OrderType=Request.QueryString("ordertype")
ViewType="list"
ContentType=Request.QueryString("contenttype")
If InStr(OrderType,"recommend")<>0 Then
OrderType="Recommend desc,"
ElseIf InStr(OrderType,"bits")<>0 Then
OrderType="bits desc,"
ElseIf InStr(OrderType,"cmt")<>0 Then
OrderType="cmt desc,"
ElseIf InStr(OrderType,"submittime")<>0 Then
OrderType="submittime desc,"
End If
ExNow=ExComm.ExNow()
c_year=ExComm.G(request.querystring("c_year"))
c_month=ExComm.G(request.querystring("c_month"))
c_day=ExComm.G(request("c_day"))
classid=cint(request.querystring("classid"))
action=ExComm.G(request.querystring("action"))
'构造Sql语句开始
Dim ExPages,page
Set ExPages=new Ex_SplitPageCls
Expages.letConn=Conn
Expages.letColumns="select log_postyear,log_postmonth,log_postday, title,bits,id,iscmt,classid,emotion,tb,ishide,cmt,logpass,submittime,abstract,textnum"
ExPages.letDataFrom="from Ex_Log"
ExPages.letOrder="order by istop asc,"&OrderType&Application(Sn&"ListOrderType")
If action<>"search" Then'当非搜索
If classid=0 Then
If c_year<>"" And c_month<>"" And c_day<>"" Then
ExPages.letWhere="where log_postyear="&c_year&" and log_postmonth="&c_month&" and log_postday="&c_day&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0"
ExPages.letStrPage="&c_year="&c_year&"&c_month="&c_month&"&c_day="&c_day&"&loginhash="&Trim(request("loginhash"))&"&"
ElseIf c_year<>"" And c_month<>"" Then
ExPages.letWhere="where log_postyear="&c_year&" and log_postmonth="&c_month&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0"
ExPages.letStrPage="&c_year="&c_year&"&c_month="&c_month&"&c_day="&c_day&"&loginhash="&Trim(request("loginhash"))&"&"
ElseIf c_year<>"" Then
ExPages.letWhere="where log_postyear="&c_year&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0"
ExPages.letStrPage="&c_year="&c_year&"&c_month="&c_month&"&c_day="&c_day&"&loginhash="&Trim(request("loginhash"))&"&"
ElseIf ContentType<>"" Then
ExPages.letWhere="where textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0 and recommend<>0"
ExPages.letStrPage="&contenttype=recommend&loginhash="&Trim(request("loginhash"))
Else
ExPages.letWhere="where textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0"
ExPages.letStrPage="&loginhash="&Trim(request("loginhash"))
End If
Else'具体到某类
ExPages.letWhere="where classid="&classid&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0"
ExPages.letStrPage="&classid="&classid&"&loginhash="&Trim(request("loginhash"))
End If
Else'为搜索
Dim selecttype,keyword
selecttype=ExComm.G(request("selecttype"))
keyword=ExComm.G(request("keyword"))
ExPages.letWhere="where "&selecttype&" like '%"&keyword&"%' and textnum<>0"
ExPages.letStrPage="&action=search&loginhash="&Trim(request("loginhash"))&"&selecttype="&selecttype&"&keyword="&keyword&"&"
'点击tags进行处理
classid2=ExComm.G(request.querystring("classid"))
If request.querystring.count<>0 And classid2<>"" And selecttype="tags"then
dim tagsrs,classid2
classid2=ExComm.G(request.querystring("classid"))
Conn.execute("update Ex_tags set times=times+1 where tagname='"&keyword&"' and classid="&classid2)
End if
End If
'构造sql语句结束
Set Rs=server.CreateObject("adodb.recordset")
If ViewType="list" Then
Expages.letPageSize=CInt(Application(sn&"LogNum"))
Else
Expages.letPageSize=CInt(Application(sn&"LogNum"))
End If
If ExComm.G(request("page"))="" Then
page=1
Else
page=ExComm.G(request("page"))
End if
ExPages.letPage=CInt(page)
ExPages.Execute()
'显示tags和日志列表内容开始
Set Rs=ExPages.GetRs
If ExPages.GetRsCount<>0 then
'===============以下为显示代码===============
'显示热门tags
'tags显示结束
Do While Not rs.eof
'构造$show_topic$
If Application(sn&"runmode")="静态" Then
Dim BlogViewUrl
BlogViewUrl=ExComm.CreateUrl(ExComm.GetClassFolder(Rs("classid")),ExComm.GetLogName(Rs("id")),"")
show_topic="<a href=""wap.asp?classid="&rs("classid")&"&loginhash="&Trim(request("loginhash"))&""">["&ExComm.GetClassName(rs("classid"))&"]</a>"
show_logcls=Replace(show_topic,"[","")
show_logcls=Replace(show_logcls,"]","")
If Rs("ishide")="游客" And Rs("textnum")<>0 And (Trim(Rs("logpass"))="" Or IsNull(Rs("logpass"))) Then
show_topic=show_topic&"<a href="""&BlogViewUrl&""">"&rs("title")&"</a>"
show_topicurl=BlogViewUrl
Else
show_topic=show_topic&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a>"
show_topicurl="wap.asp?id="&rs("id")&"loginhash="&Trim(request("loginhash"))
End if
Else
show_topic="<a href=""wap.asp?classid="&rs("classid")&"&loginhash="&Trim(request("loginhash"))&""">["&ExComm.GetClassName(rs("classid"))&"]</a>"
show_logcls=Replace(show_topic,"[","")
show_logcls=Replace(show_logcls,"]","")
show_topic=show_topic&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a>"
show_topicurl="wap.asp?id="&rs("id")&"loginhash="&Trim(request("loginhash"))
End if
'构造$show_loginfo$
show_loginfo=""&Application(sn&"ShowName")&" 发表于 "&rs("log_postyear")&"-"&rs("log_postmonth")&"-"&rs("log_postday")&" "&Hour(Rs("submittime"))&":"&Minute(Rs("submittime"))&":"&Second(Rs("submittime"))
'构造$show_logtext$
If checklogin=False And rs("ishide")="隐藏" then
show_logtext="<div style=""text-align:center"">此处隐藏一篇日志。</div>"
elseif rs("logpass")<>"" And checklogin=False then
show_logtext="<div style=""text-align:center""><a href=""wap.asp?m=blogview&id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">此日志需要密码访问。</a></div>"
ElseIf ExComm.IsLogin("user")=False And rs("ishide")="会员" And checklogin=False Then
show_logtext="<div style=""text-align:center""><br>本日志只有会员才可以查看,如果您是会员请登陆</div>"
Else
show_logtext=Rs("abstract")
end If
'构造$show_more$ 此标记为js调用显示
'show_more=ExSkin.More(Rs("Id"))
'构造$show_emot$
show_emot="<img src=images/emotion/em0"&rs("emotion")&".gif >"
'构造$show_author$
show_author=Application(sn&"showname")
'构造$show_addtime$
show_addtime=rs("log_postyear")&"-"&rs("log_postmonth")&"-"&rs("log_postday")&" "&Hour(Rs("submittime"))&":"&Minute(Rs("submittime"))&":"&Second(Rs("submittime"))
'构造$show_topictxt$
show_topictxt=rs("title")
'Show_LogIds=Show_LogIds&Rs("id")&","
'辅模板替换开始
If viewtype="list" Then
Show_Logcyc="<div class=""viewtype opt"" style=""text-align:left""><span>"&show_more&"</span>★ "&show_topic&"</div>"
Else
Skin2=ExSkin.GetTxtSkin("show_log.html")
show_logcyc=replace(Skin2,"$show_topic$",show_topic)
Show_logcyc=Replace(show_logcyc,"$show_copyright$","")
Show_logcyc=Replace(show_logcyc,"$show_adscnthead$","")
Show_logcyc=Replace(show_logcyc,"$show_adscntbottom$","")
show_logcyc=replace(show_logcyc,"$show_loginfo$",show_loginfo)
show_logcyc=replace(show_logcyc,"$show_more$",show_more)
show_logcyc=replace(show_logcyc,"$show_emot$",show_emot)
show_logcyc=replace(show_logcyc,"$show_author$",show_author)
show_logcyc=replace(show_logcyc,"$show_addtime$",show_addtime)
show_logcyc=replace(show_logcyc,"$show_topictxt$",show_topictxt)
show_logcyc=replace(show_logcyc,"$show_logtext$",show_logtext)
show_logcyc=replace(show_logcyc,"$show_logcls$",show_logcls)
show_logcyc=replace(show_logcyc,"$show_topicurl$",show_topicurl)
End If
rs.movenext
show_log=show_log&show_logcyc
Loop
'内容部分循环结束
'===================分页尾部=======================
dim showpage
showpage="<br/><center>"&ExPages.WapShow&"</center>"
show_log=show_log&showpage
set rs=nothing
else
show_log="<a href=""wap.asp?loginhash="&Trim(request("loginhash"))&""">暂时未有任何日志！</a>"
end If
'显示tags和日志列表内容结束
End Function
'******************************************
'生成日志上一篇 下一篇代码
'id--当前日志的id
'******************************************
Function proNext(id)
dim rs,strsql,ExNow
ExNow=ExComm.ExNow()
set rs=server.CreateObject("adodb.recordset")
strsql="select top 1 id,title,classid,ishide from Ex_log where id>"&id&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0 order by submittime asc"
rs.open strsql,Conn,1,1
if not rs.eof and not rs.bof Then
If Application(sn&"runmode")<>"动态" And rs("ishide")="游客" Then
proNext="上一篇: "&"<a href="""&ExComm.CreateUrl(ExComm.GetClassFolder(Rs("classid")),ExComm.GetLogName(Rs("id")),"")&""">"&rs("title")&"</a> <br>"
Else
proNext="上一篇: "&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a> <br>"
End if
end if
rs.close
strsql="select top 1 id,classid,title,ishide,textnum,logpass from Ex_log where id<"&id&" and textnum<>0 and datediff('d','"&ExNow&"',submittime)<=0 order by submittime desc"
rs.open strsql,Conn,1,1
if not rs.eof and not rs.bof Then
If Application(sn&"runmode")<>"动态" And Rs("ishide")="游客" And Rs("textnum")<>0 And (Trim(Rs("logpass"))="" Or IsNull(Rs("logpass"))) Then
proNext=proNext&"下一篇: "&"<a href="""&ExComm.CreateUrl(ExComm.GetClassFolder(Rs("classid")),ExComm.GetLogName(Rs("id")),"")&""">"&rs("title")&"</a> <br>"
Else
proNext=proNext&"下一篇: "&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a> <br>"
End If
end if
rs.close
set rs=nothing
end Function
'过滤内容
Function filetrContent(str)
Dim pattern,re
Set re = new Regexp
Re.ignorecase=True
Re.global=True
Re.multiline=True
Re.pattern = "<img(.*)?/>"
filetrContent = re.Replace(str,"[图片]")
End Function
'******************************************
'显示日志内容
'******************************************
Function Show_LogMore(ExSkin)
Dim id,sql,rs
Dim show_logtext,show_topic,show_loginfo,show_more,show_logcyc,iscmt,show_copyright,show_author,show_addtime
Dim show_topictxt,show_emot,show_logcls,show_topicurl,logName,BlogViewUrl
Dim Skin2,Show_logids
id=clng(request.querystring("id"))
Show_logids=id
sql="select * from Ex_log where id="&id
Set rs=Conn.execute(sql)
if not rs.eof And not rs.bof Then
logName=rs("title")
iscmt=rs("iscmt")
'构造$show_topic$
If Application(sn&"runmode")="静态" Then
BlogViewUrl=ExComm.CreateUrl(ExComm.GetClassFolder(Rs("classid")),ExComm.GetLogName(Rs("id")),"")
show_topic="<a href=""wap.asp?classid="&rs("classid")&"&loginhash="&Trim(request("loginhash"))&""">["&ExComm.GetClassName(rs("classid"))&"]</a>"
show_logcls=Replace(show_topic,"[","")
show_logcls=Replace(show_logcls,"]","")
If Rs("ishide")="游客" And Rs("textnum")<>0 And (Trim(Rs("logpass"))="" Or IsNull(Rs("logpass"))) Then
show_topic=show_topic&"<a href="""&BlogViewUrl&""" >"&rs("title")&"</a>"
show_topicurl=BlogViewUrl
Else
show_topic=show_topic&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a>"
show_topicurl="wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))
End If
Else
show_topic="<a href=""wap.asp?classid="&rs("classid")&"&loginhash="&Trim(request("loginhash"))&""">["&ExComm.GetClassName(rs("classid"))&"]</a>"
show_logcls=Replace(show_topic,"[","")
show_logcls=Replace(show_logcls,"]","")
show_topic=show_topic&"<a href=""wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))&""">"&rs("title")&"</a>"
show_topicurl="wap.asp?id="&rs("id")&"&loginhash="&Trim(request("loginhash"))
End if
'构造$show_loginfo$
show_loginfo="发表于"&rs("log_postyear")&"-"&rs("log_postmonth")&"-"&rs("log_postday")&" "&Hour(Rs("submittime"))&":"&Minute(Rs("submittime"))&":"&Second(Rs("submittime"))
'构造$show_logtext$
If checklogin=False And rs("ishide")="隐藏" then
show_logtext="<div align=center>此处隐藏一篇日志。</div>"
elseif rs("logpass")<>"" And checklogin=False And request("checkpass")<>rs("logpass") then
show_logtext="<div align=center>此日志需要密码访问<br><FORM METHOD=POST ACTION=""wap.asp?id="&rs("id")&"&check=true&loginhash="&Trim(request("loginhash"))&"""><INPUT TYPE=""text"" NAME=""checkpass"" id=""checkpass""><INPUT TYPE=""submit"" value=""查看""></FORM></div>"
ElseIf checklogin=False And rs("ishide")="会员" And ExComm.IsLogin("user")=False Then
show_logtext="<div align=center><br>本日志只有会员才可以查看,如果您是会员请登陆</div>"
Else
Dim tags,tags_start,tags_end,tags_str
tags=rs("tags")
'show_blogKeyword=Replace(tags&" "," ",",")
If tags<>"" then
tags=Split(tags," ")
tags_end=UBound(tags)
For tags_start=0 To tags_end
tags_str= tags_str&"<a href=""wap.asp?action=search&loginhash="&Trim(request("loginhash"))&"&selecttype=tags&keyword="&server.urlencode(tags(tags_start))&"&classid="&rs("classid")&""">"&tags(tags_start)&"</a> "
Next
End if
show_logtext=filetrContent(rs("content"))
show_logtext=show_logText&"<br>日志标签："&tags_str
show_logtext=show_logText&"<br>"&proNext(rs("id"))
end If
'构造$show_copyright$
If Rs("copyright")=True Then
show_CopyRight=Application(Sn&"CopyRight")
Else
show_CopyRight=""
End If
'构造$show_more$ 此标记为js调用显示
'show_more=ExSkin.More(Rs("Id"))
'构造$show_emot$
show_emot="<img src=images/emotion/em0"&rs("emotion")&".gif >"
'构造$show_author$
show_author=Application(sn&"showname")
'构造$show_addtime$
show_addtime=rs("log_postyear")&"-"&rs("log_postmonth")&"-"&rs("log_postday")&" "&Hour(Rs("submittime"))&":"&Minute(Rs("submittime"))&":"&Second(Rs("submittime"))
'构造$show_topictxt$
show_topictxt=rs("title")
Title=show_topictxt
'辅模板替换开始
Skin2="<div>$show_topic$</div><div style=""background:#C5DDF0"">$show_loginfo$</div><div>$show_logtext$</div><div style=""background:#C5DDF0"">以下是日志回复</div>"
show_logcyc=replace(Skin2,"$show_topic$",show_topic)
show_logcyc=replace(show_logcyc,"$show_loginfo$",show_loginfo)
show_logcyc=replace(show_logcyc,"$show_more$",show_more)
show_logcyc=replace(show_logcyc,"$show_emot$",show_emot)
show_logcyc=replace(show_logcyc,"$show_author$",show_author)
show_logcyc=replace(show_logcyc,"$show_addtime$",show_addtime)
show_logcyc=replace(show_logcyc,"$show_topictxt$",show_topictxt)
show_logcyc=replace(show_logcyc,"$show_logtext$",show_logtext)
show_logcyc=replace(show_logcyc,"$show_logcls$",show_logcls)
show_logcyc=replace(show_logcyc,"$show_topicurl$",show_topicurl)
show_logcyc=replace(show_logcyc,"$show_copyright$",show_copyright)
show_logmore=show_logmore&show_logcyc
'回复部分显示
Dim ExPages,page
Set ExPages=new Ex_SplitPageCls
Expages.letConn=Conn
Expages.letColumns="select *"
ExPages.letDataFrom="from Ex_Comment"
ExPages.letOrder="order by id desc"
If checklogin=False Then
If ExComm.G(request.querystring("cmtid"))<>"" Then
ExPages.letWhere="where isshow='是' and id="&CLng(request.querystring("cmtid"))
Else
ExPages.letWhere="where isshow='是' and parentid="&CLng(id)
End If
Else
If ExComm.G(request.querystring("cmtid"))<>"" Then
ExPages.letWhere="where id="&CLng(request.querystring("cmtid"))
Else
ExPages.letWhere="where parentid="&CLng(id)
End If
End If
Set Rs=server.CreateObject("adodb.recordset")
Expages.letPageSize=Application(sn&"CmtPageSize")
If ExComm.G(request("page"))="" Then
page=1
Else
page=CLng(request("page"))
End if
ExPages.letPage=page
ExPages.letStrPage="&id="&ExComm.G(request("id"))&"&loginhash="&Trim(request("loginhash"))
ExPages.Execute()
Set Rs=ExPages.GetRs
If ExPages.GetRsCount<>0 then
Do While Not rs.eof
'构造$show_topic$
show_topic=rs("cmttitle")
'构造$show_loginfo$和'构造$show_author$
if trim(rs("userhome"))<>"" and trim(rs("userhome"))<>"http://" then
show_loginfo="<a href="""&rs("userhome")&""" target=""_blank"" title=""查看主页"">"&rs("username")&"</a>"&"于"&rs("addtime")&"发表"
show_author="<a href="""&rs("userhome")&""" target=""_blank"" title=""查看主页"">"&rs("username")&"</a>"
else
show_loginfo=rs("username")&"于"&rs("addtime")&"发表"
show_author=rs("username")
end If
'构造$show_logtext$
show_logtext=rs("cmtcomment")
'构造$show_more$
Show_more=" "
If ExComm.isLOGIN("user") And Rs("username")=session("user") then
show_more="<a href=""?ac=edit&editid="&rs("id")&"&id="&id&"#cmtpost"">编辑</a>"
End If
If checklogin Then
show_more=show_more&" | <a href=""admin_Cmt.asp?action=del&id="&rs("id")&""" onclick=""return confirm('是否要删除？')"">删除</a>"
End If
'构造$show_emot$
show_emot=""
'构造$show_addtime$
show_addtime=rs("addtime")
'构造$show_topictxt$
show_topictxt=rs("cmttitle")
If ExComm.IsOblogSkin Then
show_logcyc=Skin2
Else
show_logcyc="<div style=""margin-top:10px"">$show_logtext$</div><div style=""background:#C5DDF0;"">$show_loginfo$</div>"
End If
show_logcyc=replace(show_logcyc,"$show_topic$",show_topic)
show_logcyc=replace(show_logcyc,"$show_loginfo$",show_loginfo)
show_logcyc=replace(show_logcyc,"$show_logtext$",show_logtext)
show_logcyc=replace(show_logcyc,"$show_more$",show_more)
show_logcyc=replace(show_logcyc,"$show_emot$",show_emot)
show_logcyc=replace(show_logcyc,"$show_author$",show_author)
show_logcyc=replace(show_logcyc,"$show_addtime$",show_addtime)
show_logcyc=replace(show_logcyc,"$show_topictxt$",show_topictxt)
show_logcyc=replace(show_logcyc,"$show_cmtid$",Rs("id"))
rs.movenext
show_logmore=show_logmore&"<a name=""#cmttop""></a>"&show_logcyc
Loop
dim showpage
showpage=showpage&"<div align=center>"&ExPages.WapShow&"</div>"
'分页结束
show_logmore=show_logmore&showpage
rs.close
Set rs=Nothing
End If
'显示回复框
If iscmt="游客" or (iscmt="会员" and ExComm.IsLogin("user")) then
show_logmore=show_logmore&"<a name=""#cmtpost""></a> <div align=""center"">"
show_logmore=show_logmore&" <table border=""0"" width=""60%"" id=""Ex_cmttab"" align=""center"">"
If request("ac")="edit" Then
show_logmore=show_logmore&"<form method=""POST"" action=""wap.asp?action=edit&loginhash="&Trim(request("loginhash"))&"&editid="&request("editid")&"&id="&id&""" id=""Ex_cmt"">"
Else
show_logmore=show_logmore&"<form method=""POST"" action=""wap.asp?action=save&loginhash="&Trim(request("loginhash"))&"&id="&id&""" id=""Ex_cmt"">"
End if
show_logmore=show_logmore&" <tr>"
show_logmore=show_logmore&" <td width=""30%"">昵称</td>"
show_logmore=show_logmore&" <td width=""70%"" style=""text-align:left;""><input type=""text"" name=""username"" size=""20"" value="""&ExComm.UnDeCode(request.Cookies(Md5(sn))("uname"))&""" align=""left""><font color=""red"">*</font></td>"
show_logmore=show_logmore&" </tr>"
show_logmore=show_logmore&" <tr>"
show_logmore=show_logmore&" <td width=""30%"">密码</td>"
show_logmore=show_logmore&" <td width=""70%"" style=""text-align:left;""><input type=""password"" name=""userpass"" id=""password"" size=""20"" value="""&ExComm.UnDeCode(request.Cookies(Md5(sn))("upwd"))&"""><font color=red>[游客不必填写]</font></td>"
show_logmore=show_logmore&" </tr>"
show_logmore=show_logmore&" <tr>"
show_logmore=show_logmore&" <td width=""30%"">主页</td>"
show_logmore=show_logmore&" <td width=""70%"" style=""text-align:left;""><input type=""text"" name=""homepage"" size=""20"" value="""&ExComm.UnDeCode(request.Cookies(Md5(sn))("homepage"))&"""></td>"
show_logmore=show_logmore&" </tr>"
If request("ac")<>"edit" then
show_logmore=show_logmore&" <tr style=""display:none"">"
show_logmore=show_logmore&" <td width=""30%"">标题<font color=""red"">*</font></td>"
show_logmore=show_logmore&" <td width=""70%""><input type=""text"" name=""cmttitle"" size=""35"" value=""re:"&logName&"""></td></tr><tr><td colspan=""2"">"
show_logmore=show_logmore&"<textarea name=""aBody"" id=""aBody"" style=""width:100%;height:30px""></textarea>"&vbcrlf
show_logmore=show_logmore&"</tr>"
show_logmore=show_logmore&" <tr>"&vbcrlf
show_logmore=show_logmore&" <td width=""100%"" colspan=""2"">"
Else
Dim cc
cc=Conn.execute("select cmttitle,cmtcomment from ex_comment where id="&CInt(request("editid")))
show_logmore=show_logmore&" <tr style=""display:none;"">"
show_logmore=show_logmore&" <td width=""30%"">标题<font color=""red"">*</font></td>"
show_logmore=show_logmore&" <td width=""70%""><input type=""text"" name=""cmttitle"" size=""35"" value="""&cc(0)&"""></td></tr><tr><td colspan=""2"">"
show_logmore=show_logmore&"<textarea name=""aBody"" id=""aBody"" style=""width:100%;height:30px"">"&server.htmlencode(cc(1))&"</textarea>"&vbcrlf
show_logmore=show_logmore&"</tr>"
show_logmore=show_logmore&" <tr>"&vbcrlf
show_logmore=show_logmore&" <td width=""100%"" colspan=""2"">"
End If
show_logmore=show_logmore&"</td></tr>"
show_logmore=show_logmore&" <tr>"
show_logmore=show_logmore&" <td width=""100%"" colspan=""2""><input type=""submit"" value=""提交"" name=""B1"" ></td>"
show_logmore=show_logmore&" </tr></form>"
show_logmore=show_logmore&" </table>"
show_logmore=show_logmore&" </div>"
show_logmore=show_logmore&"<br>提示：代<font color=""red"">*</font>的和内容必须填写！！"
Else
If iscmt="会员" then
show_logmore=show_logmore&"<br><center>此文章只有会员才可以回复,如果您是会员请登陆</center>"
Else
show_logmore=show_logmore&"<br><center>此文章禁止回复</center>"
End if
end If
Else
show_logmore="<a href=""wap.asp?loginhash="&Trim(request("loginhash"))&""">日志不存在！！！</a>"
End if
End Function
'*****************************
'及时生成回复信息静态页
'参数:被回复信息id
'****************************
Function CreateCmt(id)
Dim ExRefresh
Set ExRefresh=new Ex_RefreshCls
ExRefresh.CreateView id
End Function
Dim logmore
Sub save()
Dim cmttitle,cmtcontent,username,userpass,userhome,checkcode,rs,parentid,strsql,cmtid,CmtSql
Dim IsShow,Msg,ExSkin
Dim ExNow
ExNow=ExComm.ExNow()
cmtid=CLng(request.querystring("id"))
cmttitle=ExComm.F(request.Form("cmttitle"))
username=ExComm.F(trim(request.Form("username")))
userpass=ExComm.F(trim(request.Form("userpass")))
userhome=ExComm.F(request.Form("homepage"))
cmtcontent=ExComm.G(request.Form("aBody"))
checkcode=ExComm.G(request.Form("checkcode"))
if (session("excheckcode")<>checkcode Or Session("excheckcode")="") And Application(sn&"IsCheckCode")="是" then
ShowMsg "验证码不正确",""
end If
If Request.cookies(Application(Sn&"blogurl"))<>Sn And Application(sn&"IsCheckCode")="是" Then
ShowMsg "你是机器人吧?",""
End If
'身份验证开始
If userpass<>"" Then
If ExComm.CheckUNP(username,userpass) Then
If Len(userpass)<=20 Then
response.Cookies(Md5(sn))("uname")=ExComm.DeCode(username)
response.Cookies(Md5(sn))("upwd")=ExComm.DeCode(md5(userpass))
response.Cookies(Md5(sn))("homepage")=ExComm.DeCode(userhome)
session("user")=username
End If
Else
ShowMsg "帐号,密码不正确或您的帐号被锁定。",""
End If
Else
Rs=Conn.execute("select count(*) from Ex_user where username='"&username&"'")
If Rs(0)<>0 Then
ShowMsg "你使用的昵称已经被人注册，请更换其它昵称",""
End If
End If
'身份验证结束
If cmttitle<>"" And username<>"" And cmtcontent<>"" Then
If ExComm.CheckRe(ExComm.clearHtml(cmtcontent),Application(sn&"cmtmsgcheckre")) And Application(sn&"iscmtmsgcheck")="是" Then
IsShow="否"
Msg="\年博客开启了评论审核功能,此信息需要审核才能显示."
Else
IsShow="是"
Msg=""
Conn.execute("update Ex_log set cmt=cmt+1 where id="&cmtid)
'缓存评论数量加一
End If
CmtSql="insert into Ex_Comment (cmttitle,username,cmtcomment,addtime,addip,parentid,userpass,userhome,isshow) values ('"&cmttitle&"','"&username&"','"&FilterCmt(cmtcontent)&"',#"&ExNow&"#,'"&ExComm.GetIp()&"',"&cmtid&",'"&userpass&"','"&checkhttp(userhome)&"','"&isShow&"')"
Conn.Execute CmtSql
Application.lock
Application(sn&"cmttotal")=Application(sn&"cmttotal")+1
Application.unlock
'更新最新评论缓存
Set ExSkin=new Ex_SkinCls
ExSkin.RefreshSkinCache
Set ExSkin=Nothing
CreateCmt cmtid
ShowMsg "您已经成功发布了评论。",Application(Sn&"blogurl")&"/wap.asp?id="&cmtid
Else
ShowMsg "请填写完整",""
End if
End Sub
Sub edit
Dim cmttitle,cmtcontent,username,userpass,userhome,checkcode,strsql,ParentId,cmtid,CmtSql,CmtRs,IsShow,Msg
Dim ExNow
ExNow=ExComm.ExNow()
ParentId=CLng(request.querystring("id"))
cmtid=clng(request.querystring("editid"))
cmttitle=ExComm.F(request.Form("cmttitle"))
username=ExComm.F(trim(request.Form("username")))
userpass=ExComm.F(trim(request.Form("userpass")))
cmtcontent=ExComm.G(request.Form("aBody"))
userhome=ExComm.F(request.Form("homepage"))
checkcode=request.Form("checkcode")
if (session("excheckcode")<>checkcode Or Session("excheckcode")="") And Application(sn&"IsCheckCode")="是" then
ShowMsg "验证码不正确",""
end if
If cmttitle<>"" And username<>"" And userpass<>"" And cmtcontent<>"" Then
CmtRs=Conn.execute("select count(*) from Ex_User where username='"&username&"' and userpwd='"&userpass&"'")
If CmtRs(0)=0 Then
ShowMsg "你的帐号或密码不正确",""
End If
If ExComm.CheckRe(ExComm.clearHtml(cmtcontent),Application(sn&"cmtmsgcheckre")) And Application(sn&"iscmtmsgcheck")="是" Then
IsShow="否"
Msg="\n博客开启了评论审核功能,此信息需要审核才能显示."
Conn.execute("update Ex_log set cmt=cmt-1 where id="&ParentId)
'缓存评论数量加一
Else
IsShow="是"
Msg=""
End If
CmtSql="update Ex_Comment set cmttitle='"&cmttitle&"',username='"&username&"',cmtcomment='"&FilterCmt(cmtcontent)&"',addtime=#"&ExNow&"#,addip='"&ExComm.GetIp()&"',userpass='"&userpass&"',userhome='"&checkhttp(userhome)&"',isshow='"&IsShow&"' where id="&cmtid&""
Conn.Execute cmtSql
CreateCmt(CLng(request.querystring("id")))
response.write("<script>alert('您已经成功的修改评论."&Msg&"')</script>")
Else
ShowMsg "请填写完整",""
End If
response.Write("<script>window.location='wap.asp?id="&request("id")&"&loginhash="&Trim(request("loginhash"))&"'</script>")
End Sub
'********************************************
'回复信息过滤
'str--要过滤的字符串
'********************************************
Function filterCmt(str)
Dim re
Set re=new regexp
re.ignorecase=True
re.multiline=True
re.global=True
re.pattern="<script(.*?)</script>"
str=re.Replace(str,"")
re.pattern="<ifram(.*?)</ifram>"
str=re.Replace(str,"")
filterCmt=str
End Function
'********************************************
'修正连接 如果没有http://就添加
'str--要检测的字符串
'********************************************
function checkhttp(str)
if instr(str,"http://")=0 then
checkhttp="http://"&str
else
checkhttp=str
end if
end Function
%>