install.asp

个人网站比较简短

    On Error Resume Next
    If fso.FileExists(Server.MapPath("NotInsalled.txt")) Then
        fso.DeleteFile Server.MapPath("NotInsalled.txt")
    End If
End Sub

Sub Stepdel()
    On Error Resume Next
    If fso.FileExists(Server.MapPath("NotInsalled.txt")) Then
        fso.DeleteFile Server.MapPath("NotInsalled.txt")
    End If
    If fso.FileExists(Server.MapPath("install.asp")) Then
        fso.DeleteFile Server.MapPath("install.asp")
    End If
    If Err.Number <> 0 Then
        ErrMsg = ErrMsg & "<br><li>删除此安装文件（Install.asp）失败，错误原因：" & Err.Description & "<br>请手动删除此文件。"
        Err.Clear
        Exit Sub
    Else
        Call WriteSuccessMsg("删除此安装文件（Install.asp）成功！<br><br><a href='Index.asp'>点此开始使用系统</a>", ComeUrl)
    End If
    Response.Cookies(Site_Sn)("AdminName") = ""
    Response.Cookies(Site_Sn)("AdminPassword") = ""
    Response.Cookies(Site_Sn)("RndPassword") = ""
End Sub

Sub SaveConfig()
    Dim sqlConfig, rsConfig
    If action = "Step2" Then
        sqlConfig = "select * from PE_Config"
        Set rsConfig = Server.CreateObject("ADODB.Recordset")
        rsConfig.Open sqlConfig, Conn, 1, 3
        If rsConfig.BOF And rsConfig.EOF Then
            rsConfig.addnew
        End If
        rsConfig("SiteName") = Trim(Request("SiteName"))
        rsConfig("SiteTitle") = Trim(Request("SiteTitle"))
        rsConfig("SiteUrl") = Trim(Request("SiteUrl"))
        rsConfig("InstallDir") = InstallDir
        rsConfig("LogoUrl") = Trim(Request("LogoUrl"))
        rsConfig("BannerUrl") = Trim(Request("BannerUrl"))
        rsConfig("WebmasterName") = Trim(Request("WebmasterName"))
        rsConfig("WebmasterEmail") = Trim(Request("WebmasterEmail"))
        rsConfig("Copyright") = Trim(Request("Copyright"))
        rsConfig("objName_FSO") = Trim(Request("objName_FSO"))
        rsConfig("AdminDir") = Trim(Request("AdminDir"))
        rsConfig("ADDir") = Trim(Request("ADDir"))

        rsConfig.Update
        rsConfig.Close
        Set rsConfig = Nothing
    End If
End Sub

Sub DoImport()
    'On Error Resume Next
    Dim mdbname, tconn, trs, rs, sql
    mdbname = "Database/SiteWeaver.mdb"
    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)
    If Err.Number <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
        Exit Sub
    End If
    '导入方案
    Set rs = tconn.Execute("select * from PE_TemplateProject where TemplateProjectID order by TemplateProjectID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_TemplateProject", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("TemplateProjectID") = rs("TemplateProjectID")
            trs("TemplateProjectName") = rs("TemplateProjectName")
            trs("Intro") = rs("Intro")
            trs("IsDefault") = rs("IsDefault")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    
    
    '导入模板
    Set rs = tconn.Execute(" select * from PE_Template order by TemplateID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Template", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("ChannelID") = rs("ChannelID")
            trs("TemplateName") = rs("TemplateName")
            trs("TemplateType") = rs("TemplateType")
            trs("TemplateContent") = rs("TemplateContent")
            trs("IsDefault") = rs("IsDefault")
            trs("IsDefaultInProject") = rs("IsDefaultInProject")
            trs("ProjectName") = rs("ProjectName")
            trs("Deleted") = rs("Deleted")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing

    '导入自定义标签
    Set rs = tconn.Execute(" select * from PE_Label order by LabelID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Label", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("LabelName") = rs("LabelName")
            trs("LabelClass") = rs("LabelClass")
            trs("LabelType") = rs("LabelType")
            trs("PageNum") = rs("PageNum")
            trs("reFlashTime") = rs("reFlashTime")
            trs("fieldlist") = rs("fieldlist")
            trs("LabelIntro") = rs("LabelIntro")
            trs("Priority") = rs("Priority")
            trs("LabelContent") = rs("LabelContent")
            trs("AreaCollectionID") = rs("AreaCollectionID")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing

    '导入风格
    Set rs = tconn.Execute(" select * from PE_Skin order by SkinID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Skin", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("SkinName") = rs("SkinName")
            trs("Skin_CSS") = rs("Skin_CSS")
            trs("IsDefault") = rs("IsDefault")
            trs("ProjectName") = rs("ProjectName")
            trs("IsDefaultInProject") = rs("IsDefaultInProject")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    '导入国家
    Set rs = tconn.Execute(" select * from PE_Country")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Country", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("Country") = rs("Country")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    '导入省份
    Set rs = tconn.Execute(" select * from PE_Province")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Province", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("Province") = rs("Province")
            trs("Country") = rs("Country")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    '导入城市
    Set rs = tconn.Execute(" select * from PE_City")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_City", Conn, 1, 3
    If trs.BOF And trs.EOF Then
        Do While Not rs.EOF
            trs.addnew
            trs("Area") = rs("Area")
            trs("Country") = rs("Country")
            trs("Province") = rs("Province")
            trs("City") = rs("City")
            trs("Area") = rs("Area")
            trs("Postcode") = rs("Postcode")
            trs("AreaCode") = rs("AreaCode")
            trs.Update
            rs.MoveNext
        Loop
    End If
    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing

    tconn.Close
    Set tconn = Nothing
End Sub

Sub CreatSkinFile()
    If Not fso.FolderExists(Server.MapPath(InstallDir & "Skin")) Then
        fso.CreateFolder (Server.MapPath(InstallDir & "Skin"))
    End If

    Dim rsSkin, sqlSkin, hf
    sqlSkin = "select * from PE_Skin"
    Set rsSkin = Server.CreateObject("adodb.recordset")
    rsSkin.Open sqlSkin, Conn, 1, 1
    Do While Not rsSkin.EOF
        Set hf = fso.CreateTextFile(Server.MapPath(InstallDir & "Skin/Skin" & rsSkin("SkinID") & ".css"), True)
        hf.Write Replace_CaseInsensitive(rsSkin("Skin_CSS"), "Skin/", InstallDir & "Skin/")
        hf.Close
        rsSkin.MoveNext
    Loop
    rsSkin.Close
    sqlSkin = "select * from PE_Skin where IsDefault=" & PE_True & ""
    rsSkin.Open sqlSkin, Conn, 1, 1
    If rsSkin.BOF And rsSkin.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>没有默认风格！</li>"
    Else
        Set hf = fso.CreateTextFile(Server.MapPath(InstallDir & "Skin/DefaultSkin.css"), True)
        hf.Write Replace_CaseInsensitive(rsSkin("Skin_CSS"), "Skin/", InstallDir & "Skin/")
        hf.Close
    End If
    rsSkin.Close
    Set rsSkin = Nothing
End Sub

Function Replace_CaseInsensitive(expression, find, replacewith)
    regEx.Pattern = find
    Replace_CaseInsensitive = regEx.Replace(expression, replacewith)
End Function

Function IsRadioChecked(Compare1, Compare2)
    If Compare1 = Compare2 Then
        IsRadioChecked = " checked"
    Else
        IsRadioChecked = ""
    End If
End Function

Function IsOptionSelected(Compare1, Compare2)
    If Compare1 = Compare2 Then
        IsOptionSelected = " selected"
    Else
        IsOptionSelected = ""
    End If
End Function

Sub ClearSiteCache()
    PE_Cache.DelAllCache
End Sub

%>