<% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// 作 者: 朱煊(zx.asd) '// 版权所有: RainbowSoft Studio '// 技术支持: rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_system_lib.asp '// 开始时间: 2004.07.25 '// 最后修改: 2007-1-4 '// 备 注: 库模块 '/////////////////////////////////////////////////////////////////////////////// '********************************************************* ' 目的： 定义TCategory类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TCategory Public ID Public Name Public Intro Public Order Public Count Public Alias Public Property Get Url If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Url = ZC_BLOG_HOST & Directory & FileName If ZC_MOONSOFT_PLUGIN_ENABLE And ZC_MOONSOFT_PLUGIN_ANONYMOUS Then Url = ZC_BLOG_HOST & Directory End If Else Url = ZC_BLOG_HOST & "catalog.asp?"& "cate=" & ID End If End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?cate=" & ID End Property Public Property Get HtmlName HtmlName=TransferHTML(Name,"[html-format]") End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Directory=ParseCustomDirectory(ZC_MOONSOFT_PLUGIN_REGEX,ZC_STATIC_DIRECTORY,StaticName,"","","","","","") Else Directory=ZC_STATIC_DIRECTORY End If Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = "cat_" & ID Else StaticName = Alias End If End Property Public Property Get FileName FileName = StaticName If ZC_MOONSOFT_PLUGIN_ENABLE And ZC_MOONSOFT_PLUGIN_ANONYMOUS Then FileName = "default" End If FileName = FileName & "." & ZC_STATIC_TYPE End Property Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(Order,"int",0) 'ID可以为0 Name=FilterSQL(Name) Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Name)=0 Then Post=False:Exit Function If ID=0 Then objConn.Execute("INSERT INTO [blog_Category]([cate_Name],[cate_Order],[cate_Intro]) VALUES ('"&Name&"',"&Order&",'"&Alias&"')") Dim objRS Set objRS=objConn.Execute("SELECT MAX([cate_ID]) FROM [blog_Category]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Category] set [cate_Name]='"&Name&"',[cate_Order]="&Order&",[cate_Intro]='"&Alias&"' WHERE [cate_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(cate_ID) Call CheckParameter(cate_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [cate_ID],[cate_Name],[cate_Intro],[cate_Order],[cate_Count] FROM [blog_Category] WHERE [cate_ID]=" & cate_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("cate_ID") Name=objRS("cate_Name") Alias=objRS("cate_Intro") Order=objRS("cate_Order") Count=objRS("cate_Count") LoadInfoByID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryCateInfo) If IsArray(aryCateInfo)=True Then ID=aryCateInfo(0) Name=aryCateInfo(1) Alias=aryCateInfo(2) Order=aryCateInfo(3) Count=aryCateInfo(4) End If LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function Dim objRS Set objRS=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE [log_CateID]=" & ID) If (Not objRS.bof) And (Not objRS.eof) Then ShowError(13) objConn.Execute("DELETE FROM [blog_Category] WHERE [cate_ID] =" & ID) Call DelFile() Del=True End Function Public Function DelFile() On Error Resume Next Dim fso, TxtFile Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & Directory & FileName) Then Set TxtFile = fso.GetFile(BlogPath & Directory & FileName) TxtFile.Delete End If Set fso=Nothing DelFile=True Err.Clear End Function Private Sub Class_Initialize() ID=0 End Sub End Class '********************************************************* '********************************************************* ' 目的： 定义TArticle类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TArticle Public ID Public CateID Public AuthorID Public Level Public Title Public Intro Public Content Public PostTime Public Tag Public Alias Public CommNums Public ViewNums Public TrackBackNums Private IP Public Istop Public Template_Article_Trackback Public Template_Article_Comment Public Template_Article_Commentpost Public Template_Article_Tag Public Template_Article_Navbar_L Public Template_Article_Navbar_R Public Template_Article_Commentpost_Verify Public Template_Article_Mutuality Public Template_Article_Single Public Template_Article_Multi Public Template_Article_Istop Public Template_Article_Search Public html Public htmlWAP Public Template_Article_Multi_WAP Public Template_Article_Single_WAP Private Ftemplate_Wap Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Public Property Let template_Wap(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template_Wap template_Wap = Ftemplate_Wap End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then If ZC_CUSTOM_DIRECTORY_ENABLE=True Then Directory=ParseCustomDirectory(ZC_CUSTOM_DIRECTORY_REGEX,ZC_STATIC_DIRECTORY,Categorys(CateID).StaticName,Users(AuthorID).StaticName,Year(PostTime),Month(PostTime),Day(PostTime),ID,StaticName) Else Directory=ZC_STATIC_DIRECTORY End If Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Property Get Url If Level=2 Then Url = ZC_BLOG_HOST & "view.asp?id=" & ID Else Url = ZC_BLOG_HOST & Directory & FileName If ZC_CUSTOM_DIRECTORY_ENABLE And ZC_CUSTOM_DIRECTORY_ANONYMOUS Then Url = ZC_BLOG_HOST & Directory End If End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = ID Else StaticName = Alias End If End Property Public Property Get FileName FileName = StaticName If ZC_CUSTOM_DIRECTORY_ENABLE And ZC_CUSTOM_DIRECTORY_ANONYMOUS Then FileName = "default" End If FileName = FileName & "." & ZC_STATIC_TYPE End Property Private FTrackBackKey Public Property Get TrackBackKey If IsNull(FTrackBackKey) Or IsEmpty(FTrackBackKey) Or FTrackBackKey="" Then FTrackBackKey=Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(ID) & CStr(TrackBackNums)),8) End If TrackBackKey=FTrackBackKey End Property Private FCommentKey Public Property Get CommentKey If IsNull(FCommentKey) Or IsEmpty(FCommentKey) Or FCommentKey="" Then FCommentKey=Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(ID)),8) End If CommentKey=FCommentKey End Property Public Property Get TrackBack TrackBack = ZC_BLOG_HOST & "cmd.asp?act=tb&id="& ID &"&key=" & TrackBackKey End Property Public Property Get PreTrackBack PreTrackBack = ZC_BLOG_HOST & "cmd.asp?act=gettburl&id=" & ID End Property Public Property Get TrackBackUrl TrackBackUrl = TrackBack End Property Public Property Get CommentUrl CommentUrl = Url & "#comment" End Property Public Property Get WfwComment WfwComment = ZC_BLOG_HOST End Property Public Property Get WfwCommentRss WfwCommentRss = ZC_BLOG_HOST & "sydication.asp?cmt=" & ID End Property Public Property Get CommentPostUrl CommentPostUrl = ZC_BLOG_HOST & "cmd.asp?act=cmt&key=" & CommentKey End Property Public Property Get HtmlContent HtmlContent=TransferHTML(UBBCode(Content,"[face][link][autolink][font][code][image][typeset][media][flash][key]"),"[html-japan][vbCrlf][upload]") End Property Public Property Get HtmlTitle HtmlTitle=TransferHTML(Title,"[html-japan][html-format]") End Property Public Property Get HtmlIntro HtmlIntro=TransferHTML(UBBCode(Intro,"[face][link][autolink][font][code][image][typeset][media][flash][key]"),"[html-japan][vbCrlf][upload]") End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get TagToName Dim t,i,s If Tag<>"" Then s=Tag s=Replace(s,"}","") t=Split(s,"{") For i=LBound(t) To UBound(t) If t(i)<>"" Then If IsEmpty(FirstTagIntro) Then FirstTagIntro=Tags(t(i)).Intro t(i)=Tags(t(i)).Name End If Next s=Trim(Join(t)) & " " If s=" " Then s="" TagToName=s End If End Property Public FirstTagIntro Public Function LoadInfobyID(log_ID) Call CheckParameter(log_ID,"int",0) Dim objRS Set objRS=objConn.Execute("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] FROM [blog_Article] WHERE [log_ID]=" & log_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("log_ID") Tag=objRS("log_Tag") CateID=objRS("log_CateID") Title=objRS("log_Title") Intro=objRS("log_Intro") Content=objRS("log_Content") Level=objRS("log_Level") AuthorID=objRS("log_AuthorID") PostTime=objRS("log_PostTime") CommNums=objRS("log_CommNums") ViewNums=objRS("log_ViewNums") TrackBackNums=objRS("log_TrackBackNums") Alias=objRS("log_Url") Istop=objRS("log_Istop") PostTime = Year(PostTime) & "-" & Month(PostTime) & "-" & Day(PostTime) & " " & Hour(PostTime) & ":" & Minute(PostTime) & ":" & Second(PostTime) Else Exit Function End If objRS.Close Set objRS=Nothing LoadInfobyID=True End Function Public Function LoadInfoByArray(aryArticleInfo) '[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] 'Array(objRS("log_ID"),objRS("log_Tag"),objRS("log_CateID"),objRS("log_Title"),objRS("log_Intro"),objRS("log_Content"),objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),objRS("log_CommNums"),objRS("log_ViewNums"),objRS("log_TrackBackNums"),objRS("log_Url")) If IsArray(aryArticleInfo)=True Then ID=aryArticleInfo(0) Tag=aryArticleInfo(1) CateID=aryArticleInfo(2) Title=aryArticleInfo(3) Intro=aryArticleInfo(4) Content=aryArticleInfo(5) Level=aryArticleInfo(6) AuthorID=aryArticleInfo(7) PostTime=aryArticleInfo(8) CommNums=aryArticleInfo(9) ViewNums=aryArticleInfo(10) TrackBackNums=aryArticleInfo(11) Alias=aryArticleInfo(12) Istop=aryArticleInfo(13) PostTime = Year(PostTime) & "-" & Month(PostTime) & "-" & Day(PostTime) & " " & Hour(PostTime) & ":" & Minute(PostTime) & ":" & Second(PostTime) End If LoadInfoByArray=True End Function Public Function Export(intType) Call Export_CMTandTB Call Export_Mutuality Call Export_NavBar Call Export_CommentPost Call Export_Tag Application.Lock Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE") Template_Article_Multi=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-MULTI") Template_Article_Istop=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-ISTOP") Template_Article_Multi_WAP=Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI") Template_Article_Single_WAP =Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE") Application.UnLock Template_Article_Single=Replace(Template_Article_Single,"<#template:article_trackback#>",Template_Article_Trackback) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_comment#>",Template_Article_Comment) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_commentpost#>",Template_Article_Commentpost) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_tag#>",Template_Article_Tag) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_l#>",Template_Article_Navbar_L) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_r#>",Template_Article_Navbar_R) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_mutuality#>",Template_Article_Mutuality) Template_Article_Multi=Replace(Template_Article_Multi,"<#template:article_tag#>",Template_Article_Tag) Template_Article_Istop=Replace(Template_Article_Istop,"<#template:article_tag#>",Template_Article_Tag) Dim aryTemplateTagsName(47) Dim aryTemplateTagsValue(47) Dim i,j aryTemplateTagsName(1)="<#article/id#>" aryTemplateTagsValue(1)=ID aryTemplateTagsName(2)="<#article/level#>" aryTemplateTagsValue(2)=Level aryTemplateTagsName(3)="<#article/title#>" If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(3)=Search(Title,Request.QueryString("q")) Else aryTemplateTagsValue(3)=HtmlTitle End If aryTemplateTagsName(4)="<#article/intro#>" If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(4)=Search(TransferHTML(Intro & Content,"[html-format]"),Request.QueryString("q")) Else If Level=2 Then aryTemplateTagsValue(4)=ZC_MSG043 Else aryTemplateTagsValue(4)=HtmlIntro End If End If aryTemplateTagsName(5)="<#article/content#>" aryTemplateTagsValue(5)=HtmlContent If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(5)=aryTemplateTagsValue(4) End If aryTemplateTagsName(6)="<#article/posttime#>" aryTemplateTagsValue(6)=PostTime aryTemplateTagsName(7)="<#article/commnums#>" aryTemplateTagsValue(7)=Commnums aryTemplateTagsName(8)="<#article/viewnums#>" aryTemplateTagsValue(8)=Viewnums aryTemplateTagsName(9)="<#article/trackbacknums#>" aryTemplateTagsValue(9)=Trackbacknums aryTemplateTagsName(10)="<#article/trackback_url#>" aryTemplateTagsValue(10)=TrackBack aryTemplateTagsName(11)="<#article/url#>" aryTemplateTagsValue(11)=HtmlUrl aryTemplateTagsName(12)="<#article/category/id#>" aryTemplateTagsValue(12)=Categorys(CateID).ID aryTemplateTagsName(13)="<#article/category/name#>" aryTemplateTagsValue(13)=Categorys(CateID).HtmlName aryTemplateTagsName(15)="<#article/category/order#>" aryTemplateTagsValue(15)=Categorys(CateID).Order aryTemplateTagsName(16)="<#article/category/count#>" aryTemplateTagsValue(16)=Categorys(CateID).Count aryTemplateTagsName(17)="<#article/category/url#>" aryTemplateTagsValue(17)=Categorys(CateID).HtmlUrl aryTemplateTagsName(18)="<#article/author/id#>" aryTemplateTagsValue(18)=Users(AuthorID).ID aryTemplateTagsName(19)="<#article/author/name#>" aryTemplateTagsValue(19)=Users(AuthorID).Name aryTemplateTagsName(20)="<#article/author/level#>" aryTemplateTagsValue(20)=ZVA_User_Level_Name(Users(AuthorID).Level) aryTemplateTagsName(21)="<#article/author/email#>" aryTemplateTagsValue(21)=Users(AuthorID).Email aryTemplateTagsName(22)="<#article/author/homepage#>" aryTemplateTagsValue(22)=Users(AuthorID).HomePage aryTemplateTagsName(23)="<#article/author/count#>" aryTemplateTagsValue(23)=Users(AuthorID).Count aryTemplateTagsName(24)="<#article/author/url#>" aryTemplateTagsValue(24)=Users(AuthorID).HtmlUrl aryTemplateTagsName(25)="<#article/posttime/longdate#>" aryTemplateTagsValue(25)=FormatDateTime(PostTime,vbLongDate) aryTemplateTagsName(26)="<#article/posttime/shortdate#>" aryTemplateTagsValue(26)=FormatDateTime(PostTime,vbShortDate) aryTemplateTagsName(27)="<#article/posttime/longtime#>" aryTemplateTagsValue(27)=FormatDateTime(PostTime,vbLongTime) aryTemplateTagsName(28)="<#article/posttime/shorttime#>" aryTemplateTagsValue(28)=FormatDateTime(PostTime,vbShortTime) aryTemplateTagsName(29)="<#article/posttime/year#>" aryTemplateTagsValue(29)=Year(PostTime) aryTemplateTagsName(30)="<#article/posttime/month#>" aryTemplateTagsValue(30)=Month(PostTime) aryTemplateTagsName(31)="<#article/posttime/monthname#>" aryTemplateTagsValue(31)=ZVA_Month_Abbr(Month(PostTime)) aryTemplateTagsName(32)="<#article/posttime/day#>" aryTemplateTagsValue(32)=Day(PostTime) aryTemplateTagsName(33)="<#article/posttime/weekday#>" aryTemplateTagsValue(33)=Weekday(PostTime) aryTemplateTagsName(34)="<#article/posttime/weekdayname#>" aryTemplateTagsValue(34)=ZVA_Week_Abbr(Weekday(PostTime)) aryTemplateTagsName(35)="<#article/posttime/hour#>" aryTemplateTagsValue(35)=Hour(PostTime) aryTemplateTagsName(36)="<#article/posttime/minute#>" aryTemplateTagsValue(36)=Minute(PostTime) aryTemplateTagsName(37)="<#article/posttime/second#>" aryTemplateTagsValue(37)=Second(PostTime) aryTemplateTagsName(38)="<#article/commentrss#>" aryTemplateTagsValue(38)=WfwCommentRss aryTemplateTagsName(39)="<#article/commentposturl#>" aryTemplateTagsValue(39)=CommentPostUrl aryTemplateTagsName(40)="<#article/pretrackback_url#>" aryTemplateTagsValue(40)=PreTrackBack aryTemplateTagsName(41)="<#article/trackbackkey#>" aryTemplateTagsValue(41)=TrackBackKey aryTemplateTagsName(42)="<#article/commentkey#>" aryTemplateTagsValue(42)=CommentKey aryTemplateTagsName(43)="<#article/staticname#>" aryTemplateTagsValue(43)=StaticName aryTemplateTagsName(44)="<#article/category/staticname#>" aryTemplateTagsValue(44)=Categorys(CateID).StaticName aryTemplateTagsName(45)="<#article/author/staticname#>" aryTemplateTagsValue(45)=Users(AuthorID).StaticName aryTemplateTagsName(46)="<#article/tagtoname#>" aryTemplateTagsValue(46)=TagToName aryTemplateTagsName(47)="<#article/firsttagintro#>" aryTemplateTagsValue(47)=FirstTagIntro j=47 For i=1 to j Template_Article_Istop=Replace(Template_Article_Istop,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Multi=Replace(Template_Article_Multi,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Single=Replace(Template_Article_Single,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Multi_WAP = Replace(Template_Article_Multi_WAP, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Template_Article_Single_WAP = Replace(Template_Article_Single_WAP, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Ftemplate = Replace(Ftemplate, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Next If intType=ZC_DISPLAY_MODE_SEARCH Then Template_Article_Search=Template_Article_Multi End If Export=True End Function Public Function Export_Tag 'Tag Dim t,i,s,j If Tag<>"" Then Tag=Replace(Tag,"}","") t=Split(Tag,"{") For i=LBound(t) To UBound(t) If t(i)<>"" Then Application.Lock s=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TAG") Application.UnLock Template_Article_Tag=Template_Article_Tag & Tags(t(i)).MakeTemplate(s) End If Next End If Export_Tag=True End Function Function Export_CMTandTB() If CommNums + TrackBackNums > 0 Then Dim strC_Count,strC,strT_Count,strT Dim objComment Dim objTrackBack Dim i Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=" & ID &" UNION ALL SELECT [tb_ID],[log_ID],'',[tb_Title],[tb_Excerpt],[tb_Blog],[tb_URL],[tb_PostTime],[tb_IP],[tb_Agent] from [blog_TrackBack] WHERE [blog_TrackBack].[log_ID]="& ID & " ORDER BY [comm_ID],[comm_PostTime]" objRS.Open() If (not objRS.bof) And (not objRS.eof) Then ReDim aryArticleExportMsgTB(objRS.RecordCount) For i=1 To objRS.RecordCount If IsNumeric(objRS("comm_AuthorID")) Then Set objComment=New TComment objComment.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_AuthorID"),objRS("comm_Author"),objRS("comm_Content"),objRS("comm_Email"),objRS("comm_HomePage"),objRS("comm_PostTime"),"","")) strC_Count=strC_Count+1 Application.Lock strC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT") Application.UnLock objComment.Count=strC_Count strC=objComment.MakeTemplate(strC) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Comment=strC & Template_Article_Comment Else Template_Article_Comment=Template_Article_Comment & strC End If Set objComment=Nothing Else Set objTrackBack=New TTrackBack objTrackBack.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_HomePage"),objRS("comm_Author"),objRS("comm_Email"),objRS("comm_Content"),objRS("comm_PostTime"),"","")) strT_Count=strT_Count+1 Application.Lock strT=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TRACKBACK") Application.UnLock objTrackBack.Count=strT_Count strT=objTrackBack.MakeTemplate(strT) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Trackback=strT & Template_Article_Trackback Else Template_Article_Trackback=Template_Article_Trackback & strT End If Set objTrackBack=Nothing End If objRS.MoveNext If objRS.eof Then Exit For Next End if objRS.Close() Set objRS=Nothing End If Template_Article_Comment=Template_Article_Comment & "

" Export_CMTandTB=True End Function Function Export_NavBar() If ZC_USE_NAVIGATE_ARTICLE=False Then Template_Article_Navbar_L="" Template_Article_Navbar_R="" Export_NavBar=True Exit Function End If Dim s,t Dim strName Dim strUrl Dim objNavArticle Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [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] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]<#" & PostTime & "#) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then Set objNavArticle=New TArticle If objNavArticle.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))) Then strName=objNavArticle.Title strUrl=objNavArticle.Url End If Set objNavArticle=Nothing Application.Lock s=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_L") Application.UnLock s=Replace(s,"<#article/nav_l/url#>",strUrl) s=Replace(s,"<#article/nav_l/name#>",strName) Template_Article_Navbar_L=s End If Set objRS=Nothing Set objRS=objConn.Execute("SELECT TOP 1 [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] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]>#" & PostTime & "#) ORDER BY [log_PostTime] ASC") If (Not objRS.bof) And (Not objRS.eof) Then Set objNavArticle=New TArticle If objNavArticle.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))) Then strName=objNavArticle.Title strUrl=objNavArticle.Url End If Set objNavArticle=Nothing Application.Lock t=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_R") Application.UnLock t=Replace(t,"<#article/nav_r/url#>",strUrl) t=Replace(t,"<#article/nav_r/name#>",strName) Template_Article_Navbar_R=t End If Set objRS=Nothing Export_NavBar=True End Function Function Export_CommentPost() If Level<4 Then Exit Function Application.Lock Template_Article_Commentpost=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST") Application.UnLock If ZC_COMMENT_VERIFY_ENABLE=True Then Application.Lock Template_Article_Commentpost_Verify=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY") Application.UnLock End If Template_Article_Commentpost=Replace(Template_Article_Commentpost,"<#template:article_commentpost-verify#>",Template_Article_Commentpost_Verify) End Function '相关文章的生成 Function Export_Mutuality() 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 Set objRS=Server.CreateObject("ADODB.Recordset") strSQL="SELECT TOP "& ZC_MUTUALITY_COUNT &" [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_Level]>2) AND [log_ID]<"& ID strSQL = strSQL & " AND (" Dim aryTAGs Tag=Replace(Tag,"}","") aryTAGs=Split(Tag,"{") For j = LBound(aryTAGs) To UBound(aryTAGs) If aryTAGs(j)<>"" Then strSQL = strSQL & "([log_Tag] Like '%{"&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_MUTUALITY_COUNT '相关文章数目，可自行设定 Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS("log_ID"),objRS("log_Tag"),objRS("log_CateID"),objRS("log_Title"),"","",objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),objRS("log_CommNums"),objRS("log_ViewNums"),objRS("log_TrackBackNums"),objRS("log_Url"),objRS("log_Istop"))) Then strCC_Count=strCC_Count+1 strCC_ID=objArticle.ID strCC_Url=objArticle.Url strCC_PostTime=objArticle.PostTime strCC_Title=objArticle.Title Application.Lock strCC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_Mutuality") Application.UnLock strCC=Replace(strCC,"<#article/mutuality/id#>",strCC_ID) strCC=Replace(strCC,"<#article/mutuality/url#>",strCC_Url) strCC=Replace(strCC,"<#article/mutuality/posttime#>",strCC_PostTime) strCC=Replace(strCC,"<#article/mutuality/name#>",strCC_Title) Template_Article_Mutuality=Template_Article_Mutuality & strCC End If objRS.MoveNext If objRS.eof Then Exit For Set objArticle=Nothing Next End if objRS.Close() Set objRS=Nothing End If Export_Mutuality=True End Function Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(CateID,"int",0) Call CheckParameter(AuthorID,"int",0) Call CheckParameter(Level,"int",0) Call CheckParameter(PostTime,"dtm",Empty) Call CheckParameter(Istop,"bool",False) 'ID可以为0 If (CateID=0) Then Post=False:Exit Function If (AuthorID=0) Then Post=False:Exit Function If IsEmpty(PostTime) Then Post=False:Exit Function Title=FilterSQL(Title) Intro=FilterSQL(Intro) Content=FilterSQL(Content) Tag=FilterSQL(Tag) IP=FilterSQL(IP) Title=TransferHTML(Title,"[japan-html]") Intro=TransferHTML(Intro,"[japan-html]") Content=TransferHTML(Content,"[japan-html]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) '检查“别名”是否有重名 If Alias<>"" Then Dim objRSsub Set objRSsub=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE [log_ID]<>"& ID &" AND [log_Url]='"& Alias &"'" ) If (Not objRSsub.bof) And (Not objRSsub.eof) Then Randomize Alias=Alias & "_" & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) End If Set objRSsub=Nothing End If If Len(Title)=0 Then Post=False:Exit Function If Len(Content)=0 Then Post=False:Exit Function If Len(Intro)=0 Then Intro=Left(Content,ZC_TB_EXCERPT_MAX) & "..." If ID=0 Then objConn.Execute("INSERT INTO [blog_Article]([log_CateID],[log_AuthorID],[log_Level],[log_Title],[log_Intro],[log_Content],[log_PostTime],[log_IP],[log_Tag],[log_Url],[log_Istop]) VALUES ("&CateID&","&AuthorID&","&Level&",'"&Title&"','"&Intro&"','"&Content&"','"&PostTime&"','"&IP&"','"&Tag&"','"&Alias&"',"&Istop&")") Dim objRS Set objRS=objConn.Execute("SELECT MAX([log_ID]) FROM [blog_Article]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Article] SET [log_CateID]="&CateID&",[log_AuthorID]="&AuthorID&",[log_Level]="&Level&",[log_Title]='"&Title&"',[log_Intro]='"&Intro&"',[log_Content]='"&Content&"',[log_PostTime]='"&PostTime&"',[log_IP]='"&IP&"',[log_Tag]='"&Tag&"',[log_Url]='"&Alias&"',[log_Istop]="&Istop&" WHERE [log_ID] =" & ID) End If Post=True End Function Public Function DelFile() On Error Resume Next Dim fso, TxtFile Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & Directory & FileName) Then Set TxtFile = fso.GetFile(BlogPath & Directory & FileName) TxtFile.Delete End If Set fso=Nothing Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "/cache/" & ID & ".html") Then Set TxtFile = fso.GetFile(BlogPath & "/cache/" & ID & ".html") TxtFile.Delete End If Set fso=Nothing DelFile=True Err.Clear End Function Public Function Del() Call DelFile() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Article] WHERE [log_ID] =" & ID) objConn.Execute("DELETE FROM [blog_Comment] WHERE [log_ID] =" & ID) objConn.Execute("DELETE FROM [blog_TrackBack] WHERE [log_ID] =" & ID) Del=True End Function Public Function Statistic() Dim objRS Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Comment] WHERE [log_ID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then CommNums=objRS(0) End If objConn.Execute("UPDATE [blog_Article] SET [log_CommNums]="& CommNums &" WHERE [log_ID] =" & ID) Set objRS=Nothing Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_TrackBack] WHERE [log_ID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then TrackBackNums=objRS(0) End If objConn.Execute("UPDATE [blog_Article] SET [log_TrackBackNums]="& TrackBackNums &" WHERE [log_ID] =" & ID) Set objRS=Nothing Statistic=True End Function Function Build() Dim aryTemplateTagsName Dim aryTemplateTagsValue Dim i,j htmlWAP = Template_Article_Single_WAP If IsEmpty(html) Then html=template html=Replace(html,"<#template:article-single#>",Template_Article_Single) Application.Lock aryTemplateTagsName=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName(0)="BlogTitle" aryTemplateTagsValue(0)=Title j=UBound(aryTemplateTagsName) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName(i) & "#>",aryTemplateTagsValue(i)) htmlWAP = Replace(htmlWAP, "<#" & aryTemplateTagsName(i) & "#>", aryTemplateTagsValue(i)) Next Build=True End Function Function SetVar(TemplateTag,TemplateValue) If IsEmpty(html) Then html=template html=Replace(html,"<#" & TemplateTag & "#>",TemplateValue) End Function Function Save() If Not(Level>2) Then Save=True:Exit Function Dim objStream html=TransferHTML(html,"[no-asp]") If ZC_STATIC_TYPE="asp" Then html="<"&"%@ CODEPAGE=65001 %"&">" & html End If If ZC_CUSTOM_DIRECTORY_ENABLE=True Then Call CreatDirectoryByCustomDirectory(Directory) End If Call SaveToFile(BlogPath & Directory & FileName,html,"utf-8",False) Save=True End Function Function SaveCache() If Not(Level>1) Then SaveCache=True:Exit Function Dim strList If Istop Then strList=Template_Article_Istop Else strList=Template_Article_Multi End If strList=TransferHTML(strList,"[no-asp]") Call SaveToFile(BlogPath & "/cache/" & ID & ".html",strList,"utf-8",False) SaveCache=True End Function Function LoadCache() Dim objStream Template_Article_Multi=LoadFromFile(BlogPath & "/CACHE/" & ID & ".html","utf-8") LoadCache=True End Function Private Sub Class_Initialize() PostTime=Now() ID=0 CateID=0 AuthorID=0 Level=4'默认为普通 Title=ZC_MSG099 IP=Request.Servervariables("REMOTE_ADDR") Ftemplate_Wap=Empty Ftemplate=Empty End Sub End Class '********************************************************* '********************************************************* ' 目的： 定义TArticleList类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TArticleList Public Title Public FileName Public AllList Public AuthList Public CateList Public TagsList Public aryArticle Public aryArticleList() Public Template_PageBar Public Template_Article_Multi Public Template_PageBar_Next Public Template_PageBar_Previous Public Template_Calendar Public TemplateTags_ArticleList_Author_ID Public TemplateTags_ArticleList_Tags_ID Public TemplateTags_ArticleList_Category_ID Public TemplateTags_ArticleList_Date_ShortDate Public TemplateTags_ArticleList_Date_Year Public TemplateTags_ArticleList_Date_Month Public TemplateTags_ArticleList_Date_Day Public TemplateTags_ArticleList_Page_Now Public TemplateTags_ArticleList_Page_All Public html Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then Directory=ZC_STATIC_DIRECTORY Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Function Export(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim i,j,k,l Dim objRS Dim intPageCount Dim objArticle Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) Title=ZC_BLOG_SUBTITLE Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn '////////////////////////// 'ontop 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] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=True) AND ([log_Level]>1)" objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = 1 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))) Then If objArticle.Export(intType)= True Then aryArticleList(i)=objArticle.Template_Article_Istop End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() k=Join(aryArticleList) Erase aryArticleList '////////////////////////// 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] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=False) AND ([log_Level]>1)" If Not IsEmpty(intCateId) Then objRS.Source=objRS.Source & "AND([log_CateID]="&intCateId&")" On Error Resume Next Title=Categorys(intCateId).Name TemplateTags_ArticleList_Category_ID=Categorys(intCateId).ID 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 TemplateTags_ArticleList_Author_ID=Users(intAuthorId).ID Err.Clear End if If IsDate(dtmYearMonth) Then Dim y Dim m Dim d Dim ny Dim nm If IsDate(dtmYearMonth) Then 'dtmYearMonth=CDate(dtmYearMonth) Else Call showError(3) End If y=Year(dtmYearMonth) m=Month(dtmYearMonth) d=Day(dtmYearMonth) TemplateTags_ArticleList_Date_ShortDate=dtmYearMonth TemplateTags_ArticleList_Date_Year=y TemplateTags_ArticleList_Date_Month=m TemplateTags_ArticleList_Date_Day=d ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 If InstrRev(CStr(dtmYearMonth),"-")>=7 Then objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&") AND(Day([log_PostTime])="&d&")" Else objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&")" End If Template_Calendar="" 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 & "}%')" TemplateTags_ArticleList_Tags_ID=Tag.ID End If End If Next Err.Clear Title=strTagsName End If objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT 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))) Then If objArticle.Export(intType)= True Then aryArticleList(i)=objArticle.Template_Article_Multi End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=k & Join(aryArticleList) TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intPageCount Call ExportBar(intPage,intPageCount,intCateId,intAuthorId,dtmYearMonth,strTagsName) Export=True End Function Public Function ExportByCache(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim strType Dim i,j,s,t,k,l Dim intAllPage Dim intTagsID Dim objArticle Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) i=InStr(1,TagsList,vbTab & strTagsName & vbVerticalTab,vbBinaryCompare) If i>0 Then j=Left(TagsList,i-1) i=InStrRev(j,vbTab) intTagsID=Right(j,Len(j)-i) Call CheckParameter(intTagsID,"int",Empty) End If '////////////////////////// 'ontop If True Then strType="Istop" & "Page1" & "[" s="Istop" & "Page" i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next k=Join(aryArticleList) Erase aryArticleList ReDim aryArticle(0) End If End If '//////////////////////////// strType="All" & "Page" & CStr(intPage) & "[" s="All" & "Page" Title=ZC_BLOG_SUBTITLE i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next Template_Article_Multi=k & Join(aryArticleList) End If TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intAllPage Call ExportBar(intPage,intAllPage,intCateId,intAuthorId,dtmYearMonth,strTagsName) ExportByCache=True End Function Public Function ExportByMixed(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim strType Dim i,j,k,l,s Dim objRS Dim intPageCount Dim objArticle Dim intAllPage Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) Title=ZC_BLOG_SUBTITLE Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn '////////////////////////// 'ontop If True Then strType="Istop" & "Page1" & "[" s="Istop" & "Page" i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next k=Join(aryArticleList) Erase aryArticleList ReDim aryArticle(0) End If End If '//////////////////////////// objRS.Source="SELECT [log_ID] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=False) AND ([log_Level]>1)" If Not IsEmpty(intCateId) Then objRS.Source=objRS.Source & "AND([log_CateID]="&intCateId&")" On Error Resume Next Title=Categorys(intCateId).Name TemplateTags_ArticleList_Category_ID=Categorys(intCateId).ID 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 TemplateTags_ArticleList_Author_ID=Users(intAuthorId).ID Err.Clear End If If IsDate(dtmYearMonth) Then Dim y Dim m Dim d Dim ny Dim nm If IsDate(dtmYearMonth) Then ' dtmYearMonth=CDate(dtmYearMonth) Else Call showError(3) End If y=Year(dtmYearMonth) m=Month(dtmYearMonth) d=Day(dtmYearMonth) TemplateTags_ArticleList_Date_ShortDate=dtmYearMonth TemplateTags_ArticleList_Date_Year=y TemplateTags_ArticleList_Date_Month=m TemplateTags_ArticleList_Date_Day=d ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 If InstrRev(CStr(dtmYearMonth),"-")>=7 Then objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&") AND(Day([log_PostTime])="&d&")" Else objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&")" End If Template_Calendar="" 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 & "}%')" TemplateTags_ArticleList_Tags_ID=Tag.ID End If End If Next Err.Clear Title=strTagsName End If objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = intPage For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle = New TArticle objArticle.ID=objRS(0) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=k & Join(aryArticleList) TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intPageCount Call ExportBar(intPage,intPageCount,intCateId,intAuthorId,dtmYearMonth,strTagsName) ExportByMixed=True End Function Public Function Build() Dim aryTemplateTagsName Dim aryTemplateTagsValue Dim i,j If IsEmpty(html) Then html=template html=Replace(html,"<#template:article-multi#>",Template_Article_Multi) html=Replace(html,"<#template:pagebar#>",Template_PageBar) html=Replace(html,"<#template:pagebar_next#>",Template_PageBar_Next) html=Replace(html,"<#template:pagebar_previous#>",Template_PageBar_Previous) html=Replace(html,"<#articlelist/author/id#>",TemplateTags_ArticleList_Author_ID) html=Replace(html,"<#articlelist/tags/id#>",TemplateTags_ArticleList_Tags_ID) html=Replace(html,"<#articlelist/category/id#>",TemplateTags_ArticleList_Category_ID) html=Replace(html,"<#articlelist/date/year#>",TemplateTags_ArticleList_Date_Year) html=Replace(html,"<#articlelist/date/month#>",TemplateTags_ArticleList_Date_Month) html=Replace(html,"<#articlelist/date/day#>",TemplateTags_ArticleList_Date_Day) html=Replace(html,"<#articlelist/date/shortdate#>",TemplateTags_ArticleList_Date_ShortDate) html=Replace(html,"<#articlelist/page/now#>",TemplateTags_ArticleList_Page_Now) html=Replace(html,"<#articlelist/page/all#>",TemplateTags_ArticleList_Page_All) Application.Lock aryTemplateTagsName=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName(0)="BlogTitle" aryTemplateTagsValue(0)=Title j=UBound(aryTemplateTagsName) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName(i) & "#>",aryTemplateTagsValue(i)) Next If IsEmpty(Template_Calendar) Or Len(Template_Calendar)=0 Then For i=1 to j If aryTemplateTagsName(i)="CACHE_INCLUDE_CALENDAR" Then Template_Calendar=aryTemplateTagsValue(i) End If Next End If html=Replace(html,"<#CACHE_INCLUDE_CALENDAR_NOW#>",Template_Calendar) Build=True End Function Function Save() html=TransferHTML(html,"[no-asp]") If ZC_STATIC_TYPE="asp" Then html="<"&"%@ CODEPAGE=65001 %"&">" & html End If If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Call CreatDirectoryByCustomDirectory(Directory) End If Call SaveToFile(BlogPath & Directory & FileName,html,"utf-8",False) Save=True End Function Function SetVar(TemplateTag,TemplateValue) If IsEmpty(html) Then html=template html=Replace(html,"<#" & TemplateTag & "#>",TemplateValue) End Function Public Function Search(strQuestion) Dim i Dim j Dim s Dim objRS Dim intPageCount Dim objArticle strQuestion=Trim(strQuestion) If Len(strQuestion)=0 Then Search=True:Exit Function If CheckRegExp(strQuestion,"[nojapan]") Then Exit Function strQuestion=FilterSQL(strQuestion) 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] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>2)" objRS.Source=objRS.Source & "AND (([log_Title] LIKE '%" & strQuestion & "%') OR ([log_Intro] LIKE '%" & strQuestion & "%') OR ([log_Content] LIKE '%" & strQuestion & "%')) " objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() s=Replace(Replace(ZC_MSG086,"%s","" & TransferHTML(Replace(strQuestion,Chr(39)&Chr(39),Chr(39)),"[html-format]") & "",vbTextCompare,1),"%s","" & objRS.RecordCount & "") If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_SEARCH_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = 1 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))) Then If objArticle.Export(ZC_DISPLAY_MODE_SEARCH)= True Then aryArticleList(i)=objArticle.Template_Article_Search End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=Join(aryArticleList) Search=True End Function Public Function ExportBar(intNowPage,intAllPage,intCateId,intAuthorId,dtmYearMonth,strTagsName) Dim i Dim s Dim t Dim strPageBar If Not IsEmpty(intCateId) Then t=t & "cate=" & intCateId & "&" If Not IsEmpty(dtmYearMonth) Then t=t & "date=" & Year(dtmYearMonth) & "-" & Month(dtmYearMonth) If InstrRev(CStr(dtmYearMonth),"-")>=7 Then t=t & "-" & Day(dtmYearMonth) End If t=t & "&" End If If Not IsEmpty(intAuthorId) Then t=t & "auth=" & intAuthorId & "&" If Not (strTagsName="") Then t=t & "tags=" & Server.URLEncode(strTagsName) & "&" If intAllPage>0 Then Dim a,b s=ZC_BLOG_HOST & "catalog.asp?"& t &"page=1" Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG285) Template_PageBar=Template_PageBar & strPageBar If intAllPage>ZC_PAGEBAR_COUNT Then a=intNowPage b=intNowPage+ZC_PAGEBAR_COUNT If a>ZC_PAGEBAR_COUNT Then a=a-1:b=b-1 If b>intAllPage Then b=intAllPage:a=intAllPage-ZC_PAGEBAR_COUNT Else a=1:b=intAllPage End If For i=a to b s=ZC_BLOG_HOST & "catalog.asp?"& t &"page="& i Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock If i=intNowPage then Template_PageBar=Template_PageBar & "" & i & "" Else strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",i) Template_PageBar=Template_PageBar & strPageBar End If Next s=ZC_BLOG_HOST & "catalog.asp?"& t &"page="& intAllPage Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG286) Template_PageBar=Template_PageBar & strPageBar If intNowPage=1 Then Template_PageBar_Previous="" Else Template_PageBar_Previous=""&ZC_MSG156&"" End If If intNowPage=intAllPage Then Template_PageBar_Next="" Else Template_PageBar_Next=""&ZC_MSG155&"" End If End If ExportBar=True End Function Public Function LoadCache() Dim strContent strContent="" strContent=LoadFromFile(BlogPath & "/CACHE/cache_list_"&ZC_BLOG_CLSID&".html","utf-8") AllList=strContent LoadCache=True End Function Private Sub Class_Initialize() Redim Article(ZC_DISPLAY_COUNT) End Sub End Class '********************************************************* '********************************************************* ' 目的： 定义TUser类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TUser Public ID Public Level Public Name Public Password Public Alias Public Sex Public Email Public MSN Public QQ Public HomePage Public Intro Public Count Public LastVisitTime Public LastVisitIP Public Property Get Url Url = ZC_BLOG_HOST & "catalog.asp?"& "auth=" & ID End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?user=" & ID End Property Private FLoginType Public Property Let LoginType(strLoginType) If (strLoginType="Form") Or (strLoginType="QueryString") Or (strLoginType="Self") Then FLoginType=strLoginType Else FLoginType="Cookies" End If End Property Public Property Get LoginType If IsEmpty(FLoginType)=True Then LoginType="Cookies" Else LoginType = FLoginType End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = "user_" & ID Else StaticName = Alias End If End Property Public Function Verify() Dim strUserName Dim strPassWord If LoginType="Cookies" Then strPassWord=Request.Cookies("password") If (strPassWord="") Then Exit Function strUserName=vbsunescape(Request.Cookies("username")) If (strUserName="") Then Exit Function ElseIf LoginType="Form" Then strPassWord=Request.Form("password") If (strPassWord="") Then Exit Function strUserName=Request.Form("username") If (strUserName="") Then Exit Function ElseIf LoginType="QueryString" Then strPassWord=Request.QueryString("password") If (strPassWord="") Then Exit Function strUserName=Request.QueryString("username") If (strUserName="") Then Exit Function ElseIf LoginType="Self" Then strPassWord=Password If (strPassWord="") Then Exit Function strUserName=Name If (strUserName="") Then Exit Function Else Exit Function End If strUserName=FilterSQL(strUserName) strPassWord=FilterSQL(strPassWord) '校检 If Len(strUserName) >ZC_USERNAME_MAX Then Call ShowError(7) If Len(strPassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(strUserName,"[username]") Then Call ShowError(7) If Not CheckRegExp(strPassWord,"[password]") Then Call ShowError(7) Dim objRS Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Level],[mem_Password] FROM [blog_Member] WHERE [mem_Name]='"&strUserName & "'" ) If (Not objRS.Bof) And (Not objRS.Eof) Then If StrComp(strPassWord,objRS("mem_Password"))=0 Then ID=objRS("mem_ID") LoadInfobyID(ID) Verify=True Else If LoginType="Cookies" Then Response.Cookies("password")="" End If Else If LoginType="Cookies" Then Response.Cookies("password")="" End If objRS.Close Set objRS=Nothing End Function Function LoadInfobyID(user_ID) Call CheckParameter(user_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Name],[mem_Level],[mem_Password],[mem_Email],[mem_HomePage],[mem_PostLogs],[mem_Intro] FROM [blog_Member] WHERE [mem_ID]=" & user_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("mem_ID") Name=objRS("mem_Name") Level=objRS("mem_Level") Password=objRS("mem_Password") Email=objRS("mem_Email") HomePage=objRS("mem_HomePage") Count=objRS("mem_PostLogs") Alias=objRS("mem_Intro") If IsNull(Email) Or IsEmpty(Email) Or Len(Email)=0 Then Email="a@b.com" If IsNull(HomePage) Then HomePage="" If IsNull(Alias) Then Alias="" LoadInfobyID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryUserInfo) If IsArray(aryUserInfo)=True Then ID=aryUserInfo(0) Name=aryUserInfo(1) Level=aryUserInfo(2) Password=aryUserInfo(3) Email=aryUserInfo(4) HomePage=aryUserInfo(5) Count=aryUserInfo(6) Alias=aryUserInfo(7) End If If IsNull(Email) Or IsEmpty(Email) Or Len(Email)=0 Then Email="a@b.com" If IsNull(HomePage) Then HomePage="" If IsNull(Alias) Then Alias="" LoadInfoByArray=True End Function Function Edit(currentUser) Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) If ((Level<1) Or (Level>5)) Then Call ShowError(16) If (Name="") Then Call ShowError(7) If Len(Name) >ZC_USERNAME_MAX Then Call ShowError(7) If Not CheckRegExp(Name,"[username]") Then Call ShowError(7) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Email)=0 Then Call ShowError(29) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(29) If Not CheckRegExp(Email,"[email]") Then Call ShowError(29) IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If If ID=0 Then If Level <= currentUser.Level Then ShowError(6) If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) objConn.Execute("INSERT INTO [blog_Member]([mem_Level],[mem_Name],[mem_PassWord],[mem_Email],[mem_HomePage],[mem_Intro]) VALUES ("&Level&",'"&Name&"','"&PassWord&"','"&Email&"','"&HomePage&"','"&Alias&"')") Edit=True Else If (ID=currentUser.ID) And (Level <> currentUser.Level) Then ShowError(6) If (ID<>currentUser.ID) And (Level <= currentUser.Level) Then ShowError(6) Dim targetUser Set targetUser=New TUser If targetUser.LoadInfobyID(ID) Then If Len(PassWord)=0 Then PassWord=targetUser.PassWord If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(6) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) Else Exit Function End If objConn.Execute("UPDATE [blog_Member] SET [mem_Level]="&Level&",[mem_Name]='"&Name&"',[mem_PassWord]='"&PassWord&"',[mem_Email]='"&Email&"',[mem_HomePage]='"&HomePage&"',[mem_Intro]='"&Alias&"' WHERE [mem_ID]="&ID) If Name <> targetUser.Name Then objConn.Execute("UPDATE [blog_Comment] SET [comm_Author]='"&Name&"' WHERE [comm_AuthorID]="&ID) End If If Email <> targetUser.Email Then objConn.Execute("UPDATE [blog_Comment] SET [comm_Email]='"&Email&"' WHERE [comm_AuthorID]="&ID) End If Edit=True If (ID=currentUser.ID) Then Response.Cookies("username")=Name Response.Cookies("password")=PassWord End If End If End Function Function Register(currentUser) Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) If (Level<>4) Then Call ShowError(16) If (Name="") Then Call ShowError(7) If Len(Name) >ZC_USERNAME_MAX Then Call ShowError(7) If Not CheckRegExp(Name,"[username]") Then Call ShowError(7) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Email)=0 Then Call ShowError(29) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(29) If Not CheckRegExp(Email,"[email]") Then Call ShowError(30) IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If If ID=0 Then If Level <= 1 Then ShowError(6) If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) objConn.Execute("INSERT INTO [blog_Member]([mem_Level],[mem_Name],[mem_PassWord],[mem_Email],[mem_HomePage],[mem_Intro]) VALUES ("&Level&",'"&Name&"','"&PassWord&"','"&Email&"','"&HomePage&"','"&Alias&"')") Register=True End If End Function Function Del(currentUser) Dim objRS Dim objUpLoadFile Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) Dim targetUser Set targetUser=New TUser If targetUser.LoadInfobyID(ID) Then If targetUser.Level<= currentUser.Level Then ShowError(6) If currentUser.ID = targetUser.ID Then ShowError(17) Else Exit Function End If objConn.Execute("DELETE FROM [blog_Article] WHERE [log_AuthorID] =" & ID) objConn.Execute("DELETE FROM [blog_Comment] WHERE [comm_AuthorID] =" & ID) objConn.Execute("DELETE FROM [blog_Member] WHERE [mem_ID] =" & ID) Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_AuthorID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof Set objUpLoadFile=New TUpLoadFile If objUpLoadFile.LoadInfoByID(objRS("ul_ID")) Then objUpLoadFile.Del Set objUpLoadFile=Nothing objRS.MoveNext Loop End If objRS.Close Set objRS=Nothing objConn.Execute("DELETE FROM [blog_UpLoad] WHERE [ul_AuthorID] =" & ID) Del=True End Function Private Sub Class_Initialize() Level=5 ID=0 Name=ZC_MSG018 Sex=0 Email="" MSN="" QQ="" HomePage="" Intro="" End Sub End Class '********************************************************* '********************************************************* ' 目的： 定义TComment类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TComment Public ID Public log_ID Public AuthorID Public Author Public Content Public Email Public HomePage Public PostTime Public IP Public Agent Public Count Public Property Get HomePageForAntiSpam HomePageForAntiSpam=URLEncodeForAntiSpam(HomePage) End Property Public Property Get SafeEmail If (Email="") Or IsEmpty(Email) Or IsNull(Email) Then Email="null@null.com" SafeEmail=Replace(Email,"@","[AT]") End Property Public Property Get EmailMD5 If (Email="") Or IsEmpty(Email) Or IsNull(Email) Then EmailMD5="" Else EmailMD5=MD5(Email) End If End Property Public Property Get FirstContact If Len(HomePage)>0 Then FirstContact=HomePageForAntiSpam Else FirstContact="mailto:" & SafeEmail End If End Property Public Property Get HtmlContent 'HtmlContent=TransferHTML(UBBCode(Content,"[font][face]"),"[enter][nofollow]") HtmlContent=TransferHTML(UBBCode(Content,"[link][link-antispam][font][face]"),"[enter][nofollow]") End Property Public Function Post() IP=Request.ServerVariables("REMOTE_ADDR") Agent=Request.ServerVariables("HTTP_USER_AGENT") If Len(HomePage)>0 Then If InStr(HomePage,"http://")=0 Then HomePage="http://" & HomePage End If '检查参数 Call CheckParameter(log_ID,"int",0) Call CheckParameter(AuthorID,"int",0) Call CheckParameter(PostTime,"dtm",Now) Author=FilterSQL(Author) Content=FilterSQL(Content) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) PostTime=FilterSQL(PostTime) IP=FilterSQL(IP) Agent=FilterSQL(Agent) 'log_ID不能为0 If Len(Author)=0 Then Call ShowError(15) If Len(Content)=0 Then Call ShowError(46) If Len(Content)>ZC_CONTENT_MAX Then Call ShowError(46) Author=TransferHTML(Author,"[html-format]") Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Content=TransferHTML(Content,"[html-format]") If Len(Author)>ZC_USERNAME_MAX Then Call ShowError(15) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(30) If Not CheckRegExp(Author,"[username]") Then Call ShowError(15) IF Len(Email)>0 Then If Not CheckRegExp(Email,"[email]") Then Call ShowError(29) End If IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If Dim objRS Dim strSpamIP Dim strSpamContent Set objRS=objConn.Execute("SELECT [comm_IP],[comm_Content] FROM [blog_Comment] WHERE [comm_ID]= ( SELECT MAX(comm_ID) FROM [blog_Comment] )") If (Not objRS.bof) And (Not objRS.eof) Then strSpamIP=objRS("comm_IP") strSpamContent=objRS("comm_Content") End If objRS.Close Set objRS=Nothing If (ID=0) And (strSpamIP=IP) And (strSpamContent=Content) Then Call ShowError(39) End If If ID=0 Then objConn.Execute("INSERT INTO [blog_Comment]([log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_IP],[comm_PostTime],[comm_Agent]) VALUES ("&log_ID&","&AuthorID&",'"&Author&"','"&Content&"','"&Email&"','"&HomePage&"','"&IP&"','"&PostTime&"','"&Agent&"')") Set objRS=objConn.Execute("SELECT MAX([comm_ID]) FROM [blog_Comment]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Comment] SET [log_ID]="&log_ID&", [comm_AuthorID]="&AuthorID&",[comm_Author]='"&Author&"',[comm_Content]='"&Content&"',[comm_Email]='"&Email&"',[comm_HomePage]='"&HomePage&"',[comm_IP]='"&IP&"',[comm_PostTime]='"&PostTime&"',[comm_Agent]='"&Agent&"' WHERE [comm_ID] =" & ID) End If Post=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Comment] WHERE [comm_ID] =" & ID) Del=True End Function Public Function LoadInfoByID(comm_ID) Call CheckParameter(comm_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [comm_ID]=" & comm_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("comm_ID") log_ID=objRS("log_ID") AuthorID=objRS("comm_AuthorID") Author=objRS("comm_Author") Content=objRS("comm_Content") Email=objRS("comm_Email") HomePage=objRS("comm_HomePage") PostTime=objRS("comm_PostTime") IP=objRS("comm_IP") Agent=objRS("comm_Agent") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(HomePage) Then HomePage="" End Function Public Function LoadInfoByArray(aryCommInfo) If IsArray(aryCommInfo)=True Then ID=aryCommInfo(0) log_ID=aryCommInfo(1) AuthorID=aryCommInfo(2) Author=aryCommInfo(3) Content=aryCommInfo(4) Email=aryCommInfo(5) HomePage=aryCommInfo(6) PostTime=aryCommInfo(7) IP=aryCommInfo(8) Agent=aryCommInfo(9) End If If IsNull(HomePage) Then HomePage="" LoadInfoByArray=True End Function Public Function MakeTemplate(strC) strC=Replace(strC,"<#article/comment/id#>",ID) strC=Replace(strC,"<#article/comment/name#>",Author) strC=Replace(strC,"<#article/comment/url#>",HomePage) strC=Replace(strC,"<#article/comment/urlencoder#>",HomePageForAntiSpam) strC=Replace(strC,"<#article/comment/email#>",SafeEmail) strC=Replace(strC,"<#article/comment/posttime#>",PostTime) strC=Replace(strC,"<#article/comment/content#>",HtmlContent) strC=Replace(strC,"<#article/comment/count#>",Count) strC=Replace(strC,"<#article/comment/authorid#>",AuthorID) strC=Replace(strC,"<#article/comment/firstcontact#>",FirstContact) strC=Replace(strC,"<#article/comment/emailmd5#>",EmailMD5) MakeTemplate=strC End Function End Class '********************************************************* '********************************************************* ' 目的： 定义TTrackBack类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TTrackBack Public ID Public log_ID Public URL Public Title Public Blog Public Excerpt Public PostTime Public IP Public Agent Public Count Public Property Get UrlForAntiSpam UrlForAntiSpam=URLEncodeForAntiSpam(Url) End Property Public Property Get HtmlExcerpt HtmlExcerpt=TransferHTML(Excerpt,"[enter]") End Property Private Function ReturnTbXML(strMsg) Dim strXML strXML="%e%m" If strMsg="undiscovered" Then'未发现相应ID strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) ElseIf strMsg="repetition" Then'重复PING strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Elseif strMsg="invalid parameter" Then'非法参数 strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Elseif strMsg="none data" Then'无数据 strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Else'PING 成功 strXML=Replace(strXML,"%e","0") strXML=Replace(strXML,"%m",strMsg) End If 'Response.ContentType = "text/html" Response.ContentType = "text/xml" Response.Clear Response.Write strXML End Function Public Function Post() Dim objRS 'Call ReturnTbXML("undiscovered"):Exit Function Call CheckParameter(log_ID,"int",0) If IsDate(PostTime)=False Then PostTime=Now() IP=Request.ServerVariables("REMOTE_ADDR") Agent=Request.ServerVariables("HTTP_USER_AGENT") IP=FilterSQL(IP) Agent=FilterSQL(Agent) URL=FilterSQL(URL) Title=FilterSQL(Title) Blog=FilterSQL(Blog) Excerpt=FilterSQL(Excerpt) Blog=TransferHTML(Blog,"[html-format]") Title=TransferHTML(Title,"[html-format]") Excerpt=TransferHTML(Excerpt,"[html-format][nohtml]") URL=TransferHTML(URL,"[html-format]") 'log_ID不能为0 If (log_ID=0) Then Call ReturnTbXML("invalid parameter"):Post=False:Exit Function If Len(URL)=0 Then Call ReturnTbXML("none data"):Post=False:Exit Function If Len(URL)>ZC_HOMEPAGE_MAX Then Call ReturnTbXML("url is long"):Post=False:Exit Function If Len(Blog)>ZC_EMAIL_MAX Then Call ReturnTbXML("name is long"):Post=False:Exit Function If Len(Blog)=0 Then Blog="Unknow" If Len(Excerpt)=0 Then Excerpt="" If Len(Excerpt)>ZC_TB_EXCERPT_MAX Then Excerpt=Left(Excerpt,ZC_TB_EXCERPT_MAX)&"..." If Len(Title)>ZC_HOMEPAGE_MAX Then Call ReturnTbXML("title is long"):Post=False:Exit Function If Len(Title)=0 Then Title=URL '检查ID是否存在 'Set objRS=objConn.Execute("SELECT * FROM [blog_Article] WHERE [log_ID]=" & log_ID) 'If (Not objRS.bof) And (Not objRS.eof) Then 'Else ' objRS.close ' Call returnTbXML("undiscovered") ' Exit Function 'End If 'objRS.Close 'Set objRS=Nothing '检查是否已TB过 Set objRS=objConn.Execute("SELECT * FROM [blog_TrackBack] WHERE [log_ID]=" & log_ID & " and [tb_url]='" & URL & "'") If (Not objRS.bof) And (Not objRS.eof) Then objRS.close Call returnTbXML("repetition") Exit Function End If objRS.Close Set objRS=Nothing '接收TB If ID=0 Then objConn.Execute("INSERT INTO [blog_TrackBack]([log_ID],[tb_URL],[tb_Title],[tb_Blog],[tb_Excerpt],[tb_PostTime],[tb_IP],[tb_Agent]) VALUES ("&log_ID&",'"&URL&"','"&Title&"','"&Blog&"','"&Excerpt&"','"&PostTime&"','"&IP&"','"&Agent&"')") Else objConn.Execute("UPDATE [blog_TrackBack] SET [log_ID]="&log_ID&", [tb_URL]='"&URL&"',[tb_Excerpt]='"&Excerpt&"',[tb_Title]='"&Title&"',[tb_Blog]='"&Blog&"',[tb_IP]='"&IP&"',[tb_PostTime]='"&PostTime&"',[tb_Agent]='"&Agent&"' WHERE [tb_ID] =" & ID) End If Call returnTbXML("succeed") Post=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_TrackBack] WHERE [tb_ID] =" & ID) Del=True End Function Function Send(strAddress) Dim strSendTB strSendTB = "title=" & Server.URLEncode(Title) & "&url=" & Server.URLEncode(URL) & "&excerpt=" & Server.URLEncode(Excerpt) & "&blog_name=" & Server.URLEncode(Blog) Dim objPing Set objPing = Server.CreateObject("MSXML2.ServerXMLHTTP") objPing.open "POST",strAddress,False objPing.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" objPing.send strSendTB 'Response.ContentType = "text/xml" 'Response.Clear 'Response.Write objPing.responseXML.xml Set objPing = Nothing Send=True End Function Public Function LoadInfoByID(tb_ID) Call CheckParameter(tb_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [tb_ID],[log_ID],[tb_URL],[tb_Title],[tb_Blog],[tb_Excerpt],[tb_PostTime],[tb_IP],[tb_Agent] FROM [blog_TrackBack] WHERE [tb_ID]=" & tb_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("tb_ID") log_ID=objRS("log_ID") URL=objRS("tb_URL") Title=objRS("tb_Title") Blog=objRS("tb_Blog") Excerpt=objRS("tb_Excerpt") PostTime=objRS("tb_PostTime") IP=objRS("tb_IP") Agent=objRS("tb_Agent") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Excerpt) Then Excerpt="" End Function Public Function LoadInfoByArray(aryTbInfo) If IsArray(aryTbInfo)=True Then ID=aryTbInfo(0) log_ID=aryTbInfo(1) URL=aryTbInfo(2) Title=aryTbInfo(3) Blog=aryTbInfo(4) Excerpt=aryTbInfo(5) PostTime=aryTbInfo(6) IP=aryTbInfo(7) Agent=aryTbInfo(8) End If If IsNull(Excerpt) Then Excerpt="" LoadInfoByArray=True End Function Public Function MakeTemplate(strT) strT=Replace(strT,"<#article/trackback/id#>",ID) strT=Replace(strT,"<#article/trackback/name#>",Blog) strT=Replace(strT,"<#article/trackback/url#>",UrlForAntiSpam) strT=Replace(strT,"<#article/trackback/title#>",Title) strT=Replace(strT,"<#article/trackback/posttime#>",PostTime) strT=Replace(strT,"<#article/trackback/content#>",HtmlExcerpt) strT=Replace(strT,"<#article/trackback/count#>",Count) MakeTemplate=strT End Function End Class '********************************************************* '********************************************************* ' 目的： 定义TUpLoadFile类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TUpLoadFile Public ID Public AuthorID Public FileSize Public FileName Public PostTime Public Stream Private FUploadType Public Property Let UploadType(strUploadType) If (strUploadType="Stream") Then FUploadType=strUploadType Else FUploadType="Form" End If End Property Public Property Get UploadType If IsEmpty(FUploadType)=True Then UploadType="Form" Else UploadType = FUploadType End If End Property Public Function LoadInfoByID(ul_ID) Call CheckParameter(ul_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [ul_ID],[ul_AuthorID],[ul_FileSize],[ul_FileName],[ul_PostTime] FROM [blog_UpLoad] WHERE [ul_ID]=" & ul_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("ul_ID") AuthorID=objRS("ul_AuthorID") FileSize=objRS("ul_FileSize") FileName=objRS("ul_FileName") PostTime=objRS("ul_PostTime") LoadInfobyID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryULInfo) If IsArray(aryULInfo)=True Then ID=aryULInfo(0) AuthorID=aryULInfo(1) FileSize=aryULInfo(2) FileName=aryULInfo(3) PostTime=aryULInfo(4) End If LoadInfoByArray=True End Function Private Function UpLoad_Form() Dim i,j Dim x,y,z Dim intFormSize Dim binFormData Dim strFileName intFormSize = Request.TotalBytes binFormData = Request.BinaryRead(intFormSize) If Instr(CStr(Request.ServerVariables("HTTP_USER_AGENT")),"Opera")>0 Then i=0 i=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(13)&ChrB(10)) If i>0 Then i=i+3 j=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)) Else i=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(13)&ChrB(10)) i=i+3 j=InStrB(binFormData,ChrB(13)&ChrB(10)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)) End If If Len(Request.QueryString("filename"))>0 Then strFileName=Request.QueryString("filename") Else x=InstrB(binFormData,ChrB(&H66)&ChrB(&H69)&ChrB(&H6C)&ChrB(&H65)&ChrB(&H6E)&ChrB(&H61)&ChrB(&H6D)&ChrB(&H65)&ChrB(&H3D)&ChrB(&H22)) y=InstrB(x+11,binFormData,ChrB(&H22)) For z=1 to y-x-10 strFileName=strFileName & Chr(AscB(MidB(binFormData,x+z+9,1))) Next End If Dim objStreamUp Set objStreamUp = Server.CreateObject("ADODB.Stream") With objStreamUp .Type = adTypeBinary .Mode = adModeReadWrite .Open .Position = 0 .Write binFormData .Position = i Stream=.Read(j-i-1) .Close End With FileName=strFileName FileSize=LenB(Stream) End Function Private Function UpLoad_Stream() FileSize=LenB(Stream) End Function Public Function UpLoad(bolAutoName) If UploadType="Form" Then Call UpLoad_Form() ElseIf UploadType="Stream" Then Call UpLoad_Stream() End If If InStrRev(FileName,"\")>0 Then FileName=Mid(FileName,InStrRev(FileName,"\")+1) End If If InStrRev(FileName,"/")>0 Then FileName=Mid(FileName,InStrRev(FileName,"\")+1) End If FileName=TransferHTML(FileName,"[filename]") '超出类型限制 If Not CheckRegExp(LCase(FileName),"\.("& ZC_UPLOAD_FILETYPE &")$") Then Call ShowError(26) '超出大小限制 If FileSize>ZC_UPLOAD_FILESIZE Then Call ShowError(27) FileName=FilterSQL(FileName) If bolAutoName=True Then Randomize FileName=Year(Now) & Right("0"&Month(Now),2) & Right("0"&Day(Now),2) & Right("0"&Hour(Now),2) & Right("0"&Minute(Now),2) & Right("0"&Second(Now),2) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Right(FileName,Len(FileName)-InStrRev(FileName,".")+1) End If Dim objRS Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_FileName] = '" & FileName & "'") If (Not objRS.bof) And (Not objRS.eof) Then '不能重名 Call ShowError(28) Else PostTime=Now() objConn.Execute("INSERT INTO [blog_UpLoad]([ul_AuthorID],[ul_FileSize],[ul_FileName],[ul_PostTime]) VALUES ("& AuthorID &","& FileSize &",'"& FileName &"','"& PostTime &"')") Dim objStreamFile Set objStreamFile = Server.CreateObject("ADODB.Stream") objStreamFile.Type = adTypeBinary objStreamFile.Mode = adModeReadWrite objStreamFile.Open objStreamFile.Write Stream objStreamFile.SaveToFile BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & FileName,adSaveCreateOverWrite objStreamFile.Close End If UpLoad=True End Function Public Function Del() Call CheckParameter(ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_ID] = " & ID) If (Not objRS.bof) And (Not objRS.eof) Then Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & objRS("ul_FileName")) Then fso.DeleteFile(BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & objRS("ul_FileName")) End If objConn.Execute("DELETE FROM [blog_UpLoad] WHERE [ul_ID] =" & ID) Else Exit Function End If objRS.Close Set objRS=Nothing Del=True End Function End Class '********************************************************* '********************************************************* ' 目的： 定义TTag类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TTag Public ID Public Name Public Intro Public Order Public Count Public Property Get EncodeName EncodeName = Server.URLEncode(Name) End Property Public Property Get Url Url = ZC_BLOG_HOST & "catalog.asp?"& "tags=" & Server.URLEncode(Name) End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get HtmlIntro HtmlIntro=TransferHTML(Intro,"[html-format]") End Property Public Property Get HtmlName HtmlName=TransferHTML(Name,"[html-format]") End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?tags=" & ID End Property Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(Order,"int",0) Name=FilterSQL(Name) Name=TransferHTML(Name,"[normalname]") If Len(Name)=0 Then Post=False:Exit Function Intro=FilterSQL(Intro) Intro=TransferHTML(Intro,"[html-format]") If ID=0 Then objConn.Execute("INSERT INTO [blog_Tag]([tag_Name],[tag_Order],[tag_Intro]) VALUES ('"&Name&"',"&Order&",'"&Intro&"')") Else objConn.Execute("UPDATE [blog_Tag] SET [tag_Name]='"&Name&"',[tag_Order]="&Order&",[tag_Intro]='"&Intro&"' WHERE [tag_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(tag_ID) Call CheckParameter(tag_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [tag_ID],[tag_Name],[tag_Intro],[tag_Order],[tag_Count] FROM [blog_Tag] WHERE [tag_ID]=" & tag_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("tag_ID") Name=objRS("tag_Name") Intro=objRS("tag_Intro") Order=objRS("tag_Order") Count=objRS("tag_Count") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Intro) Then Intro="" End Function Public Function LoadInfoByArray(aryTagInfo) If IsArray(aryTagInfo)=True Then ID=aryTagInfo(0) Name=aryTagInfo(1) Intro=aryTagInfo(2) Order=aryTagInfo(3) Count=aryTagInfo(4) End If If IsNull(Intro) Then Intro="" LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function Dim s Dim i Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT [log_ID],[log_tag] FROM [blog_Article] WHERE [log_Tag] LIKE '%{" & ID & "}%'") If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof i=objRS("log_ID") s=objRS("log_tag") s=Replace(s,"{"& ID &"}","") objConn.Execute("UPDATE [blog_Article] SET [log_tag]='"& s &"' WHERE [log_ID] =" & i) objRS.MoveNext Loop End If objRS.Close objConn.Execute("DELETE FROM [blog_Tag] WHERE [tag_ID] =" & ID) Del=True End Function Public Function MakeTemplate(s) s=Replace(s,"<#article/tag/id#>",ID) s=Replace(s,"<#article/tag/name#>",HtmlName) s=Replace(s,"<#article/tag/intro#>",HtmlIntro) s=Replace(s,"<#article/tag/count#>",Count) s=Replace(s,"<#article/tag/url#>",HtmlUrl) s=Replace(s,"<#article/tag/encodename#>",EncodeName) MakeTemplate=s End Function End Class '********************************************************* '********************************************************* ' 目的： 定义TKeyWord类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TKeyWord Public ID Public Name Public Intro Public Url Public Function Post() Call CheckParameter(ID,"int",0) Name=FilterSQL(Name) Name=TransferHTML(Name,"[normalname]") If Len(Name)=0 Then Post=False:Exit Function Intro=FilterSQL(Intro) Intro=TransferHTML(Intro,"[html-format]") Url=FilterSQL(Url) If Len(Url)=0 Then Post=False:Exit Function If Not CheckRegExp(Url,"[homepage]") Then Call ShowError(30) If ID=0 Then objConn.Execute("INSERT INTO [blog_Keyword]([key_Name],[key_URL],[key_Intro]) VALUES ('"&Name&"','"&Url&"','"&Intro&"')") Else objConn.Execute("UPDATE [blog_Keyword] SET [key_Name]='"&Name&"',[key_URL]='"&Url&"',[key_Intro]='"&Intro&"' WHERE [key_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(key_ID) Call CheckParameter(key_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [key_ID],[key_Name],[key_Intro],[key_Url] FROM [blog_Keyword] WHERE [key_ID]=" & key_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("key_ID") Name=objRS("key_Name") Intro=objRS("key_Intro") Url=objRS("key_Url") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Intro) Then Intro="" End Function Public Function LoadInfoByArray(aryKeyWordInfo) If IsArray(aryKeywordInfo)=True Then ID=aryKeyWordInfo(0) Name=aryKeyWordInfo(1) Intro=aryKeyWordInfo(2) Url=aryKeyWordInfo(3) End If If IsNull(Intro) Then Intro="" LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Keyword] WHERE [key_ID] =" & ID) Del=True End Function End Class '********************************************************* '********************************************************* ' 目的： 定义TGuestBook类 ' 输入： 无 ' 返回： 无 '********************************************************* Class TGuestBook Public Template_Article_Single Public Template_Article_Comment Public Template_Article_Commentpost Public Template_PageBar Public Template_Article_Commentpost_Verify Public html Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Public Function Export(intPage) Dim i,j,strC_Count,objComment,strC If IsNumeric(intPage)=False Then intPage=1 Call CheckParameter(intPage,"int",1) Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-GUESTBOOK") If (Template_Article_Single="") Then Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE") End If Template_Article_Commentpost=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST") If ZC_COMMENT_VERIFY_ENABLE=True Then Template_Article_Commentpost_Verify=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY") End If Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT COUNT([comm_ID])AS allComment FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=0") If (Not objRS.bof) And (Not objRS.eof) Then strC_Count=objRS("allComment") End If objRS.Close Set objRS=Nothing Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=0 ORDER BY [comm_PostTime] DESC" objRS.Open() objRS.PageSize=ZC_MSG_COUNT If objRS.PageCount>0 Then objRS.AbsolutePage = intPage If (not objRS.bof) And (not objRS.eof) Then For i=1 To objRS.PageSize Set objComment=New TComment objComment.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_AuthorID"),objRS("comm_Author"),objRS("comm_Content"),objRS("comm_Email"),objRS("comm_HomePage"),objRS("comm_PostTime"),"","")) Application.Lock strC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT") Application.UnLock objComment.Count=strC_Count-i-(ZC_MSG_COUNT * (intPage-1))+1 strC=objComment.MakeTemplate(strC) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Comment=Template_Article_Comment & strC Else Template_Article_Comment=strC & Template_Article_Comment End If Set objComment=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If j=objRS.PageCount If j>0 Then Dim a,b,s,t,intNowPage,strPageBar s=ZC_BLOG_HOST & "guestbook.asp" t="" intNowPage=intPage Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG285) Template_PageBar=Template_PageBar & strPageBar If j>ZC_PAGEBAR_COUNT Then a=intNowPage b=intNowPage+ZC_PAGEBAR_COUNT If a>ZC_PAGEBAR_COUNT Then a=a-1:b=b-1 If b>j Then b=j:a=j-ZC_PAGEBAR_COUNT Else a=1:b=j End If For i=a to b s=ZC_BLOG_HOST & "guestbook.asp?"& t &"page="& i If i=1 Then s=ZC_BLOG_HOST & "guestbook.asp" End If Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock If i=intNowPage then Template_PageBar=Template_PageBar & "" & i & "" Else strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",i) Template_PageBar=Template_PageBar & strPageBar End If Next s=ZC_BLOG_HOST & "guestbook.asp?"& t &"page="& j If j=1 Then s=ZC_BLOG_HOST & "guestbook.asp" End If Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG286) Template_PageBar=Template_PageBar & strPageBar End If objRS.Close Set objRS=Nothing Template_Article_Comment=Template_Article_Comment & "

" Template_Article_Commentpost=Replace(Template_Article_Commentpost,"<#template:article_commentpost-verify#>",Template_Article_Commentpost_Verify) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_trackback#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_comment#>",Template_Article_Comment) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_commentpost#>",Template_Article_Commentpost) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_tag#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_l#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_r#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_mutuality#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:pagebar#>",Template_PageBar) Dim aryTemplateTagsName(47) Dim aryTemplateTagsValue(47) Dim PostTime PostTime=Now() aryTemplateTagsName(1)="<#article/id#>" aryTemplateTagsValue(1)=0 aryTemplateTagsName(2)="<#article/level#>" aryTemplateTagsValue(2)=4 aryTemplateTagsName(3)="<#article/title#>" aryTemplateTagsValue(3)=ZC_MSG275 aryTemplateTagsName(4)="<#article/intro#>" aryTemplateTagsValue(4)=ZC_GUESTBOOK_CONTENT aryTemplateTagsName(5)="<#article/content#>" aryTemplateTagsValue(5)=ZC_GUESTBOOK_CONTENT & "
" & "
" & ZC_MSG042 & ":" & Template_PageBar aryTemplateTagsName(6)="<#article/posttime#>" aryTemplateTagsValue(6)=PostTime aryTemplateTagsName(7)="<#article/commnums#>" aryTemplateTagsValue(7)=strC_Count aryTemplateTagsName(8)="<#article/viewnums#>" aryTemplateTagsValue(8)=0 aryTemplateTagsName(9)="<#article/trackbacknums#>" aryTemplateTagsValue(9)=0 aryTemplateTagsName(10)="<#article/trackback_url#>" aryTemplateTagsValue(10)="" aryTemplateTagsName(11)="<#article/url#>" aryTemplateTagsValue(11)=ZC_BLOG_HOST & "guestbook.asp" aryTemplateTagsName(12)="<#article/category/id#>" aryTemplateTagsValue(12)=0 aryTemplateTagsName(13)="<#article/category/name#>" aryTemplateTagsValue(13)=ZC_BLOG_NAME aryTemplateTagsName(15)="<#article/category/order#>" aryTemplateTagsValue(15)=0 aryTemplateTagsName(16)="<#article/category/count#>" aryTemplateTagsValue(16)=0 aryTemplateTagsName(17)="<#article/category/url#>" aryTemplateTagsValue(17)="" aryTemplateTagsName(18)="<#article/author/id#>" aryTemplateTagsValue(18)=0 aryTemplateTagsName(19)="<#article/author/name#>" aryTemplateTagsValue(19)=ZC_BLOG_MASTER aryTemplateTagsName(20)="<#article/author/level#>" aryTemplateTagsValue(20)=4 aryTemplateTagsName(21)="<#article/author/email#>" aryTemplateTagsValue(21)="" aryTemplateTagsName(22)="<#article/author/homepage#>" aryTemplateTagsValue(22)="" aryTemplateTagsName(23)="<#article/author/count#>" aryTemplateTagsValue(23)=0 aryTemplateTagsName(24)="<#article/author/url#>" aryTemplateTagsValue(24)="" aryTemplateTagsName(25)="<#article/posttime/longdate#>" aryTemplateTagsValue(25)=FormatDateTime(PostTime,vbLongDate) aryTemplateTagsName(26)="<#article/posttime/shortdate#>" aryTemplateTagsValue(26)=FormatDateTime(PostTime,vbShortDate) aryTemplateTagsName(27)="<#article/posttime/longtime#>" aryTemplateTagsValue(27)=FormatDateTime(PostTime,vbLongTime) aryTemplateTagsName(28)="<#article/posttime/shorttime#>" aryTemplateTagsValue(28)=FormatDateTime(PostTime,vbShortTime) aryTemplateTagsName(29)="<#article/posttime/year#>" aryTemplateTagsValue(29)=Year(PostTime) aryTemplateTagsName(30)="<#article/posttime/month#>" aryTemplateTagsValue(30)=Month(PostTime) aryTemplateTagsName(31)="<#article/posttime/monthname#>" aryTemplateTagsValue(31)=ZVA_Month_Abbr(Month(PostTime)) aryTemplateTagsName(32)="<#article/posttime/day#>" aryTemplateTagsValue(32)=Day(PostTime) aryTemplateTagsName(33)="<#article/posttime/weekday#>" aryTemplateTagsValue(33)=Weekday(PostTime) aryTemplateTagsName(34)="<#article/posttime/weekdayname#>" aryTemplateTagsValue(34)=ZVA_Week_Abbr(Weekday(PostTime)) aryTemplateTagsName(35)="<#article/posttime/hour#>" aryTemplateTagsValue(35)=Hour(PostTime) aryTemplateTagsName(36)="<#article/posttime/minute#>" aryTemplateTagsValue(36)=Minute(PostTime) aryTemplateTagsName(37)="<#article/posttime/second#>" aryTemplateTagsValue(37)=Second(PostTime) aryTemplateTagsName(38)="<#article/commentrss#>" aryTemplateTagsValue(38)="" aryTemplateTagsName(39)="<#article/commentposturl#>" aryTemplateTagsValue(39)=ZC_BLOG_HOST & "cmd.asp?act=cmt&key=" & Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(0) & CStr(Day(Now))),8) aryTemplateTagsName(40)="<#article/pretrackback_url#>" aryTemplateTagsValue(40)="" aryTemplateTagsName(41)="<#article/trackbackkey#>" aryTemplateTagsValue(41)="00000" aryTemplateTagsName(42)="<#article/commentkey#>" aryTemplateTagsValue(42)="00000" aryTemplateTagsName(43)="<#article/staticname#>" aryTemplateTagsValue(43)="" aryTemplateTagsName(44)="<#article/category/staticname#>" aryTemplateTagsValue(44)="" aryTemplateTagsName(45)="<#article/author/staticname#>" aryTemplateTagsValue(45)="" aryTemplateTagsName(46)="<#article/tagtoname#>" aryTemplateTagsValue(46)="" aryTemplateTagsName(47)="<#article/firsttagintro#>" aryTemplateTagsValue(47)="" j=47 For i=1 to j Template_Article_Single=Replace(Template_Article_Single,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Ftemplate=Replace(Ftemplate,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Next Dim aryTemplateTagsName2 Dim aryTemplateTagsValue2 html=Replace(template,"<#template:article-single#>",Template_Article_Single) html=Replace(html,"<#template:article-guestbook#>",Template_Article_Single) Application.Lock aryTemplateTagsName2=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue2=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName2(0)="BlogTitle" aryTemplateTagsValue2(0)=ZC_MSG275 j=UBound(aryTemplateTagsName2) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName2(i) & "#>",aryTemplateTagsValue2(i)) Next Export=True End Function End Class '********************************************************* %>