usersynchro.asp

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

Else
    SourceDbFile = Trim(Request.Form("SourceDbFile"))
End If

RemoteSys = Trim(Request.Form("RemoteSys"))
RemoteDbType = Trim(Request.Form("RemoteDbType"))
If RemoteSys = "PE2005" Then
    RemoteUserTable = "PE_User"
Else
    RemoteUserTable = "Dv_User"
End If
If RemoteDbType = "SQL" Then
    RemoteDbServer = Trim(Request.Form("RemoteDbServer"))
    RemoteDbName = Trim(Request.Form("RemoteDbName"))
    RemoteDbUser = Trim(Request.Form("RemoteDbUser"))
    RemoteDbPass = Trim(Request.Form("RemoteDbPass"))
Else
    RemoteDbFile = Trim(Request.Form("RemoteDbFile"))
End If

Call RefreshHtml("CheckSourceData", "<li>正在连接源数据库...")
Call OpenDatabase("Source")
If DataConnected Then
    Call RefreshHtml("CheckSourceData", "<li>从源数据库共读取到<font color=red>" & TotalNum & "</font>条记录,现在将对这些记录逐一进行转换。")
    Call RefreshHtml("CheckRemoteData", "<li>正在连接目标数据库...")
    Call OpenDatabase("Remote")
    If DataConnected And TotalNum > 0 Then
        Call RefreshHtml("CheckRemoteData", "<li>正在进行转换...如果进度出现暂时停顿，请耐心等候！")
        Call UserTrans
        Call CloseDatabase
    End If
End If

If Not DataConnected Then
    Call RefreshHtml("theResult", "<li><font color=red>由于数据库连接失败，操作无法继续进行，请返回上一步，输入正确的数据库连接信息重试</font>")
    Call RefreshHtml("NavButton", "<input class='button' type='button' name='button' onClick='JavaScript:history.go(-1);' value='上一步'>")
Else
    Call RefreshHtml("theResult", "<li><font color=red>操作已完成，请点击下一步察看操作结果说明</font>")
    Call RefreshHtml("SuccessNum", "<input type='hidden' name='SuccessNum' id='SuccessNum' value='" & SuccessNum & "'>")
    Call RefreshHtml("JumpNum", "<input type='hidden' name='JumpNum' id='JumpNum' value='" & JumpNum & "'>")
    Call RefreshHtml("TotalNum", "<input type='hidden' name='TotalNum' id='TotalNum' value='" & TotalNum & "'>")
    Call RefreshHtml("NavButton", "<input class='button' type='submit' name='submit' value='下一步'>")
End If
End Sub 'DoTrans

Private Sub ShowResult()
TotalNum = Trim(Request.Form("TotalNum"))
SuccessNum = Trim(Request.Form("SuccessNum"))
JumpNum = Trim(Request.Form("JumpNum"))
%>
<table width="98%"  border="0" align="center" cellpadding="2" cellspacing="1" class="border">
  <form name="actionform" id="actionform" action="UserSynchro.asp" method="post">
    <tr>
      <td colspan="2" class="tdbg">&nbsp;</td>
    </tr>
    <tr align="center">
      <th height="22" colspan="2" class="topbg2"><b><font color="#FFFFFF">操作结果说明</font></b></th>
    </tr>
    <tr>
      <td width="27%" rowspan="3" valign="top" class="tdbg"><strong>动易用户数据互转工具</strong>
          <ul>
            <li>收集数据库信息</li>
            <li>进行数据库操作</li>
            <li> <font color="#FF0000">操作结果说明</font></li>
        </ul></td>
      <td width="73%" class="tdbg">成功转换<font color=blue><b><%=SuccessNum%></b></font>条用户记录，<br>
        有<font color=blue><b><%=JumpNum%></b></font>条用户资料由于目标数据库中已经存在同名用户，没有进行转换，<br>
        有<font color=red><b><%=Clng(TotalNum) - (CLng(SuccessNum) + Clng(JumpNum))%></b></font>条用户记录转换失败！<br>
        <br>
        分析说明：<br>
        <%
        If SuccessNum = TotalNum Then
            Response.Write "恭喜您！您的这次数据转换或合并非常成功！所有的记录都已经得到了转换。<br><br>"
        ElseIf CLng(SuccessNum) + CLng(JumpNum) = CLng(TotalNum) Then
            Response.Write "祝贺您，您的用户资料已经成功完成转换或合并，有部分源数据库中的用户名在目标数据库中已经存在，因此没有对其进行转换，这是正常的。<br><br>"
        Else
            Response.Write "非常遗憾，在转换过程中，有" & TotalNum - (SuccessNum + JumpNum) & "个用户的资料没有得到成功转换。这很有可能由以下原因导致：<br>"
            Response.Write "<li>您的某些记录中的无法由本程序自动修复的关键字段（例如用户名、Email地址、密码等）出现空值。这种情况下，该用户资料已经损坏，只能手工修改或删除；<br>"
            Response.Write "<li>您的源数据库或者目标数据库被修改过，与标准数据库有不同字段，导致程序运行错误；<br>"
            Response.Write "<li>其它未知错误，请与本程序作者联系以报告bug，并获得相关技术指导。<br><br>"
        End If
        %>
        </td>
    <tr>
        <td class="tdbg" align=center><b><font color=blue>让梦想插上翅膀，</font>&nbsp;&nbsp;<font color=red>与动易一起飞翔！</font>&nbsp;&nbsp;动易2005新版热卖中……</b></td>
        <tr>
      <td align="center" class="tdbg"><input name="Submit" type="button" class="button" value="退　出" onClick="window.close()"></td>
    </tr>
  </form>
</table>
<%

End Sub 'ShowResult
Private Sub OpenDatabase(DataType)
    On Error Resume Next
    Dim strSql, rsCount
    If DataType = "Source" Then
        If SourceDbType = "AC" Then
            ConnStrS = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(SourceDbFile)
            PES_Now = "Now()"
        Else
            ConnStrS = "Provider = Sqloledb; User ID = " & SourceDbUser & "; Password = " & SourceDbPass & "; Initial Catalog = " & SourceDbName & "; Data Source = " & SourceDbServer & ";"
            PES_Now = "Getdate()"
        End If
        Set ConnSource = Server.CreateObject("Adodb.Connection")
        ConnSource.Open ConnStrS
        ConnSource.CommandTimeOut = 999
        If Err Then
            Err.Clear
            Set conn = Nothing
            Call RefreshHtml("CheckSourceData", "<li><font color=red>源数据库连接出错，请检查您提供的连接信息是否正确</font>")
            DataConnected = False
        Else
            strSql = "Select Count(*) From " & SourceUserTable
            Set rsCount = ConnSource.Execute(strSql)
            If Err Then
                Err.Clear
                Call RefreshHtml("CheckSourceData", "<li><font color=red>您的数据库结构与您所选择的系统版本不符，请确认您源数据程序版本与数据库设置正确")
                DataConnected = False
            Else
                TotalNum = rsCount(0)
                If IsNull(TotalNum) Then TotalNum = 0
                DataConnected = True
            End If
            Set rsCount = Nothing
        End If
    Else
        If RemoteDbType = "AC" Then
            ConnStrR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(RemoteDbFile)
            PER_Now = "Now()"
        Else
            ConnStrR = "Provider = Sqloledb; User ID = " & RemoteDbUser & "; Password = " & RemoteDbPass & "; Initial Catalog = " & RemoteDbName & "; Data Source = " & RemoteDbServer & ";"
            PER_Now = "Getdate()"
        End If
        Set ConnRemote = Server.CreateObject("Adodb.Connection")
        ConnRemote.Open ConnStrR
        ConnRemote.CommandTimeOut = 999
        If Err Then
            Err.Clear
            Set conn = Nothing
            Call RefreshHtml("CheckRemoteData", "<li>目标数据库连接出错，请检查您提供的连接信息是否正确")
            DataConnected = False
        Else
            strSql = "Select * From " & RemoteUserTable
            Set rsCount = ConnRemote.Execute(strSql)
            If Err Then
                Err.Clear
                Call RefreshHtml("CheckRemoteData", "<li>您的数据库结构与您所选择的系统版本不符，请确认您目标数据程序版本与数据库设置正确")
                DataConnected = False
            Else
                DataConnected = True
            End If
            Set rsCount = Nothing
        End If
    End If
End Sub 'OpenDatabase

Private Sub UserTrans()
    '定义动易、动网都要用的字段变量
    Dim UserName, UserPassword, UserQuestion, UserAnswer, UserEmail, UserSex
    Dim UserRegDate, UserLastLoginTime, UserLogins
    '定义数据处理过程中的临时变量
    Dim strSql, RsSource, RsRemote, TempRs, Rs, UserGroupID
    Dim ActionType, NeedTrans, IsAddUser
    ActionType = Trim(Request("ActionType"))
    If IsNumeric(ActionType) Then
        ActionType = CLng(ActionType)
    Else
        ActionType = 0
    End If

    '如果目标数据库是动易，则先生成必要的默认值
    If RemoteSys = "PE2005" Then
        '获取默认用户权限和设置
        Set TempRs = ConnRemote.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=2")
        Dim GroupID, GroupSetting
        GroupID = TempRs(0)
        GroupSetting = Split(TempRs(1), ",")
        '获得用户ID号初始值,判断目标数据库是否存在用户
        Dim MaxUserID, UserExist
        Set TempRs = ConnRemote.Execute("SELECT Max(UserID) FROM PE_User")
        If IsNull(TempRs(0)) Then
            MaxUserID = 0
            UserExist = False
        Else
            MaxUserID = TempRs(0)
            UserExist = True
        End If
        Set TempRs = Nothing
        '生成符合条件的随机验证码
        Dim CheckNum
        Randomize
        CheckNum = CStr(Int(7999 * Rnd + 2000)) & CStr(Int(7999 * Rnd + 2000)) '随机验证码
        '生成客户编号的前8位
        Dim v_ymd, v_hms, v_mmm, ClientNum
        v_ymd = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
    Else
        If RemoteSys = "Dvbbs70" Then
            Set Rs = ConnRemote.Execute("select UserGroupID,IsSetting,ParentGID from Dv_UserGroups where not MinArticle=-1 order by MinArticle")
            If Rs(1) = 1 Then
                UserGroupID = Rs(0)
            Else
                If Rs(2) = 0 Then
                    UserGroupID = Rs(0)
                Else
                    UserGroupID = Rs(2)
                End If
            End If
        Else
            Set Rs = ConnRemote.Execute("Select UserGroupID From Dv_UserGroups Where ParentGID=3 Order By MinArticle")
            UserGroupID = Rs("UserGroupID")
        End If
    End If  '完毕
    'On Error Resume Next
    '读取源数据库中的所有用户记录
    strSql = "SELECT * From " & SourceUserTable
    Set RsSource = ConnSource.Execute(strSql)
    If RsSource.EOF And RsSource.Bof Then
        Call RefreshHtml("RateOfProgress", "<li>源数据库中没有用户资料，无需进行同步")
    Else
        Do While Not RsSource.EOF
            UserName = RsSource("UserName")
            UserPassword = RsSource("UserPassword")
            '针对不同系统处理读取的字段
            If SourceSys = "PE2005" Then
                UserQuestion = CheckStr(RsSource("Question"))
                UserAnswer = CheckStr(RsSource("Answer"))
                UserSex = CheckInt(RsSource("Sex"))
                UserRegDate = CheckDateTime(RsSource("RegTime"))
                UserLastLoginTime = CheckDateTime(RsSource("LastLoginTime"))
                UserLogins = CheckInt(RsSource("LoginTimes"))
                UserEmail = CheckStr(RsSource("Email"))
            Else
                UserQuestion = CheckStr(RsSource("UserQuesion"))