无限分类生成HTML文件

'无限分类生成HTML文件

'接收传递过来的文章路径参数

 set rsHtmlFileCode=server.CreateObject ("ADODB.RecordSet")
 sql4="select * from Article where ID="&CurrentArticleID
 rsHtmlFileCode.Open sql4,conn,1,3
 if rsHtmlFileCode.EOF and rsHtmlFileCode.bof then
  response.Write("alert('没有找到需要生成HTML的文章数据内容');history.go(-1);")
  response.End()
 else
  
  ClassDepth=rs("ClassDepth")
  ClassID=rs("ClassID")
  ParentID=rs("ParentID")
  '获取当前文章路径
  if ClassDepth=0 then
  CurrentClassDir="/"&sClassDir
  else
  sClassDepth=ClassDepth-1
  sParentID=ParentID
  CurrentClassDir=""
  GetCurrentClassDirPath sClassDepth,sParentID,CurrentClassDir   
  end if
  '建立当前文章目录
  CreatHtmlFolder CurrentClassDir
  
 end if
 rsHtmlFileCode.close
 set rsHtmlFileCode=nothing
 
'获取文章对应的静态生成页面文件路径 
Function GetCurrentClassDirPath(CurrentClassDepth,CurrentClassID,CurrentClassDir)

 set rsClsssDirPath=server.CreateObject ("ADODB.RecordSet")
 sqlClsssDirPath="select * from ArticleClass where ParentID="&CurrentClassID
 rsClsssDirPath.Open sqlClsssDirPath,conn,1,3
 if rsClsssDirPath.EOF and rsClsssDirPath.bof then
  response.Write("alert('没有找到需要生成HTML的文章数据内容');history.go(-1);")
  response.End()
 else
  
  sClassDepth=rsClsssDirPath("ClassDepth")-1
  sParentID=rsClsssDirPath("ParentID")
  sClassDir=rsClsssDirPath("ClassDir")
  
  if sClassDepth=0 then
  
   if CurrentClassDir="" then
   '当前文章的类别是顶类下的文章的路径
   StrClassDir="/"&sClassDir
   else
   '多级类别下的文章的路径
   StrClassDir=sClassDir&"/"&CurrentClassDir   
   end if
   Exit Function
  else
  CurrentClassDir=sClassDir&"/"&CurrentClassDir
  GetCurrentClassDirPath sClassDepth,sParentID,CurrentClassDir  
  end if   
 end if
 rsClsssDirPath.close
 set rsClsssDirPath=nothing

end Function

'建立对应的文件夹
Function  CreatHtmlFolder(CurrentFolderName)
  CurrentFolderPath=Server.MapPath(CurrentFolderName)
  Set FolderObject=Server.CreateObject("Scripting.FileSystemObject")
        if not FolderObject.FolderExists(CurrentFolderPath)  then  
    FolderObject.CreateFolder(CurrentFolderPath)
  response.Write(CurrentFolderPath&"文件夹创建完成")
  else
  response.Write(CurrentFolderPath&"文件夹已存在")  
        end  if   
  set FolderObject=nothing
end Function

'建立对应的文件内容
Function  CreatHtmlFile(ClassDirPath,FileName,FileExt,ArticleID,HtmlContentCode)
Set fso = CreateObject("scripting.FileSystemObject")
HtmlFileName=ClassDirPath&"/"&HtmlFileName&"."&HtmlFileExt
HtmlFileNamePath=Server.MapPath(HtmlFileNamePath)
Set ObjHtmlFile=fso.OpenTextFile(HtmlFileNamePath,8,True)

ObjHtmlFile.WriteLine HtmlContentCode

ObjHtmlFile.Close
Set ObjHtmlFile=Nothing
end Function