admin_createcommon.asp

个人网站比较简短

End Sub

Sub CreateSpecial()
    'On Error Resume Next
    If ChannelID <> PrevChannelID Then
        Call GetChannel(ChannelID)
        PrevChannelID = ChannelID
    End If
    If UseCreateHTML = 0 Or UseCreateHTML = 2 Then
        Response.Write "<b>因为此频道设置了“不生成HTML”或“专题页不生成HTML”，所以不用生成专题页。</b><br>"
        Exit Sub
    End If

    tmpDir = HtmlDir & "/Special"
    If CreateMultiFolder(tmpDir) = False Then
        Response.Write "请检查服务器。系统不能创建生成文件所需要的文件夹。"
        Exit Sub
    End If
    
    If IsAutoCreate = False Then
        Response.Write "<b>正在生成专题列表页面……请稍候！<font color='red'>在此过程中请勿刷新此页面！！！</font></b><br>"
        Response.Flush
    End If
    Dim rsCreate, sql
    Dim tmpDir, tmpTemplateID
    PageTitle = ""
    sql = "select * from PE_Special where ChannelID=" & ChannelID
    Select Case CreateType
    Case 1 '选定的专题
		If Action = "CreateOther" Then
			IsAutoCreate = True
		End If
        If IsValidID(SpecialID) = False Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请指定要生成的专题ID</li>"
            Exit Sub
        End If
        If InStr(SpecialID, ",") > 0 Then
            sql = sql & " and SpecialID in (" & SpecialID & ")"
        Else
            sql = sql & "and SpecialID=" & SpecialID
        End If
    Case 2 '所有专题
         
    Case Else
        Response.Write "参数错误！"
        Exit Sub
    End Select
    sql = sql & " order by OrderID"
    Set rsCreate = Server.CreateObject("ADODB.Recordset")
    rsCreate.Open sql, Conn, 1, 1
    If rsCreate.Bof And rsCreate.EOF Then
        TotalCreate = 0
        rsCreate.Close
        Set rsCreate = Nothing
        Exit Sub
    Else
        TotalCreate = rsCreate.RecordCount
    End If


    tmpTemplateID = 0
    strTemplate = GetTemplate(ChannelID, 4, 0)
    Call MoveRecord(rsCreate)
    Call ShowTotalCreate("个专题")

    Do While Not rsCreate.EOF
        If rsCreate("TemplateID") <> tmpTemplateID Then
            strTemplate = GetTemplate(ChannelID, 4, rsCreate("TemplateID"))
            tmpTemplateID = rsCreate("TemplateID")
        End If
        strPageTitle = tmpPageTitle
        strNavPath = tmpNavPath
        CurrentPage = 1
        SpecialID = rsCreate("SpecialID")
        If ChannelID <> PrevChannelID Then
            Call GetChannel(ChannelID)
            PrevChannelID = ChannelID
        End If
        strFileName = ChannelUrl_ASPFile & "/ShowSpecial.asp?ClassID=" & ClassID & "&SpecialID=" & SpecialID
        Call GetSpecial
        MaxPerPage = MaxPerPage_Special
        tmpDir = HtmlDir & "/Special/" & SpecialDir
        If Not fso.FolderExists(Server.MapPath(tmpDir)) Then
            fso.CreateFolder Server.MapPath(tmpDir)
        End If
        
        tmpFileName = tmpDir & "/Index" & FileExt_List
        strHtml = strTemplate
        Call PE_Content.GetHtml_Special
        Call WriteToFile(tmpFileName, strHtml)

        iCount = iCount + 1
        Response.Write "<li>成功生成第 <font color='red'><b>" & iCount & " </b></font>个专题的列表：" & tmpFileName & "</li><br>" & vbCrLf
        Response.Flush
        If UseCreateHTML = 1 And (IsAutoCreate = False Or (IsAutoCreate = True And AutoCreateType = 1)) Then
            If TotalPut Mod MaxPerPage = 0 Then
                Pages = TotalPut \ MaxPerPage
            Else
                Pages = TotalPut \ MaxPerPage + 1
            End If
            If Pages > 1 Then
                For CurrentPage = 2 To Pages

                    tmpFileName = tmpDir & "/List_" & Pages - CurrentPage + 1 & FileExt_List
                    If IsAutoCreate = True And CurrentPage > UpdatePages Then
                        Call Update_ShowPage(tmpFileName, "UpdateSpecial")
                        'If CurrentPage = Pages Then Response.Write "&nbsp;&nbsp;&nbsp;成功更新第 <font color='red'><b>" & iCount & " </b></font>个专题的第 <font color='blue'>" & UpdatePages + 1 & " 至 " & Pages & "</font> 页<br>" & vbCrLf
                    Else
                        strHtml = strTemplate
                        Call PE_Content.GetHtml_Special
                        Call WriteToFile(tmpFileName, strHtml)
                        Response.Write "&nbsp;&nbsp;&nbsp;成功生成第 <font color='red'><b>" & iCount & " </b></font>个专题的第 <font color='blue'>" & CurrentPage & "</font> 页列表：" & tmpFileName & "<br>" & vbCrLf
                        Response.Flush
                    End If
                Next
            End If
        End If
        rsCreate.MoveNext
        If iCount Mod MaxPerPage_Create = 0 Then Exit Do
    Loop
    rsCreate.Close
    Set rsCreate = Nothing
End Sub

Sub CreateSiteIndex()
    Response.Write "<br><iframe id='CreateSiteIndex' width='100%' height='30' frameborder='0' src='Admin_CreateSiteIndex.asp?ShowBack=No'></iframe>"
End Sub

Sub CreateSiteSpecial()
    If Trim(Request("SpecialID")) <> "" Then
        Response.Write "<br><iframe id='CreateSiteSpecial' width='100%' height='30' frameborder='0' src='Admin_CreateSiteSpecial.asp?SpecialID=" & Trim(Request("SpecialID")) & "&ShowBack=No&IsAutoCreate=true'></iframe>"
    End If
End Sub

Sub CreateAllJS()
    Response.Write "<br><iframe id='CreateJS' width='100%' height='100' frameborder='0' src='Admin_CreateJS.asp?ChannelID=" & ChannelID & "&ShowBack=No'></iframe>"
End Sub

Sub Update_ShowPage(FileName, iType)
    Dim hf, strUpdateHtml, strPath, strShowPage, strShowPage_en

    strUpdateHtml = ReadFileContent(FileName)

    Select Case iType
    Case "UpdateClass"
        strPath = ChannelUrl & GetListPath(StructureType, ListFileType, ParentDir, ClassDir)
        If ListFileType > 0 Then
            strShowPage = ShowPage_Html(strPath, ClassID, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
            strShowPage_en = ShowPage_en_Html(strPath, ClassID, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
        Else
            strShowPage = ShowPage_Html(strPath, 0, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
            strShowPage_en = ShowPage_en_Html(strPath, 0, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
        End If
    Case "UpdateSpecial"
        strPath = ChannelUrl & "/Special/" & SpecialDir
        strShowPage = ShowPage_Html(strPath, 0, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
        strShowPage_en = ShowPage_en_Html(strPath, 0, FileExt_List, "", TotalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName)
    Case "UpdateSiteSpecial"
        strPath = InstallDir & "/Special/" & SpecialDir
        strShowPage = ShowPage_Html(strPath, 0, FileExt_SiteSpecial, "", TotalPut, MaxPerPage, CurrentPage, True, True, "个内容")
        strShowPage_en = ShowPage_en_Html(strPath, 0, FileExt_SiteSpecial, "", TotalPut, MaxPerPage, CurrentPage, True, True, "个内容")
    End Select

    regEx.Pattern = "<!--\s分页开始\s-->([\s\S]*?)<!--\s分页结束\s-->"
    Set Matches = regEx.Execute(strUpdateHtml)
    If Matches.Count > 0 Then
        strUpdateHtml = regEx.Replace(strUpdateHtml, strShowPage)
    End If
    regEx.Pattern = "<!--\sShowPage\sBegin\s-->([\s\S]*?)<!--\sShowPage\sEnd\s-->"
    Set Matches = regEx.Execute(strUpdateHtml)
    If Matches.Count > 0 Then
        strUpdateHtml = regEx.Replace(strUpdateHtml, strShowPage_en)
    End If

    Call WriteToFile(FileName, strUpdateHtml)
End Sub

Sub ShowProcess()
	Dim iCreatePage
	If CreateType = 9 Or (CreateType = 8 And CreateItemType = 3)Then
		iCreatePage = CurrentCreatePage
	Else
		iCreatePage = CurrentCreatePage + 1
    End If
	strFileName = "Admin_Create" & ModuleName & ".asp?Action=" & Action & "&CreateType=" & CreateType & "&ChannelID=" & ChannelID & "&ClassID=" & Trim(Request("ClassID")) & "&SpecialID=" & Trim(Request("SpecialID")) & "&CreatePage=" & iCreatePage & strUrlParameter
    strFileName = Replace(strFileName, " ", "")
    If CurrentCreatePage < iTotalPage Then
        If SleepTime > 0 Then
            Response.Write "<p align='center'>" & SleepTime & "秒后将自动继续生成下一页！</p>" & vbCrLf
        End If
        Response.Write "<meta http-equiv=""refresh"" content=" & SleepTime & ";url='" & strFileName & "'>" & vbCrLf
    Else
        Response.Write "<p align='center'>已经生成所有页面！</p>" & vbCrLf
        If Trim(Request("ShowBack")) <> "No" And CreateType <> 7 And CreateType <> 8 Then
            Response.Write "<p align='center'><a href='Admin_CreateHTML.asp?ChannelID=" & ChannelID & "'>【返回】</a></p>" & vbCrLf
        End If
        If IsShowReturn = True Then '兼容采集，生成文章后进行生成栏目和首页
            Response.Write "<meta http-equiv=""refresh"" content=5;url='Admin_CreateArticle.asp?Action=CreateOther&CreateType=1&ChannelID=" & ChannelID & "&ClassID=" & ClassID & "&SpecialID=" & SpecialID & "&CollectionCreateHTML=" & Trim(Request("CollectionCreateHTML")) & "&CreateNum=" & Trim(Request("CreateNum")) & "&ShowBack=No&ChannelProperty=" &  Trim(Request("ChannelProperty")) & "&TimingCreateNum=" & Trim(Request("TimingCreateNum")) & "&TimingCreate=" & Trim(Request("TimingCreate")) & "'>" & vbCrLf
        End If
    End If
End Sub

Sub MoveRecord(rsCreate)
	If (TotalCreate Mod MaxPerPage_Create) = 0 Then
        iTotalPage = TotalCreate \ MaxPerPage_Create
    Else
        iTotalPage = TotalCreate \ MaxPerPage_Create + 1
    End If
    If CurrentCreatePage < 1 Then
        CurrentCreatePage = 1
    End If
	If CreateType = 9 Or (CreateType = 8 And CreateItemType = 3)Then
		Exit Sub
	End If
    If (CurrentCreatePage - 1) * MaxPerPage_Create > TotalCreate Then
        CurrentCreatePage = iTotalPage
    End If
    If CurrentCreatePage > 1 Then
        If (CurrentCreatePage - 1) * MaxPerPage_Create < TotalCreate Then
			rsCreate.Move (CurrentCreatePage - 1) * MaxPerPage_Create
        Else
            CurrentCreatePage = 1
        End If
    End If
    iCount = (CurrentCreatePage - 1) * MaxPerPage_Create
End Sub

Sub ShowTotalCreate(ItemName)
    If IsAutoCreate = False Then
        Response.Write "总共需要生成 <font color='red'><b>" & TotalCreate & "</b></font> " & ItemName
        Response.Write "，每页生成 <font color='red'><b>" & MaxPerPage_Create & "</b></font> " & ItemName
        Response.Write "，共需要分 <font color='red'><b>" & iTotalPage & "</b></font> 页生成"
        Response.Write "，当前正在生成 <font color='red'><b>" & CurrentCreatePage & "</b></font> 页<br>" & vbCrLf
        Response.Flush
    End If
End Sub
%>