<% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// 作 者: 朱煊(zx.asd) '// 版权所有: RainbowSoft Studio '// 技术支持: rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_system_base.asp '// 开始时间: 2005.02.11 '// 最后修改: '// 备 注: '/////////////////////////////////////////////////////////////////////////////// '定义全局变量 Dim objConn Dim BlogTitle Dim BlogUser Dim BlogPath BlogPath=Server.MapPath("c_system_base.asp") BlogPath=Left(BlogPath,Len(BlogPath)-Len("c_system_base.asp")) Dim StarTime Dim EndTime StarTime = Timer() Dim Categorys() Dim Users() Dim Tags() Dim KeyWords Dim PluginName() Dim PluginActiveFunction() ReDim PluginName(0) ReDim PluginActiveFunction(0) Dim TemplateTagsName Dim TemplateTagsValue Dim TemplatesName Dim TemplatesContent '********************************************************* ' 目的： System 初始化 '********************************************************* Sub System_Initialize() On Error Resume Next Call ActivePlugin() 'plugin node For Each sAction_Plugin_System_Initialize in Action_Plugin_System_Initialize If Not IsEmpty(sAction_Plugin_System_Initialize) Then Call Execute(sAction_Plugin_System_Initialize) If bAction_Plugin_System_Initialize=True Then Exit Sub Next If OpenConnect()=False Then If Err.Number<>0 Then Err.Clear Call ShowError(4) End If Set BlogUser =New TUser BlogUser.Verify() Call GetCategory() Call GetUser() Call GetTags() Call GetKeyWords() Call LoadGlobeCache() Dim bolRebuildIndex Application.Lock bolRebuildIndex=Application(ZC_BLOG_CLSID & "SIGNAL_REBUILDINDEX") Application.UnLock If IsEmpty(bolRebuildIndex)=False Then If bolRebuildIndex=True Then Call MakeBlogReBuild_Core() End If End If Dim strTemplateModified Application.Lock strTemplateModified=Application(ZC_BLOG_CLSID & "TEMPLATEMODIFIED") Application.UnLock If IsEmpty(strTemplateModified)=False Then If LCase(CStr(strTemplateModified))<>LCase(CStr(CheckTemplateModified)) Then Call ClearGlobeCache() Call LoadGlobeCache() End If End If 'plugin node For Each sAction_Plugin_System_Initialize_Succeed in Action_Plugin_System_Initialize_Succeed If Not IsEmpty(sAction_Plugin_System_Initialize_Succeed) Then Call Execute(sAction_Plugin_System_Initialize_Succeed) If bAction_Plugin_System_Initialize_Succeed=True Then Exit Sub Next 'If Err.Number<>0 Then Call ShowError(10) Err.Clear End Sub '********************************************************* '********************************************************* ' 目的： System 释放 '********************************************************* Sub System_Terminate() 'plugin node For Each sAction_Plugin_System_Terminate in Action_Plugin_System_Terminate If Not IsEmpty(sAction_Plugin_System_Terminate) Then Call Execute(sAction_Plugin_System_Terminate) If bAction_Plugin_System_Terminate=True Then Exit Sub Next Call CloseConnect() End Sub '********************************************************* '********************************************************* ' 目的： System 初始化 WithOutDB '********************************************************* Sub System_Initialize_WithOutDB() On Error Resume Next Call ActivePlugin() 'plugin node For Each sAction_Plugin_System_Initialize_WithOutDB in Action_Plugin_System_Initialize_WithOutDB If Not IsEmpty(sAction_Plugin_System_Initialize_WithOutDB) Then Call Execute(sAction_Plugin_System_Initialize_WithOutDB) If bAction_Plugin_System_Initialize_WithOutDB=True Then Exit Sub Next Call LoadGlobeCache() Dim strTemplateModified Application.Lock strTemplateModified=Application(ZC_BLOG_CLSID & "TEMPLATEMODIFIED") Application.UnLock If IsEmpty(strTemplateModified)=False Then If LCase(CStr(strTemplateModified))<>LCase(CStr(CheckTemplateModified)) Then Call ClearGlobeCache() Call LoadGlobeCache() End If End If 'plugin node For Each sAction_Plugin_System_Initialize_WithOutDB_Succeed in Action_Plugin_System_Initialize_WithOutDB_Succeed If Not IsEmpty(sAction_Plugin_System_Initialize_WithOutDB_Succeed) Then Call Execute(sAction_Plugin_System_Initialize_WithOutDB_Succeed) If bAction_Plugin_System_Initialize_WithOutDB_Succeed=True Then Exit Sub Next Err.Clear End Sub '********************************************************* '********************************************************* ' 目的： System 释放 WithOutDB '********************************************************* Sub System_Terminate_WithOutDB() 'plugin node For Each sAction_Plugin_System_Terminate_WithOutDB in Action_Plugin_System_Terminate_WithOutDB If Not IsEmpty(sAction_Plugin_System_Terminate_WithOutDB) Then Call Execute(sAction_Plugin_System_Terminate_WithOutDB) If bAction_Plugin_System_Terminate_WithOutDB=True Then Exit Sub Next End Sub '********************************************************* '********************************************************* ' 目的： 数据库连接 '********************************************************* Function OpenConnect() GetReallyDirectory() '判定是否为子目录调用 Dim strDbPath strDbPath=BlogPath & ZC_DATABASE_PATH Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath OpenConnect=True End Function '********************************************************* '********************************************************* ' 目的： DB Disable Connect '********************************************************* Function CloseConnect() objConn.Close Set objConn=Nothing CloseConnect=True End Function '********************************************************* '********************************************************* ' 目的： 时间计长 '********************************************************* Function RunTime() EndTime=Timer() RunTime = CLng(FormatNumber((EndTime-StarTime)*1000,3)) End Function '********************************************************* '********************************************************* ' 目的： 分类读取 '********************************************************* Function GetCategory() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Categorys Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [cate_ID] FROM [blog_Category] ORDER BY [cate_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("cate_ID") ReDim Categorys(i) End If objRS.Close Set objRS=Nothing Set objRS=objConn.Execute("SELECT [cate_ID],[cate_Name],[cate_Intro],[cate_Order],[cate_Count] FROM [blog_Category] ORDER BY [cate_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Categorys(aryAllData(0,i))=New TCategory Categorys(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i))) Next End If GetCategory=True End Function '********************************************************* '********************************************************* ' 目的： 用户读取 '********************************************************* Function GetUser() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Users Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [mem_ID] FROM [blog_Member] ORDER BY [mem_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("mem_ID") ReDim Users(i) End If objRS.Close Set objRS=Nothing Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Name],[mem_Level],[mem_Password],[mem_Email],[mem_HomePage],[mem_PostLogs],[mem_Intro] FROM [blog_Member] ORDER BY [mem_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Users(aryAllData(0,i))=New TUser Users(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i),aryAllData(5,i),aryAllData(6,i),aryAllData(7,i))) Next End If Getuser=True End Function '********************************************************* '********************************************************* ' 目的： Tags读取 '********************************************************* Function GetTags() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Tags Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [tag_ID] FROM [blog_Tag] ORDER BY [tag_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("tag_ID") ReDim Tags(i) End If Set objRS=objConn.Execute("SELECT [tag_ID],[tag_Name],[tag_Intro],[tag_Order],[tag_Count] FROM [blog_Tag] ORDER BY [tag_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Tags(aryAllData(0,i))=New TTag Tags(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i))) Next End If GetTags=True End Function '********************************************************* '********************************************************* ' 目的： KeyWords读取 '********************************************************* Function GetKeyWords() 'Dim objRS 'Set objRS=objConn.Execute("SELECT [key_ID],[key_Name],[key_URL] FROM [blog_Keyword] ORDER BY [key_ID] ASC") 'If (Not objRS.bof) And (Not objRS.eof) Then ' KeyWords=objRS.GetRows 'End If 'objRS.Close 'Set objRS=Nothing GetKeyWords=True End Function '********************************************************* '********************************************************* ' 目的： 读取权限 ' 备注: 权限最高为1 最低为5 不是则非法 ' "Root"一定只能为1 ' 权限配置方式可以变通 '********************************************************* Function GetRights(strAction) 'plugin node For Each sAction_Plugin_GetRights_Begin in Action_Plugin_GetRights_Begin If Not IsEmpty(sAction_Plugin_GetRights_Begin) Then Call Execute(sAction_Plugin_GetRights_Begin) If bAction_Plugin_GetRights_Begin=True Then Exit Function Next Select Case strAction Case "Root" GetRights=1 Case "login" GetRights=5 Case "verify" GetRights=5 Case "logout" GetRights=5 Case "admin" GetRights=4 Case "cmt","CommentRev" GetRights=5 Case "tb" GetRights=5 Case "vrs" GetRights=5 Case "rss" GetRights=5 Case "gettburl" GetRights=5 Case "ArticleMng" GetRights=3 Case "ArticleEdt" GetRights=3 Case "ArticlePst" GetRights=3 Case "ArticleDel" GetRights=3 Case "ArticleBud" GetRights=3 Case "CategoryMng" GetRights=2 Case "CategoryEdt" GetRights=2 Case "CategoryPst" GetRights=2 Case "CategoryDel" GetRights=2 Case "TagMng" GetRights=1 Case "TagEdt" GetRights=1 Case "TagPst" GetRights=1 Case "TagDel" GetRights=1 'Case "KeyWordMng" ' GetRights=1 'Case "KeyWordEdt" ' GetRights=1 'Case "KeyWordPst" ' GetRights=1 'Case "KeyWordDel" ' GetRights=1 Case "GuestBookMng" GetRights=2 Case "CommentMng" GetRights=4 Case "CommentDel" GetRights=4 Case "CommentEdt" GetRights=4 Case "CommentSav" GetRights=4 Case "CommentDelBatch" GetRights=4 Case "TrackBackMng" GetRights=3 Case "TrackBackDel" GetRights=3 Case "TrackBackDelBatch" GetRights=3 Case "TrackBackSnd" GetRights=3 Case "UserMng" GetRights=4 Case "UserEdt" GetRights=4 Case "UserDel" GetRights=1 Case "UserCrt" GetRights=1 Case "BlogReBuild" GetRights=3 Case "DirectoryReBuild" GetRights=3 Case "FileReBuild" GetRights=1 Case "AskFileReBuild" GetRights=1 Case "FileMng" GetRights=2 Case "FileSnd" GetRights=2 Case "FileUpload" GetRights=2 Case "FileDel" GetRights=2 Case "FileDelBatch" GetRights=2 Case "Search" GetRights=5 'Case "BlogMng" ' GetRights=4 Case "SettingMng" GetRights=1 Case "SettingSav" GetRights=1 Case "PlugInMng" GetRights=4 Case "SiteInfo" GetRights=4 Case "SiteFileMng" GetRights=1 Case "SiteFileEdt" GetRights=1 'Case "SiteFileFnd" ' GetRights=1 Case "SiteFilePst" GetRights=1 Case "SiteFileDel" GetRights=1 'Case "Update" ' GetRights=1 Case "ThemesMng" GetRights=1 Case "ThemesSav" GetRights=1 Case "LinkMng" GetRights=1 Case "LinkSav" GetRights=1 Case "PlugInActive" GetRights=1 Case "PlugInDisable" GetRights=1 Case Else Call ShowError(1) End Select End Function '********************************************************* '********************************************************* ' 目的： 检查权限 '********************************************************* Function CheckRights(strAction) 'plugin node For Each sAction_Plugin_CheckRights_Begin in Action_Plugin_CheckRights_Begin If Not IsEmpty(sAction_Plugin_CheckRights_Begin) Then Call Execute(sAction_Plugin_CheckRights_Begin) If bAction_Plugin_CheckRights_Begin=True Then Exit Function Next If BlogUser.Level>GetRights(strAction) Then CheckRights=False Else CheckRights=True End If End Function '********************************************************* '********************************************************* ' 目的： Make Calendar '********************************************************* Function MakeCalendar(dtmYearMonth) 'plugin node For Each sAction_Plugin_MakeCalendar_Begin in Action_Plugin_MakeCalendar_Begin If Not IsEmpty(sAction_Plugin_MakeCalendar_Begin) Then Call Execute(sAction_Plugin_MakeCalendar_Begin) If bAction_Plugin_MakeCalendar_Begin=True Then Exit Function Next Dim strCalendar Dim y Dim m Dim d Dim firw Dim lasw Dim ny Dim nm Dim i Dim j Dim k Dim b Dim s Dim t Call CheckParameter(dtmYearMonth,"dtm",Date()) y=year(dtmYearMonth) m=month(dtmYearMonth) ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 firw=Weekday(Cdate(y&"-"&m&"-1")) For i=28 to 32 If IsDate(y&"-"&m&"-"&i) Then lasw=Weekday(Cdate(y&"-"&m&"-"&i)) Else Exit For End If Next d=i-1 k=1 If firw>5 Then b=42 Else b=35 If (d=28) And (firw=1) Then b=28 If (firw>5) And (d<31) And (d-firw<>23) Then b=35 '////////////////////////////////////////////////////////// ' 逻辑处理 Dim aryDateLink(32) Dim aryDateID(32) Dim aryDateArticle(32) 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_CateID],[log_AuthorID],[log_Level],[log_PostTime],[log_Url],[log_Istop] from [blog_Article] where ([log_Level]>2) And ([log_PostTime] BETWEEN #"&y&"-"&m&"-1# AND #"&ny&"-"&nm&"-1#)") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 To objRS.RecordCount j=CInt(Day(CDate(objRS("log_PostTime")))) aryDateLink(j)=True aryDateID(j)=objRS("log_ID") Set aryDateArticle(j)=New TArticle aryDateArticle(j).LoadInfobyArray Array(objRS("log_ID"),"",objRS("log_CateID"),"","","",objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),"","","",objRS("log_Url"),"") objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.Close Set objRS=Nothing '////////////////////////////////////////////////////////// s="catalog.asp?date="&y&"-"&(m-1) t="catalog.asp?date="&y&"-"&(m+1) If m=1 Then s="catalog.asp?date="&(y-1)&"-12" If m=12 Then t="catalog.asp?date="&(y+1)&"-1" strCalendar=strCalendar & "
" strCalendar=strCalendar & "

<< "&y&"-"&m&" >>

" strCalendar=strCalendar & "

"&ZVA_Week_Abbr(1)&"

"&ZVA_Week_Abbr(2)&"

"&ZVA_Week_Abbr(3)&"

"&ZVA_Week_Abbr(4)&"

"&ZVA_Week_Abbr(5)&"

"&ZVA_Week_Abbr(6)&"

"&ZVA_Week_Abbr(7)&"

" j=0 For i=1 to b If (j=>firw-1) and (k="&(k)&"

" Else strCalendar=strCalendar & "

"&(k)&"

" End If k=k+1 Else strCalendar=strCalendar & "

" End If j=j+1 Next strCalendar=strCalendar & "
" MakeCalendar=strCalendar End Function '********************************************************* '********************************************************* ' 目的： 加载指定目录的文件列表 '********************************************************* Function LoadIncludeFiles(strDir) On Error Resume Next Dim aryFileList() ReDim aryFileList(0) Dim fso, f, f1, fc, s, i Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(BlogPath & strDir) Set fc = f.Files i=0 For Each f1 in fc i=i+1 ReDim Preserve aryFileList(i) aryFileList(i)=f1.name Next LoadIncludeFiles=aryFileList Set fso=nothing Err.Clear End Function '********************************************************* '********************************************************* ' 目的： Get Template by Name '********************************************************* Function GetTemplate(Name) Dim i,j j=UBound(TemplatesName) For i=1 to j If LCase(TemplatesName(i))=LCase(Name) Then GetTemplate=TemplatesContent(i) End If Next End Function '********************************************************* '********************************************************* ' 目的： Set Template by Name '********************************************************* Function SetTemplate(Name,Value) Dim i,j j=UBound(TemplatesName) For i=1 to j If LCase(TemplatesName(i))=LCase(Name) Then TemplatesContent(i)=Value End If Next End Function '********************************************************* '********************************************************* ' 目的： Check Template Modified Date '********************************************************* Function CheckTemplateModified() Dim fso, f, f1, fc, s Dim d,nd Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(BlogPath & "themes" & "/" & ZC_BLOG_THEME & "/" & ZC_TEMPLATE_DIRECTORY) Set fc = f.Files For Each f1 in fc d=f1.DateLastModified If nd="" Then nd=d If DateDiff("s",nd,d)>0 Then nd=d Next CheckTemplateModified=nd End Function '********************************************************* '********************************************************* ' 目的： Load 全局 Cache '********************************************************* Function LoadGlobeCache() On Error Resume Next Dim bolReLoadCache Application.Lock bolReLoadCache=Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE") Application.UnLock If IsEmpty(bolReLoadCache)=True Then bolReLoadCache="ok" Else Application.Lock TemplateTagsName=Application(ZC_BLOG_CLSID & "TemplateTagsName") TemplateTagsValue=Application(ZC_BLOG_CLSID & "TemplateTagsValue") TemplatesName=Application(ZC_BLOG_CLSID & "TemplatesName") TemplatesContent=Application(ZC_BLOG_CLSID & "TemplatesContent") Application.UnLock If IsEmpty(TemplateTagsValue)=False And IsEmpty(TemplateTagsValue)=False And IsEmpty(TemplatesName)=False And IsEmpty(TemplatesContent)=False Then Exit Function End If End If Call GetReallyDirectory Dim i,j '加载模板 Dim objStream Dim strContent Dim aryTemplatesName() Dim aryTemplatesContent() ReDim Preserve aryTemplatesName(3) ReDim Preserve aryTemplatesContent(3) '加载WAP Application.Lock aryTemplatesName(1)="TEMPLATE_WAP_ARTICLE_COMMENT" aryTemplatesName(2)="TEMPLATE_WAP_ARTICLE-MULTI" aryTemplatesName(3)="TEMPLATE_WAP_SINGLE" aryTemplatesContent(1)=LoadFromFile(BlogPath & "WAP/wap_article_comment.html","utf-8") aryTemplatesContent(2)=LoadFromFile(BlogPath & "WAP/wap_article-multi.html","utf-8") aryTemplatesContent(3)=LoadFromFile(BlogPath & "WAP/wap_single.html","utf-8") Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE_COMMENT")=aryTemplatesContent(1) Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI")=aryTemplatesContent(2) Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE")=aryTemplatesContent(3) Application.UnLock '读取Template目录下的所有文件并写入Cache Dim aryFileList Dim aryFileNameTemplate() Dim aryFileNameTemplate_Variable() aryFileList=LoadIncludeFiles("themes" & "/" & ZC_BLOG_THEME & "/" & ZC_TEMPLATE_DIRECTORY) If IsArray(aryFileList) Then j=UBound(aryFileList) ReDim aryFileNameTemplate(j) ReDim aryFileNameTemplate_Variable(j) ReDim Preserve aryTemplatesName(3+j) ReDim Preserve aryTemplatesContent(3+j) For i=1 to j aryFileNameTemplate(i)="themes" & "/" & ZC_BLOG_THEME & "/" & ZC_TEMPLATE_DIRECTORY & "/" & aryFileList(i) aryFileNameTemplate_Variable(i)="TEMPLATE_" & UCase(Left(aryFileList(i),InStr(aryFileList(i),".")-1)) If InStr(aryFileList(i),".")=0 Then aryFileNameTemplate_Variable(i)="TEMPLATE_" & UCase(aryFileList(i)) End If aryTemplatesName(3+i)=aryFileNameTemplate_Variable(i) strContent="" strContent=LoadFromFile(BlogPath & "" & aryFileNameTemplate(i),"utf-8") Application.Lock Application(ZC_BLOG_CLSID & aryFileNameTemplate_Variable(i))=strContent Application.UnLock aryTemplatesContent(3+i)=strContent Next End If '加载标签 Dim a,b,c,d,e Dim t() Dim s() a=0 b=20 c=1 d=320 e=0 '读取TEMPLATE下的Include目录下的所有文件并写入Cache 'Dim aryFileList Dim aryFileNameTemplateInclude() Dim aryFileNameTemplateInclude_Variable() aryFileList=LoadIncludeFiles("themes" & "/" & ZC_BLOG_THEME & "/" & "INCLUDE") If IsArray(aryFileList) Then e=UBound(aryFileList) ReDim aryFileNameTemplateInclude(e) ReDim aryFileNameTemplateInclude_Variable(e) ReDim s(e) ReDim Preserve aryTemplateTagsName(e) ReDim Preserve aryTemplateTagsValue(e) For i=1 to e aryFileNameTemplateInclude(i)="themes" & "/" & ZC_BLOG_THEME & "/" & "INCLUDE" & "/" & aryFileList(i) aryFileNameTemplateInclude_Variable(i)="TEMPLATE_INCLUDE_" & UCase(Left(aryFileList(i),InStr(aryFileList(i),".")-1)) If InStr(aryFileList(i),".")=0 Then aryFileNameTemplateInclude_Variable(i)="TEMPLATE_INCLUDE_" & UCase(aryFileList(i)) End If s(i)=aryFileNameTemplateInclude_Variable(i) strContent="" strContent=LoadFromFile(BlogPath & "" & aryFileNameTemplateInclude(i),"utf-8") strContent=Replace(strContent,"<"&"%=ZC_BLOG_HOST%"&">",ZC_BLOG_HOST) aryTemplateTagsName(i)=s(i) aryTemplateTagsValue(i)=strContent Next End If '读取Include目录下的所有文件并写入Cache 'Dim aryFileList Dim aryFileNameInclude() Dim aryFileNameInclude_Variable() aryFileList=LoadIncludeFiles("INCLUDE") If IsArray(aryFileList) Then a=UBound(aryFileList) ReDim aryFileNameInclude(a) ReDim aryFileNameInclude_Variable(a) ReDim s(a) ReDim Preserve aryTemplateTagsName(e+a) ReDim Preserve aryTemplateTagsValue(e+a) For i=1 to a aryFileNameInclude(i)="/INCLUDE/" & aryFileList(i) aryFileNameInclude_Variable(i)="CACHE_INCLUDE_" & UCase(Left(aryFileList(i),InStr(aryFileList(i),".")-1)) If InStr(aryFileList(i),".")=0 Then aryFileNameInclude_Variable(i)="CACHE_INCLUDE_" & UCase(aryFileList(i)) End If s(i)=aryFileNameInclude_Variable(i) strContent="" strContent=LoadFromFile(BlogPath & "" & aryFileNameInclude(i),"utf-8") strContent=Replace(strContent,"<"&"%=ZC_BLOG_HOST%"&">",ZC_BLOG_HOST) aryTemplateTagsName(e+i)=s(i) aryTemplateTagsValue(e+i)=strContent Next End If ReDim Preserve aryTemplateTagsName(a+e+d) ReDim Preserve aryTemplateTagsValue(a+e+d) For j=1 to d i=Right("000" & CStr(j),3) aryTemplateTagsName(a+e+j)="ZC_MSG" & i Call Execute("aryTemplateTagsValue(a+e+j)=ZC_MSG" & i) Next ReDim t(b) t(1)="ZC_BLOG_VERSION" t(2)="ZC_BLOG_LANGUAGE" t(3)="ZC_BLOG_HOST" t(4)="ZC_BLOG_TITLE" t(5)="ZC_BLOG_SUBTITLE" t(6)="ZC_BLOG_NAME" t(7)="ZC_BLOG_SUB_NAME" t(8)="ZC_BLOG_CSS" t(9)="ZC_BLOG_COPYRIGHT" t(10)="ZC_BLOG_MASTER" t(11)="ZC_CONTENT_MAX" t(12)="ZC_EMOTICONS_FILENAME" t(13)="ZC_EMOTICONS_FILESIZE" t(14)="ZC_GUESTBOOK_CONTENT" t(15)="ZC_BLOG_CLSID" t(16)="ZC_TIME_ZONE" t(17)="ZC_IMAGE_WIDTH" t(18)="ZC_BLOG_THEME" t(19)="ZC_VERIFYCODE_WIDTH" t(20)="ZC_VERIFYCODE_HEIGHT" ReDim Preserve aryTemplateTagsName(a+e+d+b) ReDim Preserve aryTemplateTagsValue(a+e+d+b) For j=1 to b aryTemplateTagsName(a+e+d+j)=t(j) Call Execute("aryTemplateTagsValue(a+e+d+j)="& t(j)) Next ReDim Preserve aryTemplateTagsName(a+e+d+b+c) ReDim Preserve aryTemplateTagsValue(a+e+d+b+c) aryTemplateTagsName(a+e+d+b+c)="BLOG_CREATE_TIME" aryTemplateTagsValue(a+e+d+b+c)=GetTime(Now()) Application.Lock Application(ZC_BLOG_CLSID & "TemplateTagsName")=aryTemplateTagsName Application(ZC_BLOG_CLSID & "TemplateTagsValue")=aryTemplateTagsValue Application(ZC_BLOG_CLSID & "TemplatesName")=aryTemplatesName Application(ZC_BLOG_CLSID & "TemplatesContent")=aryTemplatesContent Application.UnLock TemplateTagsName=aryTemplateTagsName TemplateTagsValue=aryTemplateTagsValue TemplatesName=aryTemplatesName TemplatesContent=aryTemplatesContent Err.Clear Application.Lock Application(ZC_BLOG_CLSID & "TEMPLATEMODIFIED")=CheckTemplateModified() Application.UnLock Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE")=bolReLoadCache Application.UnLock LoadGlobeCache=True End Function '********************************************************* '********************************************************* ' 目的： Clear Cache '********************************************************* Function ClearGlobeCache() Application.Lock Application(ZC_BLOG_CLSID & "CACHE_ARTICLE_VIEWCOUNT")=Empty Application(ZC_BLOG_CLSID & "TemplateTagsName")=Empty Application(ZC_BLOG_CLSID & "TemplateTagsValue")=Empty Application(ZC_BLOG_CLSID & "TemplatesName")=Empty Application(ZC_BLOG_CLSID & "TemplatesContent")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TAG")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TRACKBACK")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-MULTI")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-GUESTBOOK")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_L")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_R")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_MUTUALITY")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-ISTOP")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_CATALOG")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_DEFAULT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_SEARCH")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_SINGLE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_TAGS")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE_COMMENT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_GUESTBOOK")=Empty Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATEMODIFIED")=Empty Application.UnLock ClearGlobeCache=True End Function '********************************************************* '********************************************************* ' 目的： Parse Tag 并格式化 '********************************************************* Function ParseTag(strTag) Dim s Dim t Dim i Dim Tag Dim b Dim objTag strTag=Trim(strTag) strTag=Replace(strTag,",",vbCrlf) strTag=Replace(strTag,"，",vbCrlf) strTag=TransferHTML(strTag,"[normalname]") strTag=Replace(strTag,vbCrlf,",") t=Split(strTag,",") For i=LBound(t) To UBound(t) t(i)=Trim(t(i)) Next GetTags() For i=LBound(t) To UBound(t) b=False For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(t(i)) Then b=True End If End If Next If b=False Then Set objTag=New TTag objTag.ID=0 objTag.Name=t(i) objTag.Order=0 objTag.Intro="" objTag.Post Set objTag=Nothing End If Next GetTags() For i=LBound(t) To UBound(t) For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(t(i)) Then t(i)="{"&Tag.ID&"}" End If End If Next Next s=Join(t) s=Replace(s," ","") ParseTag=s End Function '********************************************************* '********************************************************* ' 目的： 得到实际上的真实目录 '********************************************************* Function GetReallyDirectory() On Error Resume Next Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath ElseIf fso.FileExists(BlogPath & "\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\" ElseIf fso.FileExists(BlogPath & "\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\..\..\" End If Set fso=Nothing GetReallyDirectory=True Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 设置提示标志 '********************************************************* Function SetBlogHint(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles) Call SetBlogHintWithCLSID(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles,ZC_BLOG_CLSID) End Function '********************************************************* '********************************************************* ' 目的： 设置提示自定义标志 '********************************************************* Function SetBlogHint_Custom(strInfo) Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_OPERATEINFO")=Application(ZC_BLOG_CLSID & "SIGNAL_OPERATEINFO") & vbCrlf & strInfo Application.UnLock End Function '********************************************************* '********************************************************* ' 目的： 设置提示标志withCLSID '********************************************************* Function SetBlogHintWithCLSID(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles,newCLSID) Application.Lock Application(newCLSID & "SIGNAL_OPERATESUCCESS")=bolOperateSuccess If IsEmpty(bolRebuildIndex)=False Then Application(newCLSID & "SIGNAL_REBUILDINDEX")=bolRebuildIndex End If If IsEmpty(bolRebuildFiles)=False Then Application(newCLSID & "SIGNAL_REBUILDFILES")=bolRebuildFiles End If Application.UnLock End Function '********************************************************* '********************************************************* ' 目的： 输出提示 '********************************************************* Function GetBlogHint() Dim bolOperateSuccess,bolRebuildIndex,bolRebuildFiles,strOperateInfo Application.Lock bolOperateSuccess=Application(ZC_BLOG_CLSID & "SIGNAL_OPERATESUCCESS") bolRebuildIndex=Application(ZC_BLOG_CLSID & "SIGNAL_REBUILDINDEX") bolRebuildFiles=Application(ZC_BLOG_CLSID & "SIGNAL_REBUILDFILES") strOperateInfo=Application(ZC_BLOG_CLSID & "SIGNAL_OPERATEINFO") Application(ZC_BLOG_CLSID & "SIGNAL_OPERATEINFO")=Empty Application.UnLock If IsEmpty(bolOperateSuccess)=False Then If bolOperateSuccess=True Then Response.Write "

" & ZC_MSG266 & "

" End If If bolOperateSuccess=False Then Response.Write "

" & ZC_MSG267 & "

" End If Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_OPERATESUCCESS")=Empty Application.UnLock End If If IsEmpty(strOperateInfo)=False Then Dim s,t t=Split(strOperateInfo,vbCrlf) For Each s In t If s<>"" Then Response.Write "

" & s & "

" End If Next End If If IsEmpty(bolRebuildIndex)=False Then If bolRebuildIndex=True Then Response.Write "

" & ZC_MSG268 & "

" End If End If If IsEmpty(bolRebuildFiles)=False Then If bolRebuildFiles=True Then Response.Write "

" & ZC_MSG269 & "

" End If End If End Function '********************************************************* '********************************************************* ' 目的： 解析ZC_CUSTOM_DIRECTORY_REGEX '********************************************************* Function ParseCustomDirectory(strRegex,strPost,strCategory,strUser,strYear,strMonth,strDay,strID,strAlias) On Error Resume Next Dim s s=strRegex s=Replace(s,"{%post%}",strPost) s=Replace(s,"{%category%}",strCategory) s=Replace(s,"{%user%}",strUser) s=Replace(s,"{%year%}",strYear) s=Replace(s,"{%month%}",Right("0" & strMonth,2)) s=Replace(s,"{%day%}",Right("0" & strDay,2)) s=Replace(s,"{%id%}",strID) s=Replace(s,"{%alias%}",strAlias) ParseCustomDirectory=s Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 按照CustomDirectory指示创建相应的目录 '********************************************************* Sub CreatDirectoryByCustomDirectory(strCustomDirectory) On Error Resume Next Dim s Dim t Dim i Dim fso Set fso = CreateObject("Scripting.FileSystemObject") s=BlogPath t=Split(strCustomDirectory,"/") For i=LBound(t) To UBound(t) If (IsEmpty(t(i))=False) And (t(i)<>"") Then s=s & t(i) & "\" If (fso.FolderExists(fldr)=False) Then Call fso.CreateFolder(s) End If End If Next Set fso = Nothing Err.Clear End Sub '********************************************************* '********************************************************* ' 目的： 加入二级菜单项 '********************************************************* Function MakeSubMenu(strName,strUrl,strType,isNewWindows) Dim strSource strSource=strSource & "" strSource=strSource & "" & strName strSource=strSource & "" MakeSubMenu=strSource End Function '********************************************************* '********************************************************* ' 目的： 注册插件函数 '********************************************************* Function RegisterPlugin(strPluginName,strPluginActiveFunction) 'On Error Resume Next Dim i i=UBound(PluginName) ReDim Preserve PluginName(i+1) ReDim Preserve PluginActiveFunction(i+1) PluginName(i)=strPluginName PluginActiveFunction(i)=strPluginActiveFunction 'Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 激活插件函数 '********************************************************* Function ActivePlugin() On Error Resume Next Dim i For i=0 To UBound(PluginActiveFunction)-1 Call Execute(PluginActiveFunction(i)) Next Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 安装插件函数，只运行一次 '********************************************************* Function InstallPlugin(strPluginName) On Error Resume Next Call Execute("Call InstallPlugin_" & strPluginName & "()") Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 删除插件函数，只运行一次 '********************************************************* Function UninstallPlugin(strPluginName) On Error Resume Next Call Execute("Call UninstallPlugin_" & strPluginName & "()") Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 检测插件是否已激活 '********************************************************* Function CheckPluginState(strPluginName) CheckPluginState=CheckPluginStateByNewValue(strPluginName,ZC_BLOG_THEME & "|" & ZC_USING_PLUGIN_LIST) End Function '********************************************************* '********************************************************* ' 目的： 检测插件是否已激活 by new value '********************************************************* Function CheckPluginStateByNewValue(strPluginName,newZC_USING_PLUGIN_LIST) Dim s,i s=Split(newZC_USING_PLUGIN_LIST,"|") For i=LBound(s) To UBound(s) If UCase(s(i))=UCase(strPluginName) Then CheckPluginStateByNewValue=True Exit Function End If Next CheckPluginStateByNewValue=False End Function '********************************************************* '********************************************************* ' 目的：挂上Action接口 ' 参数：'plugname:接口名称 'actioncode:要执行的语句，要转义为Execute可执行语句 '********************************************************* Function Add_Action_Plugin(plugname,actioncode) On Error Resume Next actioncode=Replace(actioncode,"Exit Function","b" & plugname & "=True") actioncode=Replace(actioncode,"Exit Sub","b" & plugname & "=True") Call Execute("ReDim Preserve " & plugname & "(UBound("& plugname &")+1)") Call Execute(plugname & "(UBound("& plugname &"))=" & plugname & "(UBound("& plugname &"))&""" & Replace(actioncode,"""","""""") & """" & ":") Err.Clear End Function '********************************************************* '********************************************************* ' 目的：挂上Filter接口 ' 参数：'plugname:接口名称 'functionname:要挂接的函数名 '********************************************************* Function Add_Filter_Plugin(plugname,functionname) On Error Resume Next Call Execute("s" & plugname & "=" & "s" & plugname & "&""" & functionname & """" & "& ""|""") Err.Clear End Function '********************************************************* '********************************************************* ' 目的：挂上Response接口 ' 参数：'plugname:接口名称 'parameter:要写入的内容 '********************************************************* Function Add_Response_Plugin(plugname,parameter) On Error Resume Next Call Execute(plugname & "=" & plugname & "&""" & Replace(parameter,"""","""""") & """") Err.Clear End Function '********************************************************* '********************************************************* ' 目的：GetSettingFormName '********************************************************* Function GetSettingFormName(s) On Error Resume Next Dim x Call Execute("x=" & s) GetSettingFormName=x Err.Clear End Function '********************************************************* '********************************************************* ' 目的：GetSettingFormName with Default '********************************************************* Function GetSettingFormNameWithDefault(s,d) On Error Resume Next Err.Clear Dim x Call Execute("x=" & s) GetSettingFormNameWithDefault=x If Err.Number<>0 Then GetSettingFormNameWithDefault=d End If Err.Clear End Function '********************************************************* '********************************************************* ' 目的：GetNameFormTheme '********************************************************* Function GetNameFormTheme(s) On Error Resume Next GetNameFormTheme=s Dim objXmlFile Set objXmlFile=Server.CreateObject("Microsoft.XMLDOM") objXmlFile.async = False objXmlFile.ValidateOnParse=False objXmlFile.load(BlogPath & "themes" & "/" & s & "/" & "theme.xml") If objXmlFile.readyState=4 Then If objXmlFile.parseError.errorCode <> 0 Then Else GetNameFormTheme=objXmlFile.documentElement.selectSingleNode("name").text End If End If Err.Clear End Function '********************************************************* '********************************************************* ' 目的： Blog ReBuild 核心 '********************************************************* Function MakeBlogReBuild_Core() On Error Resume Next 'plugin node For Each sAction_Plugin_MakeBlogReBuild_Core_Begin in Action_Plugin_MakeBlogReBuild_Core_Begin If Not IsEmpty(sAction_Plugin_MakeBlogReBuild_Core_Begin) Then Call Execute(sAction_Plugin_MakeBlogReBuild_Core_Begin) If bAction_Plugin_MakeBlogReBuild_Core_Begin=True Then Exit Function Next BlogReBuild_Statistics BlogReBuild_Archives BlogReBuild_Previous BlogReBuild_Comments BlogReBuild_GuestComments BlogReBuild_TrackBacks BlogReBuild_Catalogs BlogReBuild_Calendar BlogReBuild_Authors BlogReBuild_Tags 'BlogReBuild_Categorys BuildAllCache ExportRSS 'ExportATOM Call ClearGlobeCache() Call LoadGlobeCache() Dim bolOperateSuccess Application.Lock bolOperateSuccess=Application(ZC_BLOG_CLSID & "SIGNAL_OPERATESUCCESS") Application.UnLock Call SetBlogHint(bolOperateSuccess,False,Empty) MakeBlogReBuild_Core=True 'plugin node For Each sAction_Plugin_MakeBlogReBuild_Core_End in Action_Plugin_MakeBlogReBuild_Core_End If Not IsEmpty(sAction_Plugin_MakeBlogReBuild_Core_End) Then Call Execute(sAction_Plugin_MakeBlogReBuild_Core_End) If bAction_Plugin_MakeBlogReBuild_Core_End=True Then Exit Function Next Err.Clear End Function '********************************************************* '********************************************************* ' 目的： 全新的部份索引程序 '********************************************************* Function BuildAllCache() 'plugin node For Each sAction_Plugin_BuildAllCache_Begin in Action_Plugin_BuildAllCache_Begin If Not IsEmpty(sAction_Plugin_BuildAllCache_Begin) Then Call Execute(sAction_Plugin_BuildAllCache_Begin) If bAction_Plugin_BuildAllCache_Begin=True Then Exit Function Next Dim strList Dim ArticleList Dim AuthList Dim CateList Dim TagsList Dim aryAllList() Dim objRS Dim i Dim j Dim n Dim l Dim k Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT [log_ID] FROM [blog_Article] WHERE ([log_Level]>1) AND ([log_Istop]=False) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT ReDim aryAllList(objRS.PageCount+1) For i=1 to objRS.PageCount objRS.AbsolutePage=i For j = 1 To objRS.PageSize If j=1 Then aryAllList(i)="AllPage" & i & "[" If i=1 Then aryAllList(i)=aryAllList(i) & objRS("log_ID") & ";" End If If j=objRS.PageSize Then aryAllList(i)=aryAllList(i) & "]" objRS.MoveNext If objRS.EOF Then aryAllList(i)=aryAllList(i) & "]":Exit For Next Next End If objRS.Close strList=strList & Join(aryAllList) Erase aryAllList objRS.Open("SELECT [log_ID] FROM [blog_Article] WHERE ([log_Level]>1) AND ([log_Istop]=True) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT ReDim aryAllList(objRS.PageCount+1) For i=1 to objRS.PageCount objRS.AbsolutePage=i For j = 1 To objRS.PageSize If j=1 Then aryAllList(i)="IstopPage" & i & "[" aryAllList(i)=aryAllList(i) & objRS("log_ID") & ";" If j=objRS.PageSize Then aryAllList(i)=aryAllList(i) & "]" objRS.MoveNext If objRS.EOF Then aryAllList(i)=aryAllList(i) & "]":Exit For Next Next End If objRS.Close strList=strList & Join(aryAllList) Erase aryAllList Call SaveToFile(BlogPath & "/CACHE/cache_list_"&ZC_BLOG_CLSID&".html",strList,"utf-8",False) BuildAllCache=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Calendar() 'plugin node For Each sAction_Plugin_BlogReBuild_Calendar_Begin in Action_Plugin_BlogReBuild_Calendar_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Calendar_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Calendar_Begin) If bAction_Plugin_BlogReBuild_Calendar_Begin=True Then Exit Function Next Dim objStream Dim strCalendar Dim i,j Dim objRS Dim k,l,m,n 'Calendar strCalendar=MakeCalendar("") strCalendar=TransferHTML(strCalendar,"[no-asp]") Call SaveToFile(BlogPath & "/include/calendar.asp",strCalendar,"utf-8",True) BlogReBuild_Calendar=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Archives() 'plugin node For Each sAction_Plugin_BlogReBuild_Archives_Begin in Action_Plugin_BlogReBuild_Archives_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Archives_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Archives_Begin) If bAction_Plugin_BlogReBuild_Archives_Begin=True Then Exit Function Next Dim i Dim j Dim l Dim n Dim objRS Dim objStream Dim ArtList 'Archives Dim strArchives Set objRS=objConn.Execute("SELECT * FROM [blog_Article] WHERE ([log_Level]>1) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then Dim dtmYM() i=0 j=0 ReDim Preserve dtmYM(0) Do While Not objRS.eof j=UBound(dtmYM) i=Year(objRS("log_PostTime")) & "-" & Month(objRS("log_PostTime")) If i<>dtmYM(j) Then ReDim Preserve dtmYM(j+1) dtmYM(j+1)=i End If objRS.MoveNext Loop End If objRS.Close Set objRS=Nothing If Not IsEmpty(dtmYM) Then For i=1 to UBound(dtmYM) l=Year(dtmYM(i)) n=Month(dtmYM(i))+1 IF n>12 Then l=l+1:n=1 Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Article] WHERE ([log_Level]>1) AND [log_PostTime] BETWEEN #"& Year(dtmYM(i)) &"-"& Month(dtmYM(i)) &"-1# AND #"& l &"-"& n &"-1#") If (Not objRS.bof) And (Not objRS.eof) Then If ZC_MOONSOFT_PLUGIN_ENABLE=True Then strArchives=strArchives & "
  • " & Year(dtmYM(i)) & " " & ZVA_Month(Month(dtmYM(i))) & " (" & objRS(0) & ")" +"
    • " ' Call BuildCategory(Empty,Empty,Empty,Year(dtmYM(i)) & "-" & Month(dtmYM(i)),Empty,ZC_DISPLAY_MODE_ALL,ZC_STATIC_DIRECTORY,Year(dtmYM(i)) & "_" & Month(dtmYM(i))& "." & ZC_STATIC_TYPE) Else strArchives=strArchives & "
  • " & Year(dtmYM(i)) & " " & ZVA_Month(Month(dtmYM(i))) & " (" & objRS(0) & ")" +"
    • " End If If ZC_ARCHIVE_COUNT>0 Then If i=ZC_ARCHIVE_COUNT Then Exit For End If End If objRS.Close Set objRS=Nothing Next End If strArchives=TransferHTML(strArchives,"[no-asp]") Call SaveToFile(BlogPath & "/include/archives.asp",strArchives,"utf-8",True) BlogReBuild_Archives=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Catalogs() 'plugin node For Each sAction_Plugin_BlogReBuild_Catalogs_Begin in Action_Plugin_BlogReBuild_Catalogs_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Catalogs_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Catalogs_Begin) If bAction_Plugin_BlogReBuild_Catalogs_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim ArtList 'Catalogs Dim strCatalog Set objRS=objConn.Execute("SELECT * FROM [blog_Category] ORDER BY [cate_Order] ASC,[cate_Count] DESC,[cate_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof strCatalog=strCatalog & "
  •  "+Categorys(objRS("cate_ID")).Name + " (" & Categorys(objRS("cate_ID")).Count & ")" +"
    • " 'If ZC_MOONSOFT_PLUGIN_ENABLE=True Then ' Call BuildCategory(Empty,Categorys(objRS("cate_ID")).ID,Empty,Empty,Empty,ZC_DISPLAY_MODE_ALL,Categorys(objRS("cate_ID")).Directory,Categorys(objRS("cate_ID")).FileName) 'End If objRS.MoveNext Loop End If objRS.Close Set objRS=Nothing strCatalog=TransferHTML(strCatalog,"[no-asp]") Call SaveToFile(BlogPath & "/include/catalog.asp",strCatalog,"utf-8",True) BlogReBuild_Catalogs=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Categorys() 'plugin node For Each sAction_Plugin_BlogReBuild_Categorys_Begin in Action_Plugin_BlogReBuild_Categorys_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Categorys_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Categorys_Begin) If bAction_Plugin_BlogReBuild_Categorys_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim objArticle Dim i 'Categorys Dim strCategory Dim Category For Each Category in Categorys If IsObject(Category) Then Set objRS=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>1) AND ([log_CateID]="&Category.ID&") ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_PREVIOUS_COUNT Set objArticle=New TArticle If objArticle.LoadInfoByID(objRS("log_ID")) Then strCategory=strCategory & "
  • " & objArticle.Title & "
    • " End If Set objArticle=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close strCategory=TransferHTML(strCategory,"[no-asp]") Call SaveToFile(BlogPath & "/include/category_"&Category.ID&".asp",strCategory,"utf-8",True) strCategory="" End If Next BlogReBuild_Categorys=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Authors() 'plugin node For Each sAction_Plugin_BlogReBuild_Authors_Begin in Action_Plugin_BlogReBuild_Authors_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Authors_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Authors_Begin) If bAction_Plugin_BlogReBuild_Authors_Begin=True Then Exit Function Next Dim objRS Dim objStream 'Authors Dim strAuthor Dim User For Each User in Users If IsObject(User) Then strAuthor=strAuthor & "
  • "+User.Name + " (" & User.Count & ")" +"
    • " End If Next strAuthor=TransferHTML(strAuthor,"[no-asp]") Call SaveToFile(BlogPath & "/include/authors.asp",strAuthor,"utf-8",True) BlogReBuild_Authors=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Tags() 'plugin node For Each sAction_Plugin_BlogReBuild_Tags_Begin in Action_Plugin_BlogReBuild_Tags_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Tags_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Tags_Begin) If bAction_Plugin_BlogReBuild_Tags_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim i,j i=GetSettingFormName("ZC_TAGS_DISPLAY_COUNT") If i="" Then i=50 j=0 'Authors Dim strTag Set objRS=objConn.Execute("SELECT * FROM [blog_Tag] ORDER BY [tag_Count] DESC,[tag_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof If j=i Then Exit Do strTag=strTag & "
  • "+Tags(objRS("tag_ID")).Name + " (" & Tags(objRS("tag_ID")).Count & ")" +"
    • " objRS.MoveNext j=j+1 Loop End If objRS.Close Set objRS=Nothing strTag=TransferHTML(strTag,"[no-asp]") Call SaveToFile(BlogPath & "/include/tags.asp",strTag,"utf-8",True) BlogReBuild_Tags=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Previous() 'plugin node For Each sAction_Plugin_BlogReBuild_Previous_Begin in Action_Plugin_BlogReBuild_Previous_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Previous_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Previous_Begin) If bAction_Plugin_BlogReBuild_Previous_Begin=True Then Exit Function Next Dim i Dim objRS Dim objStream Dim objArticle 'Previous Dim strPrevious Set objRS=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>1) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_PREVIOUS_COUNT Set objArticle=New TArticle If objArticle.LoadInfoByID(objRS("log_ID")) Then strPrevious=strPrevious & "
  • ["& Right("0" & Month(objArticle.PostTime),2) & "/" & Right("0" & Day(objArticle.PostTime),2) &"]" & objArticle.Title & "
    • " End If Set objArticle=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close strPrevious=TransferHTML(strPrevious,"[no-asp]") Call SaveToFile(BlogPath & "/include/previous.asp",strPrevious,"utf-8",True) BlogReBuild_Previous=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Comments() 'plugin node For Each sAction_Plugin_BlogReBuild_Comments_Begin in Action_Plugin_BlogReBuild_Comments_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Comments_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Comments_Begin) If bAction_Plugin_BlogReBuild_Comments_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim objArticle 'Comments Dim strComments Dim s Dim i Set objRS=objConn.Execute("SELECT [log_ID],[comm_ID],[comm_Content],[comm_PostTime],[comm_Author] FROM [blog_Comment] WHERE [log_ID]>0 ORDER BY [comm_PostTime] DESC,[comm_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_MSG_COUNT s=objRS("comm_Content") s=Replace(s,vbCrlf,"") If (Len(s)>ZC_RECENT_COMMENT_WORD_MAX) And (ZC_RECENT_COMMENT_WORD_MAX>(Len(ZC_MSG305)+1)) Then s=Left(s,ZC_RECENT_COMMENT_WORD_MAX-(Len(ZC_MSG305)+1))&ZC_MSG305 Set objArticle=New TArticle If objArticle.LoadInfoByID(objRS("log_ID")) Then strComments=strComments & "
  • "+s+"
    • " End If Set objArticle=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close Set objRS=Nothing strComments=TransferHTML(strComments,"[no-asp]") Call SaveToFile(BlogPath & "/include/comments.asp",strComments,"utf-8",True) BlogReBuild_Comments=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_GuestComments() 'plugin node For Each sAction_Plugin_BlogReBuild_GuestComments_Begin in Action_Plugin_BlogReBuild_GuestComments_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_GuestComments_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_GuestComments_Begin) If bAction_Plugin_BlogReBuild_GuestComments_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim objArticle 'Comments Dim strComments Dim s Dim i Set objRS=objConn.Execute("SELECT [log_ID],[comm_ID],[comm_Content],[comm_PostTime],[comm_Author] FROM [blog_Comment] WHERE [log_ID]=0 ORDER BY [comm_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_MSG_COUNT s=objRS("comm_Content") s=Replace(s,vbCrlf,"") If (len(s)>ZC_RECENT_COMMENT_WORD_MAX) And (ZC_RECENT_COMMENT_WORD_MAX>(Len(ZC_MSG305)+1)) Then s=Left(s,ZC_RECENT_COMMENT_WORD_MAX-(Len(ZC_MSG305)+1))&ZC_MSG305 strComments=strComments & "
  • "+s+"
    • " objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close Set objRS=Nothing strComments=TransferHTML(strComments,"[no-asp]") Call SaveToFile(BlogPath & "/include/guestcomments.asp",strComments,"utf-8",True) BlogReBuild_GuestComments=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_TrackBacks() 'plugin node For Each sAction_Plugin_BlogReBuild_TrackBacks_Begin in Action_Plugin_BlogReBuild_TrackBacks_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_TrackBacks_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_TrackBacks_Begin) If bAction_Plugin_BlogReBuild_TrackBacks_Begin=True Then Exit Function Next Dim objRS Dim objStream Dim objArticle 'TrackBacks Dim strTrackBacks Dim s Dim i Set objRS=objConn.Execute("SELECT * FROM [blog_TrackBack] ORDER BY [tb_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_MSG_COUNT s=objRS("tb_Title") s=Replace(s,vbCrlf,"") If (len(s)>ZC_RECENT_COMMENT_WORD_MAX) And (ZC_RECENT_COMMENT_WORD_MAX>(Len(ZC_MSG305)+1)) Then s=Left(s,ZC_RECENT_COMMENT_WORD_MAX-(Len(ZC_MSG305)+1))&ZC_MSG305 Set objArticle=New TArticle If objArticle.LoadInfoByID(objRS("log_ID")) Then strTrackBacks=strTrackBacks & "
  • "+s+"
    • " End If Set objArticle=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close Set objRS=Nothing strTrackBacks=TransferHTML(strTrackBacks,"[no-asp]") Call SaveToFile(BlogPath & "/include/trackbacks.asp",strTrackBacks,"utf-8",True) BlogReBuild_TrackBacks=True End Function '********************************************************* '********************************************************* ' 目的： '********************************************************* Function BlogReBuild_Statistics() 'plugin node For Each sAction_Plugin_BlogReBuild_Statistics_Begin in Action_Plugin_BlogReBuild_Statistics_Begin If Not IsEmpty(sAction_Plugin_BlogReBuild_Statistics_Begin) Then Call Execute(sAction_Plugin_BlogReBuild_Statistics_Begin) If bAction_Plugin_BlogReBuild_Statistics_Begin=True Then Exit Function Next Dim i Dim objRS Dim objStream '重新统计分类及用户的文章数、评论数 Dim Category For Each Category in Categorys If IsObject(Category) Then Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Article] WHERE [log_Level]>1 AND [log_CateID]=" & Category.ID ) i=objRS(0) objConn.Execute("UPDATE [blog_Category] SET [cate_Count]="&i&" WHERE [cate_ID] =" & Category.ID) Set objRS=Nothing End If Next Dim User 'For Each User in Users ' If IsObject(User) Then ' Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Article] WHERE [log_Level]>1 AND [log_AuthorID]=" & User.ID ) ' i=objRS(0) ' objConn.Execute("UPDATE [blog_Member] SET [mem_PostLogs]="&i&" WHERE [mem_ID] =" & User.ID) ' Set objRS=Nothing ' ' Set objRS=objConn.Execute("SELECT COUNT([comm_ID]) FROM [blog_Comment] WHERE [comm_AuthorID]=" & User.ID ) ' i=objRS(0) ' objConn.Execute("UPDATE [blog_Member] SET [mem_PostComms]="&i&" WHERE [mem_ID] =" & User.ID) ' Set objRS=Nothing ' End If 'Next 'Dim Tag 'For Each Tag in Tags ' If IsObject(Tag) Then ' Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Article] WHERE [log_Level]>1 AND [log_Tag] LIKE '%{" & Tag.ID & "}%'") ' i=objRS(0) ' objConn.Execute("UPDATE [blog_Tag] SET [tag_Count]="&i&" WHERE [tag_ID] =" & Tag.ID) ' Set objRS=Nothing ' End If 'Next 'Statistics Dim strStatistics Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT COUNT([log_ID])AS allArticle,SUM([log_CommNums]) AS allCommNums,SUM([log_ViewNums]) AS allViewNums,SUM([log_TrackBackNums]) AS allTrackBackNums FROM [blog_Article]") If (Not objRS.bof) And (Not objRS.eof) Then strStatistics=strStatistics & "
  • "& ZC_MSG082 &":" & objRS("allArticle") & "
    • " strStatistics=strStatistics & "
  • "& ZC_MSG124 &":" & objRS("allCommNums") & "
    • " strStatistics=strStatistics & "
  • "& ZC_MSG125 &":" & objRS("allTrackBackNums") & "
    • " strStatistics=strStatistics & "
  • "& ZC_MSG129 &":" & objRS("allViewNums") & "
    • " End If objRS.Close objRS.Open("SELECT COUNT([comm_ID])AS allComment FROM [blog_Comment] WHERE [log_ID]=0") If (Not objRS.bof) And (Not objRS.eof) Then strStatistics=strStatistics & "
  • "& ZC_MSG284 &":" & objRS("allComment") & "
    • " End If objRS.Close strStatistics=strStatistics & "
  • "& ZC_MSG306 &":" & GetNameFormTheme(ZC_BLOG_THEME) & "
    • " strStatistics=strStatistics & "
  • "& ZC_MSG083 &":" & ZC_BLOG_CSS & "
    • " 'strStatistics=strStatistics & "
  • "& ZC_MSG084 &":" & ZC_BLOG_LANGUAGE & "
    • " Set objRS=Nothing strStatistics=TransferHTML(strStatistics,"[no-asp]") Call SaveToFile(BlogPath & "/include/statistics.asp",strStatistics,"utf-8",False) Call GetCategory() Call GetUser() Call GetTags() Call GetKeyWords() BlogReBuild_Statistics=True End Function '********************************************************* '///////////////////////////////////////////////////////////////////////////////////////// '********************************************************* ' 目的： Export RSS 2.0 '********************************************************* Function ExportRSS() 'plugin node For Each sAction_Plugin_ExportRSS_Begin in Action_Plugin_ExportRSS_Begin If Not IsEmpty(sAction_Plugin_ExportRSS_Begin) Then Call Execute(sAction_Plugin_ExportRSS_Begin) If bAction_Plugin_ExportRSS_Begin=True Then Exit Function Next Dim Rss2Export Dim objArticle Set Rss2Export = New TNewRss2Export With Rss2Export .TimeZone=ZC_TIME_ZONE .AddChannelAttribute "title",TransferHTML(ZC_BLOG_TITLE,"[html-format]") .AddChannelAttribute "link",TransferHTML(ZC_BLOG_HOST,"[html-format]") .AddChannelAttribute "description",TransferHTML(ZC_BLOG_SUBTITLE,"[html-format]") .AddChannelAttribute "generator","RainbowSoft Studio Z-Blog " & ZC_BLOG_VERSION .AddChannelAttribute "language",ZC_BLOG_LANGUAGE .AddChannelAttribute "copyright",TransferHTML(ZC_BLOG_COPYRIGHT,"[nohtml][html-format]") .AddChannelAttribute "pubDate",GetTime(Now()) Dim i 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]>0) AND ([log_Level]>2) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_RSS2_COUNT Set objArticle=New TArticle If objArticle.LoadInfoByArray(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"),objRS("log_Istop"))) Then If ZC_RSS_EXPORT_WHOLE Then .AddItem objArticle.HtmlTitle,Users(objArticle.AuthorID).Email & " (" & Users(objArticle.AuthorID).Name & ")",objArticle.HtmlUrl,objArticle.PostTime,objArticle.HtmlUrl,objArticle.HtmlContent,Categorys(objArticle.CateID).HtmlName,objArticle.CommentUrl,objArticle.WfwComment,objArticle.WfwCommentRss,objArticle.TrackBackUrl Else .AddItem objArticle.HtmlTitle,Users(objArticle.AuthorID).Email & " (" & Users(objArticle.AuthorID).Name & ")",objArticle.HtmlUrl,objArticle.PostTime,objArticle.HtmlUrl,objArticle.HtmlIntro,Categorys(objArticle.CateID).HtmlName,objArticle.CommentUrl,objArticle.WfwComment,objArticle.WfwCommentRss,objArticle.TrackBackUrl End If End If objRS.MoveNext If objRS.eof Then Exit For Set objArticle=Nothing Next End If End With 'Rss2Export.Execute Rss2Export.SaveToFile(BlogPath & "/rss.xml") Set Rss2Export = Nothing objRS.close Set objRS=Nothing ExportRSS=True 'Response.ContentType = "text/html" 'Response.Clear End Function '********************************************************* '********************************************************* ' 目的： Export ATOM 1.0 '********************************************************* Function ExportATOM() 'plugin node For Each sAction_Plugin_ExportATOM_Begin in Action_Plugin_ExportATOM_Begin If Not IsEmpty(sAction_Plugin_ExportATOM_Begin) Then Call Execute(sAction_Plugin_ExportATOM_Begin) If bAction_Plugin_ExportATOM_Begin=True Then Exit Function Next Dim objArticle Dim Atom10Export Set Atom10Export = New TAtom10Export Atom10Export.TimeZone=ZC_TIME_ZONE Dim AtomEntry Dim AtomFeed Set AtomFeed = New TAtomFeed With AtomFeed .atomTitle=TransferHTML(ZC_BLOG_TITLE,"[html-format]") .atomSubtitle=TransferHTML(ZC_BLOG_SUBTITLE,"[html-format]") .atomID=ZC_BLOG_HOST .atomLink "alternate","text/html",ZC_BLOG_HOST .atomLink "self","application/atom+xml",ZC_BLOG_HOST & "atom.xml" '.atomPerson "author",BlogUser.Name,BlogUser.Email,BlogUser.HomePage .atomGenerator "RainbowSoft Studio Z-Blog","http://www.rainbowsoft.org/",ZC_BLOG_VERSION .atomUpdated=GetTime(Now()) End With Atom10Export.GetFeed(AtomFeed.Node) Dim i Dim objRS Set objRS=objConn.Execute("SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],NULL,[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) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 to ZC_RSS2_COUNT Set objArticle=New TArticle Set AtomEntry = New TAtomEntry With AtomEntry If objArticle.LoadInfoByArray(Array(objRS("log_ID"),objRS("log_Tag"),objRS("log_CateID"),objRS("log_Title"),objRS("log_Intro"),,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 .atomTitle=objArticle.HtmlTitle .atomPerson "author",Users(objArticle.AuthorID).Name,Users(objArticle.AuthorID).Email,Users(objArticle.AuthorID).HomePage .atomCategory "",Categorys(objArticle.CateID).Url,Categorys(objArticle.CateID).HtmlName .atomUpdated=objArticle.PostTime .atomPublished=objArticle.PostTime .atomSummary=objArticle.HtmlIntro .atomLink "alternate","text/html",objArticle.Url .atomID=objArticle.Url End If End With Atom10Export.GetEntry(AtomEntry.Node) Set AtomEntry = Nothing Set objArticle=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.close Set objRS=Nothing 'Atom10Export.Execute Atom10Export.SaveToFile(BlogPath & "/atom.xml") Set Atom10Export = Nothing ExportATOM=True 'Response.ContentType = "text/html" 'Response.Clear End Function '********************************************************* '********************************************************* ' 目的： Build Category '********************************************************* Function BuildCategory(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType,strDirectory,strFileName) Dim ArtList Set ArtList=New TArticleList ArtList.LoadCache ArtList.template="CATALOG" If ArtList.ExportByMixed(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Then ArtList.FileName=strFileName ArtList.Directory=strDirectory ArtList.Build ArtList.Save End If Set ArtList=Nothing End Function '********************************************************* '********************************************************* ' 目的： Build Article '********************************************************* Function BuildArticle(intID,bolBuildNavigate,bolBuildCategory) Dim objArticle Set objArticle=New TArticle If objArticle.LoadInfoByID(intID) Then objArticle.Statistic objArticle.template="SINGLE" If objArticle.Export(ZC_DISPLAY_MODE_ALL) Then objArticle.SaveCache objArticle.Build objArticle.Save If (bolBuildCategory=True) And (ZC_MOONSOFT_PLUGIN_ENABLE=True) Then Call BuildCategory(Empty,Categorys(objArticle.CateID).ID,Empty,Empty,Empty,ZC_DISPLAY_MODE_ALL,Categorys(objArticle.CateID).Directory,Categorys(objArticle.CateID).FileName) Call BuildCategory(Empty,Empty,Empty,Year(objArticle.PostTime) & "-" & Month(objArticle.PostTime),Empty,ZC_DISPLAY_MODE_ALL,ZC_STATIC_DIRECTORY,Year(objArticle.PostTime) & "_" & Month(objArticle.PostTime) & "." & ZC_STATIC_TYPE) End If End If If (bolBuildNavigate=True) And (ZC_USE_NAVIGATE_ARTICLE=True) Then Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [log_ID] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]<#" & objArticle.PostTime & "#) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then Call BuildArticle(objRS("log_ID"),False,False) End If Set objRS=Nothing Set objRS=objConn.Execute("SELECT TOP 1 [log_ID] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]>#" & objArticle.PostTime & "#) ORDER BY [log_PostTime] ASC") If (Not objRS.bof) And (Not objRS.eof) Then Call BuildArticle(objRS("log_ID"),False,False) End If Set objRS=Nothing End If BuildArticle=True End If Set objArticle=Nothing End Function '********************************************************* %>