<% sub CreateArticle(ArticleID) dim TemplateContent,tempTemplateContent,Title,Content,ClassID dim rsTemplate,sqlTemplate dim fso,filePath,myfile,strStream Set fso = CreateObject("Scripting.FileSystemObject") sqlTemplate = "SELECT TemplateContent,Title,Content,ClassID FROM Article INNER JOIN PE_Template ON Article.LayoutID = PE_Template.TemplateID WHERE Article.ArticleID=" & ArticleID set rsTemplate=server.CreateObject("adodb.recordset") rsTemplate.open sqlTemplate,conn,1,1 if not rsTemplate.eof then TemplateContent=rsTemplate(0) Title=rsTemplate(1) Content=rsTemplate(2) ClassID=rsTemplate(3) end if rsTemplate.close set rsTemplate=nothing tempTemplateContent = TemplateContent 'filePath=server.mappath("../menu.asp") 'Set myfile = fso.OpenTextFile(filePath,1) 'strStream = myfile.ReadAll 'myfile.Close 'tempTemplateContent = replace(tempTemplateContent,"{$Menu}",strStream) tempTemplateContent = replace(tempTemplateContent,"{$ParentClassName}",ParentClassName(ClassID)) tempTemplateContent = replace(tempTemplateContent,"{$ShowChildClass}",ShowChildClass(ClassID)) tempTemplateContent = replace(tempTemplateContent,"{$CurrentContext}",ShowCurrentContext(ArticleID,false)) tempTemplateContent = replace(tempTemplateContent,"{$SiteTitle}",SiteTitle) tempTemplateContent = replace(tempTemplateContent,"{$ArticleTitle}",Title) tempTemplateContent = replace(tempTemplateContent,"{$ArticleContent}",Content) tempTemplateContent = replace(tempTemplateContent,"{$ArticleInfo}",ShowArticleInfo()) if instr(tempTemplateContent,"{$ArticleComment}")>0 then tempTemplateContent = replace(tempTemplateContent,"{$ArticleComment}",ShowComment(10)) end if tempTemplateContent = replace(tempTemplateContent,"{$ArticleID}",ArticleID) tempTemplateContent = replace(tempTemplateContent,"{$InstallDir}",InstallDir) 'fos call CreateFile(ArticleFilePath(ArticleID),tempTemplateContent) end sub Sub CreateFile(filePath,strStream) Dim fso, tf,path,filename Set fso = CreateObject("Scripting.FileSystemObject") filePath = server.mappath(filePath) Path=Left(filePath,InstrRev(filePath,"\")-1) if not fso.FolderExists(Path) then fso.CreateFolder(Path) end if 'fso.CreateTextFile(filePath) Set tf = fso.CreateTextFile(filePath, True) tf.Write(strStream) tf.Close End Sub '================================================= '过程名：ShowChildClass '作 用：显示当前栏目的下一级子栏目 '================================================= function ShowChildClass(ClassID) dim sqlChild,rsChild,i,format,tempClassID dim rsGlobal Set rsGlobal = Server.CreateObject("ADODB.Recordset") rsGlobal.open "select ParentID,Child From ArticleClass where ClassID=" & ClassID,conn,1,1 if not rsGlobal.eof then if rsGlobal("Child") = 0 and rsGlobal("ParentID") <> 0 then tempClassID = rsGlobal("ParentID") else tempClassID = ClassID end if end if rsGlobal.close set rsGlobal = nothing format = "{classname}{childnum}" sqlChild="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From ArticleClass C" sqlChild= sqlChild & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & tempClassID & " order by C.OrderID" Set rsChild= Server.CreateObject("ADODB.Recordset") rsChild.open sqlChild,conn,1,1 if rsChild.bof and rsChild.eof then ShowChildClass=""'response.write "没有任何子栏目" else dim Childnum,temp,temp2 do while not rsChild.eof if rsChild(6)>0 then Childnum = "(" & rsChild(6) & ")" end if if rsChild(5)<>"" then temp = replace(format,"{classurl}",InstallDir & rsChild(5)) else temp = replace(format,"{classurl}",ClassFilePath(rsChild(0))) end if temp2 = temp2 & replace(replace(temp,"{classname}",rsChild(1)),"{childnum}",Childnum) rsChild.movenext loop ShowChildClass = temp2 end if rsChild.close set rsChild=nothing end function '================================================= '过程名：ShowArticleContent '作 用：显示文章具体信息 '参 数：无 '================================================= function ShowArticleInfo() dim Author,CopyFrom,Hits,UpdateTime dim sqlArticleInfo,rsArticleInfo sqlArticleInfo = "SELECT Author,CopyFrom,Hits,UpdateTime FROM Article INNER JOIN PE_Template ON Article.LayoutID = PE_Template.TemplateID WHERE Article.ArticleID=" & ArticleID set rsArticleInfo=server.CreateObject("adodb.recordset") rsArticleInfo.open sqlArticleInfo,conn,1,1 if not rsArticleInfo.eof then Author=rsArticleInfo(0) CopyFrom=rsArticleInfo(1) Hits=rsArticleInfo(2) UpdateTime=rsArticleInfo(3) end if rsArticleInfo.close set rsArticleInfo=nothing ShowArticleInfo = ShowArticleInfo & "［" ShowArticleInfo = ShowArticleInfo & "作者：" if instr(Author,"|")>0 then ShowArticleInfo = ShowArticleInfo & "" & left(Author,instr(Author,"|")-1) & "" else ShowArticleInfo = ShowArticleInfo & Author end if 'ShowArticleInfo = ShowArticleInfo & " 转贴自：" 'if instr(CopyFrom,"|")>0 then ' ShowArticleInfo = ShowArticleInfo & "" & left(CopyFrom,instr(CopyFrom,"|")-1) & "" 'else ' ShowArticleInfo = ShowArticleInfo & CopyFrom 'end if 'ShowArticleInfo = ShowArticleInfo & " 点击数：" & Hits ShowArticleInfo = ShowArticleInfo & " 更新时间：" & FormatDateTime(UpdateTime,2) ShowArticleInfo = ShowArticleInfo & "］" end function '================================================= '过程名：ShowComment '作 用：显示相关评论 '参 数：CommentNum ----最多显示多少个评论 '================================================= function ShowComment(CommentNum) dim rsComment,sqlComment,rsCommentUser if CommentNum>0 and CommentNum<=100 then sqlComment="select top " & CommentNum else sqlComment="select top 10 " end if sqlComment=sqlComment & " * from ArticleComment where ArticleID=" & ArticleID & " order by CommentID desc" Set rsComment= Server.CreateObject("ADODB.Recordset") rsComment.open sqlComment,conn,1,1 if rsComment.bof and rsComment.eof then ShowComment = ShowComment & "    没有任何评论" else ShowComment = ShowComment & "" do while not rsComment.eof ShowComment = ShowComment & "" ShowComment = ShowComment & "" rsComment.movenext loop ShowComment = ShowComment & "

" if rsComment("UserType")=1 then ShowComment = ShowComment & " 会员" set rsCommentUser=Conn_User.execute("select " & db_User_ID & "," & db_User_Name & "," & db_User_Email & "," & db_User_QQ & "," & db_User_Homepage & " from " & db_User_Table & " where " & db_User_Name & "='" & rsComment("UserName") & "'") if rsCommentUser.bof and rsCommentUser.eof then ShowComment = ShowComment & rsComment("UserName") else ShowComment = ShowComment & "" & rsComment("UserName") & "" end if else ShowComment = ShowComment & " " & rsComment("UserName") & "" end if ShowComment = ShowComment & "于" & rsComment("WriteTime") & "发表评论： " ShowComment = ShowComment & "	评分："&rsComment("Score")&"分
" ShowComment = ShowComment & "    " & rsComment("Content") & " " if rsComment("ReplyContent")<>"" then ShowComment = ShowComment & "    ★ 管理员" & rsComment("ReplyName") & "于 " & rsComment("ReplyTime") & " 回复道：     " & rsComment("ReplyContent") & " " end if ShowComment = ShowComment & "
" ShowComment = ShowComment & "查看关于此文章的所有评论" ShowComment = ShowComment & "

" end if end function function formatUrl(url,description) dim format format = "{$description}" formatUrl=replace(replace(format,"{$url}",url),"{$description}",description) end function '================================================= '过程名：ShowChildClass '作 用：显示当前位置 '参 数: ArticleID或ClassID '================================================= function ShowCurrentContext(ID,isClass) dim sql,rs dim ClassID,ClassIDs,ParentID dim strPath,strPathSplit strPathSplit="  >>  " Set rs = Server.CreateObject("ADODB.Recordset") '文章地址 if not isClass then '查出ClassID 'strPath追加文件连接 sql = "SELECT ClassID,Title FROM Article WHERE ArticleID = " & ID rs.open sql,conn,1,1 if not rs.eof then ClassID = cint(rs(0)) strPath = strPathSplit & formatUrl(ArticleFilePath(ID),rs(1)) else ClassID = ID end if rs.close end if '分类列表地址 'select ClassID,ClassName From ArticleClass where ArticleClass.ClassID in (select ParentPath From ArticleClass where ClassID=6) order by Depth sql = "select ParentPath,ParentID,ClassName From ArticleClass where ClassID = " & ClassID rs.open sql,conn,1,1 if not rs.eof then ClassIDs = rs(0) ParentID = rs(1) strPath= strPathSplit & formatUrl(ClassFilePath(ClassID),rs(2)) & strPath end if rs.close if ParentID>0 then sql = "select ClassID,ClassName From ArticleClass where ArticleClass.ClassID in ("& ClassIDs &") order by Depth" rs.open sql,conn,1,1 do while not rs.eof strPath = strPathSplit & formatUrl(ClassFilePath(rs(0)),rs(1)) & strPath rs.movenext loop rs.close end if '站点首页地址 strPath = "  " & formatUrl(SiteIndex,SiteName) & strPath set rs = nothing ShowCurrentContext = strPath end function %>