update_2005.asp

《动易网站管理系统》2005 SP2正式版中

            <td align="center">
              <input type='hidden' name='db_access' value='<%=db_access%>'>
              <input type='hidden' name='db_sql' value='<%=db_sql%>'>
              <input type='hidden' name='db_type' value='<%=db_type%>'>
              <input type='hidden' name='Action' value='Update'>
              <input type="submit" name="StartUpdate" id="StartUpdate" value="开始升级">
            </td>
          </tr>
        </table>
      </td>
    </tr>
  </table>
</form>
<%
End Sub

Sub Show_UserLevel()
    Dim strUserLevel, sqlLevel, rsLevel
    sqlLevel = "select * from PE_UserLevel order by UserLevel asc"
    Set rsLevel = Server.CreateObject("adodb.recordset")
    rsLevel.open sqlLevel, conn_old, 1, 1
    Do While Not rsLevel.EOF
        Response.Write "<option value='" & rsLevel("UserLevel") & "'>" & rsLevel("LevelName") & "</option>"
        rsLevel.movenext
    Loop
    rsLevel.Close
    Set rsLevel = Nothing
    Response.Write "<option value='3000'>等待邮件验证的用户</option>"
    Response.Write "<option value='2000'>等待管理员认证的用户</option>"
End Sub
Sub Show_UserGroup()
    Dim strUserGroup, sqlGroup, rsGroup
    sqlGroup = "select * from PE_UserGroup order by GroupType asc,GroupID asc"
    Set rsGroup = Server.CreateObject("adodb.recordset")
    rsGroup.open sqlGroup, conn, 1, 1
    Do While Not rsGroup.EOF
        Response.Write "<option value='" & rsGroup("GroupID") & "'>" & rsGroup("GroupName") & "</option>"
        rsGroup.movenext
    Loop
    rsGroup.Close
    Set rsGroup = Nothing
End Sub

Sub Show_Import()
    Dim rsLevel, i, UserLevel_Num
    Set rsLevel = conn_old.execute("select Count(*) from PE_UserLevel")
    If IsNull(rsLevel(0)) Then
        UserLevel_Num = 0
    Else
        UserLevel_Num = rsLevel(0)
    End If
    rsLevel.Close
    Set rsLevel = Nothing
    For i = 1 To UserLevel_Num + 2
        Response.Write "<input type=""text"" name=""LevelName"" width=""60"" readonly><input type=""hidden"" name=""UserLevel"">"
        Response.Write " → "
        Response.Write "<input type=""text"" name=""GroupName"" width=""60"" readonly><input type=""hidden"" name=""GroupID"">"
    Next
End Sub

Function chkdatabase()
    On Error Resume Next
    db_type = Trim(request("db_type"))
    If db_type = "ACCESS" Then
        db_access = Trim(request("db_access"))
        If db_access = "" Then
            Response.Write "请输入动易4.03 Access版的数据库文件名！"
            chkdatabase = False
            Exit Function
        End If
        Set conn_old = Server.CreateObject("ADODB.Connection")
        conn_old.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("" & db_access & "")
        If Err.Number <> 0 Then
            Response.Write "数据库连接错误，请确认输入的动易4.03 Access版的数据库文件名是否正确，且已经复制（或上传）到动易2005版所在目录。"
            chkdatabase = False
            Exit Function
        End If
        chkdatabase = True
    ElseIf db_type = "SQL" Then
        db_sql = Trim(request("db_sql"))
        If db_sql = "" Then
            Response.Write "请输入动易4.03 SQL版的数据库连接字符串！"
            chkdatabase = False
            Exit Function
        End If
        Set conn_old = Server.CreateObject("ADODB.Connection")
        conn_old.open db_sql
        If Err.Number <> 0 Then
            Response.Write "数据库连接错误，请确认输入的动易4.03 SQL版的数据库连接字符串是否正确，特别是数据库服务器的IP地址。"
            chkdatabase = False
            Exit Function
        End If
        chkdatabase = True
    End If
End Function

Sub Update()
    BeginTime = Timer
    If chkdatabase() = False Then Exit Sub
    
    UpdateTable = Trim(request("UpdateTable"))
    If InStr(UpdateTable, "PE_User") > 0 Then
        UpdateTable = UpdateTable & ",PE_UserLevel"
        Dim UserLevel, GroupID
        UserLevel = Trim(request("UserLevel"))
        GroupID = Trim(request("GroupID"))
        arrUserLevel = Split(UserLevel, ",")
        arrGroupID = Split(GroupID, ",")
        If UBound(arrUserLevel) <> UBound(arrGroupID) Then
            Response.Write "用户组升级配置错误，请检查后重新升级"
            Response.End
        End If
    End If

    Call InitPercentBar
    
    If InStr(UpdateTable, "PE_Admin") > 0 Then
        Call Update_PE_Admin
    End If
    If InStr(UpdateTable, "PE_Config") > 0 Then
        Call Update_PE_Config
    End If
    If InStr(UpdateTable, "PE_Skin") > 0 Then
        Call Update_PE_Skin
    End If
    If InStr(UpdateTable, "PE_Template") > 0 Then
        Call Update_PE_Template
    End If
    If InStr(UpdateTable, "PE_Channel") > 0 Then
        Call Update_PE_Channel
    End If
    If InStr(UpdateTable, "PE_Class") > 0 Then
        Call Update_PE_Class
    End If
    If InStr(UpdateTable, "PE_Article") > 0 Then
        Call Update_PE_Article
    End If
    If InStr(UpdateTable, "PE_Soft") > 0 Then
        Call Update_PE_Soft
    End If
    If InStr(UpdateTable, "PE_Photo") > 0 Then
        Call Update_PE_Photo
    End If
    If InStr(UpdateTable, "PE_Special") > 0 Then
        Call Update_PE_Special
    End If
    If InStr(UpdateTable, "PE_JsFile") > 0 Then
        Call Update_PE_JsFile
    End If
    If InStr(UpdateTable, "PE_Comment") > 0 Then
        Call Update_PE_Comment
    End If
    
    If InStr(UpdateTable, "PE_Guest") > 0 Then
        Call Update_PE_Guest
    End If
    If InStr(UpdateTable, "PE_Announce") > 0 Then
        Call Update_PE_Announce
    End If
    If InStr(UpdateTable, "PE_Vote") > 0 Then
        Call Update_PE_Vote
    End If
    If InStr(UpdateTable, "PE_FriendSite") > 0 Then
        Call Update_PE_FriendSite
    End If
    If InStr(UpdateTable, "PE_UserLevel") > 0 Then
        Call Update_PE_UserLevel
    End If
    If InStr(UpdateTable, "PE_Message") > 0 Then
        Call Update_PE_Message
    End If
    If InStr(UpdateTable, "PE_User") > 0 Then
        Call Update_PE_User
    End If
    Call DelAllCache

    Response.Write "<script>" & vbCrLf
    Response.Write "Info_CurrentUpdate.innerHTML=""<font color='blue'>数据库升级成功！</font>"";" & vbCrLf
    Response.Write "</script>" & vbCrLf

    conn_old.Close
    Set conn_old = Nothing
    EndTime = Timer
    Call Success

End Sub

Sub Success()
    Response.Write "<br><br>恭喜您，从动易4.03版的数据库升级到动易2005版成功！！！<br>"
    Response.Write "共耗时：" & FormatNumber((EndTime - BeginTime) * 1000, 2) & "毫秒。<br>"
    Response.Write "<font color=red>若您是直接在服务器进行升级，则请立即删除此文件！以免带来安全隐患。</font><br><br>"
    Response.Write "您还需要继续完成以下工作：<br>"
    Response.Write "&nbsp;&nbsp;&nbsp;①将4.03版中各频道的上传文件复制到2005版的相关频道中。注意，2005版已经将原4.03的图片频道的UploadThumbs和UploadPhotos两个目录合并为一个UploadPhotos目录，复制文件时请注意。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;②去后台——系统设置——网站信息配置，检查各项网站配置情况。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;③后台——系统设置——网站风格管理，将其中一个风格设为默认风格。即使不想改变默认风格，也需要做此步。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;④后台——各个频道——栏目管理，刷新栏目JS——专题管理，刷新专题JS——JS文件管理，刷新所有JS文件。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;⑤后台——系统设置——频道管理，检查各频道的参数设置情况。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;⑥后台——各个频道——栏目管理，检查各个栏目的参数设置情况。特别是浏览/查看权限。因为2005版在前台的权限管理上与4.03版有很大不同，所以如果你的网站做了权限设置的话，请一定要认真检查此项。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;⑦后台——用户管理——会员组管理，检查会员组的各项参数设置情况。特别是在各个频道和栏目的权限。4.03版的会员组权限是上下级关系，会员组在各个栏目的权限是直接保存在栏目表，而2005版的会员组是平级关系，各会员组在栏目中的权限是互相独立的。所以一定要认真检查此项。<br>" & vbCrLf
    Response.Write "&nbsp;&nbsp;&nbsp;⑧如果网站启用了生成HTML功能的，请重新生成所有页面。<br>" & vbCrLf
    Response.Write "<p align='center'><input type='button' name='close' value=' 关闭此窗口 ' onclick='javascript:onclick=window.close()'></p>"
End Sub

Sub Update_PE_Admin()
    Info_CurrentUpdate = "正在升级网站管理员..."
    TableName = "PE_Admin"
    RecordNum = GetRecordNum(TableName)
    RecordIndex = 0
    Dim rsAdmin2, rsAdmin
    Set rsAdmin2 = Server.CreateObject("ADODB.Recordset")
    Set rsAdmin = Server.CreateObject("ADODB.Recordset")
    rsAdmin2.open "select * from PE_Admin Order by ID Asc", conn_old, 1, 1
    Do While Not rsAdmin2.EOF
        rsAdmin.open "select * from PE_Admin where AdminName='" & rsAdmin2("username") & "'", conn, 1, 3
        If rsAdmin.bof And rsAdmin.EOF Then
            rsAdmin.addnew
            rsAdmin("AdminName") = rsAdmin2("username") & ""
            rsAdmin("UserName") = rsAdmin2("username") & ""
        End If
        rsAdmin("Password") = rsAdmin2("password") & ""
        rsAdmin("Purview") = rsAdmin2("purview")
        rsAdmin("LastLoginIP") = rsAdmin2("LastLoginIP") & ""
        rsAdmin("LastLoginTime") = rsAdmin2("LastLoginTime")
        rsAdmin("LastLogoutTime") = rsAdmin2("LastLogoutTime")
        rsAdmin("LoginTimes") = rsAdmin2("LoginTimes")
        rsAdmin("RndPassword") = rsAdmin2("RndPassword") & ""
        rsAdmin("EnableMultiLogin") = PE_CBool(rsAdmin2("EnableMultiLogin"))
        rsAdmin("AdminPurview_Article") = rsAdmin2("AdminPurview_Article")
        rsAdmin("AdminPurview_Soft") = rsAdmin2("AdminPurview_Soft")
        rsAdmin("AdminPurview_Photo") = rsAdmin2("AdminPurview_Photo")
        If rsAdmin2("purview") = 2 Then
            rsAdmin("AdminPurview_Shop") = 4
        End If
        rsAdmin("AdminPurview_Others") = rsAdmin2("AdminPurview_Others") & ""
        rsAdmin("arrClass_View") = GetClassPurview("View", rsAdmin2("username"))
        rsAdmin("arrClass_Input") = GetClassPurview("Input", rsAdmin2("username"))
        rsAdmin("arrClass_Check") = GetClassPurview("Check", rsAdmin2("username"))
        rsAdmin("arrClass_Manage") = GetClassPurview("Manage", rsAdmin2("username"))
        rsAdmin.Update
        rsAdmin.Close
        rsAdmin2.movenext
        RecordIndex = RecordIndex + 1
        If (RecordIndex Mod 10) = 0 Then
            Call RefreshPercentBar
        End If
        TotalRecordIndex = TotalRecordIndex + 1
    Loop
    rsAdmin2.Close
    Set rsAdmin2 = Nothing
    Set rsAdmin = Nothing
    Call RefreshPercentBar
End Sub

Sub Update_PE_Config()
    Info_CurrentUpdate = "正在升级网站配置数据..."
    TableName = "PE_Config"
    RecordNum = GetRecordNum(TableName)
    RecordIndex = 0
    Dim rsConfig2, rsConfig
    Set rsConfig2 = Server.CreateObject("ADODB.Recordset")
    Set rsConfig = Server.CreateObject("ADODB.Recordset")
    rsConfig2.open "select * from PE_Config", conn_old, 1, 1
    rsConfig.open "select * from PE_Config", conn, 1, 3
    If Not (rsConfig2.bof And rsConfig2.EOF) Then
        If rsConfig.bof And rsConfig.EOF Then
            rsConfig.addnew
        End If
        rsConfig("SiteName") = rsConfig2("SiteName")
        rsConfig("SiteTitle") = rsConfig2("SiteTitle")
        rsConfig("SiteUrl") = rsConfig2("SiteUrl")
        rsConfig("InstallDir") = rsConfig2("InstallDir")
        rsConfig("LogoUrl") = rsConfig2("LogoUrl")
        rsConfig("BannerUrl") = rsConfig2("BannerUrl")
        rsConfig("WebmasterName") = rsConfig2("WebmasterName")
        rsConfig("WebmasterEmail") = rsConfig2("WebmasterEmail")
        rsConfig("Copyright") = rsConfig2("Copyright")
        rsConfig("ShowSiteChannel") = PE_CBool(rsConfig2("ShowSiteChannel"))
        rsConfig("ShowAdminLogin") = PE_CBool(rsConfig2("ShowAdminLogin"))
        rsConfig("EnableSaveRemote") = PE_CBool(rsConfig2("EnableSaveRemote"))
        rsConfig("EnableLinkReg") = PE_CBool(rsConfig2("EnableLinkReg"))
        rsConfig("SessionTimeout") = rsConfig2("SessionTimeout")
        rsConfig("objName_FSO") = rsConfig2("objName_FSO")