<!--#include file="conn/HL_DataConn.asp"-->
<%
'……………………版权信息……………………
'本软件已登记软件著作权，版权归广州恒浪网络科技有限公司所有。所有代码都已经注册登记！
'任何未经许可的修改、复制、提供下载、出售等均属违法侵权行为，请尊重版权，勿以身试法！谢谢！
'请保留此版权信息，请尊重版权，勿以身试法！谢谢！
'网    址：http://www.Howave.Net
'技术论坛：http://BBS.Howave.Net
'联系邮箱：websky888@gmail.com 
'……………………版权信息……………………
%>

<style type="text/css">
body {
	margin-left: 0px;
	margin-top: 0px;
}
.td{font-size:12px

}
</style>
<%
Server.ScriptTimeOut = 9999999
dim Transfer_id
dim  hl_db,hl_connstr,hl_conn
Dim DataType,DataToType,AcData_Path,AcToData_Path,Data_Source,DataTo_Source,Data_Name,DataTo_Name,Data_user,DataTo_user,Data_Pass,DataTo_Pass
Dim ChkConnected,ChkConnectedTo
Dim connstr,conn,totaluser
Dim FromType,ToType,UserTable,UserToTable
Dim connTostr,connTo
Dim FoundErr,ErrMsg
Dim user_dir,user_domainroot
Dim TransType
Dim jumpnum,SusNum
Dim Interface_id,Interface_name
Dim t_username,t_id,ID_Auto
Dim TotalRecordIndex,RecordIndex,RecordNum
          'hl_db ="/manage/Database/Howave4.mdb"
		  'hl_connstr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(hl_db)
		  'Set hl_conn = Server.CreateObject("ADODB.Connection")	
	      'hl_conn.open hl_connstr
	If err then
		err.clear
		Set hl_conn = nothing
		response.write "数据库连接出错，请检查连接字串。"
		response.End
	End If
Transfer_id=replace(request("Transfer_id"),"'","")
Dim jumpuser,ChkJump,ChkUser
set hl_rs=server.CreateObject("Adodb.recordset")
    hl_sql="select * from hl_transfer_set where id="&Transfer_id
    hl_rs.open hl_sql,hl_conn,1,1
FromType=hl_rs("FromType")
ToType=hl_rs("ToType")
Transfer_Table_name=hl_rs("Transfer_Table_name")
DataType=hl_rs("DataType")
DataToType=hl_rs("DataToType")
AcToData_Path=hl_rs("AcToData_Path")
DataTo_Source=hl_rs("DataTo_Source")
DataTo_Name=hl_rs("DataTo_Name")
DataTo_user=hl_rs("DataTo_user")
DataTo_Pass=hl_rs("DataTo_Pass")
AcData_Path=hl_rs("AcData_Path")
Data_Source=hl_rs("Data_Source")
Data_Name=hl_rs("Data_Name")
Data_user=hl_rs("Data_user")
Data_pass=hl_rs("Data_pass")
Interface_id=hl_rs("Interface_id")
Interface_name=hl_rs("Interface_name")
jumpuser=hl_rs("jumpuser")
other_userid=hl_rs("other_userid")
other_username=hl_rs("other_username")
ID_Auto=hl_rs("ID_Auto")
hl_rs.close

set hl_rs=nothing
If FromType="0" And ToType<>"0" Then 
UserTable ="[hl_user]"
UserToTable=Transfer_Table_name
TransType="1"'从恒浪传送数据到其它系统
userid="id"
usertoid=other_userid
ElseIf FromType<>"0" And ToType="0" Then 
UserTable =Transfer_Table_name
UserToTable= "[hl_user]"
userid=other_userid
usertoid="id"
TransType="2"'从其它系统传送数据到恒浪
end if

call go()

Sub go()

call link_database()'调用连接源数据库程序，检测连接是否正确
If ChkConnected=True And totaluser<>0 Then' 如果检测连接正确并且返回用户数不为0则显示以下信息 
%>
<table width="808" border="1"  align="center" cellpadding="2" cellspacing="0" bordercolor="#A0D3FE" bgcolor="#EEF9FD" class="td" style="BORDER-COLLAPSE: collapse">
<TR bgColor="#e9effc">
<TD colspan="2">
<strong>读取源数据库信息</strong>
</td>
</tr>
<tr bgColor="#ffffff">
<td width="20%" colspan="2" height="42"><li><font color='green'>一共从源数据库读取了</font><font color="red"><%=totaluser%></font><font color='green'>个用户</font></li></td>
</tr>
<%
ElseIf ChkConnected=True And totaluser=0 Then ' 如果检测连接正确并且返回用户数为0则显示以下信息%>
<TR bgColor="#e9effc">
<TD colspan="2">
<strong>读取源数据库信息</strong>
</td>
</tr>
<tr bgColor="#ffffff">
<td width="20%" colspan="2" height="42"><li><font color='red'>数据库用户表无用户，不需要转换</font></li></td>
</tr>
<%
Response.End 
Else 
FoundErr=True
End If 
link_databaseTo()'调用目标数据库检测连接程序
If ChkConnected=True And ChkConnectedTo= True  Then '如果源数据库和目标数据库检测正确则
%>
<TR bgColor="#e9effc">
<TD colspan="2">
<strong>读取目的数据库信息</strong>
</td>
</tr>
<tr bgColor="#ffffff">
<td width="20%" colspan="2" height="50"><li><font color='green'>目的数据库检查正常</font></li>
</td>
</tr>
<tr bgColor="#ffffff">
<td width="20%" colspan="2" height="50"><li><font color='green'>数据转换中请稍候,请不要刷新或关闭！</font></li>
</td>
</tr>
<tr><td>

<fieldset><span id="Info_CurrentUpdate"></span>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="0" class="td">
<tr>
  <td colspan="2"><legend>当前进度</legend></td></tr>
  <tr>
    <td colspan="2" align="left"><table width="404" height="20" border="0" cellspacing="1" cellpadding="1" bgcolor="#000000">
      <tr>
        <td bgcolor="#ffffff"><table name="PercentBar" id="PercentBar" width="0" height="18" bgcolor="green" border="0" cellspacing="0" cellpadding="0">
          <tr>
            <td></td>
          </tr>
        </table></td>
      </tr>
    </table></td>
  </tr>
  <tr>
    <td width="305"><span id="Info_CurrentPercent" name="Info_CurrentPercent">0</span>%</td>
    <td width="493"><span id="Info_CurrentRecord" name="Info_CurrentRecord"></span></td>
  </tr>
</table></fieldset>
</td>
</tr>
</table>
<%
Else 
FoundErr=True
errmsg=errmsg&"<br><li><font color='red'>数据库连接出错，无法进行下一步操作，请返回重试</font></li>"
End If
if FoundErr=True then
	show_err(errmsg)
end If
If FoundErr<>True And ChkConnected=True And ChkConnectedTo = True Then
Call Transfer()
%>
<table width="808" border="1"  align="center" cellpadding="2" cellspacing="0" bordercolor="#A0D3FE" bgcolor="#EEF9FD" class="td" style="BORDER-COLLAPSE: collapse">
<TR bgColor="#e9effc" height="20">
<TD>
<strong>转换成功</strong>
</td>
</tr>
<tr bgColor="#ffffff">
<td width="20%" height="42">
<li>共跳过了<font color="red"><%=jumpnum%></font>个用户</li>
<li>转换成功<font color="red"><%=SusNum%></font>个用户</li>
<li><font color="red"><%=totaluser-(SusNum+jumpnum)%></font>个用户没有执行转换</li>
</table>
<table width="808" border="1"  align="center" cellpadding="2" cellspacing="0" bordercolor="#A0D3FE" bgcolor="#E9EFFC" class="td" style="BORDER-COLLAPSE: collapse">
<form action="Admin_Data_Transfer.asp" method="post" name="Admin_Data_Transfer">
<tr><td align="center"><input type="submit" name="submit" value="继续转换" /></td></tr></form></table>
<%
end if
End sub

Sub link_database()'测试源数据库连接程序-----------Begin----------
Dim rschk
On Error Resume Next
 If DataType="0" Then'DataType=0为Access数据库 
		connstr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(AcData_Path)		
  Else
 		connstr = "Provider = Sqloledb; User ID = " & Data_user & "; Password = " & Data_pass & "; Initial Catalog = " & Data_Name & "; Data Source = " & Data_Source & ";"
  End If 
  	Set conn = Server.CreateObject("ADODB.Connection")	
	conn.open connstr
	Conn.CommandTimeOut = 9999
    If Err Then '首先检测对数据库是否能够连接－－－－
	   Err.clear
	   conn.close
	   Set conn=Nothing
	   FoundErr=True
	   errmsg=errmsg&"<br><li><font color='red'>源数据库连接出错，请检查字符串是否正确</font></li>"
	   ChkConnected=False
	 Else '其次检查对用户表是否存在
	  Set rschk=conn.execute("select count("&userid&") from "&UserTable)
	  If Err Then 
      Err.Clear
	  conn.close
	  Set conn=Nothing 
	  FoundErr=True
	  If UserTable<>"" Then errmsg=errmsg& "<br><li>请检查源数据库是否存在用户表<font color='red'>"&UserTable&"</font></li>"
	  ChkConnected=False
	 Else 
	 totaluser=rschk(0)'totaluser为检测用户id返回的数目
	 If totaluser="" Or IsNull (totaluser )  Then  totaluser=0
	 ChkConnected=True 
	 
	  End If 
     End If 
	 
End Sub '-------------源数据库检测连接程序　---------End

Sub link_databaseTo()'目标数据库检测连接程序--------Begin
Dim rschkTo
On Error Resume Next
 If DataToType=0 Then 
		connTostr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(AcToData_Path)		
  Else
 		connTostr = "Provider = Sqloledb; User ID = " & DataTo_user & "; Password = " & DataTo_pass & "; Initial Catalog = " & DataTo_Name & "; Data Source = " & DataTo_Source & ";"
  End If 
	Set connTo = Server.CreateObject("ADODB.Connection")	
	connTo.open connTostr
	ConnTo.CommandTimeOut = 9999
    If Err Then 
	   Err.clear
	   connTo.close
	   Set connTo=Nothing
	   FoundErr=True
	   errmsg=errmsg&"<br><li><font color='red'>目的数据库连接出错，请检查字符串是否正确</font></li>"
	   ChkConnectedTo=False
	 Else 
	  Set rschkTo=connTo.execute("select * from "&UserToTable)
	  If Err Then 
      Err.Clear
	  connTo.close
	  Set connTo=Nothing 
	  FoundErr=True
	  If UserToTable<>"" Then errmsg=errmsg& "<br><li>请检查目的数据库是否存在用户表<font color='red'>"&UserToTable&"</font></li>"
	 ChkConnectedTo=False
	 Else 
	  ChkConnectedTo=True 
	  End If 
     End If  
End Sub '目标数据库检测连接程序--------End------------------

Sub Transfer()
'response.Write jumpUser
'---------------数据库资料传送程序Begin-------------------
Dim jumpuser,ChkJump,ChkUser
	 If jumpUser=0 Then ChkJump=True 'chkJump为需要检测用户，遇到同名则跳过
     If jumpUser=1 Then ChkJump=False 
On Error Resume Next
Server.ScriptTimeOut=999999999
Dim rs,rsTo,sql,sqlTo,rsTemp,rst1,rsTemp2,rsTemp3
    Set rs=conn.Execute("select * from "&UserTable)'查询源数据库表，缓存查询数据
	Set rsTo=CreateObject("adodb.recordset")
	rsTo.open "select * from "&UserToTable ,connTo,1,3'查询目标数据库usertotable所有资料
	inums=0
RecordIndex = 0
RecordNum=totaluser
Do While Not rs.eof

inums=inums+1
 If TransType="1" Then '为从hl传到其它目标系统-------A-----begin
	Set rsT1=CreateObject("adodb.recordset")'rsT1为检测目标数据库
    rst1.Open "Select "&other_userid&" From "&UserToTable&" Where "&other_username&"='" & rs("username") & "'",connTo,1,3'先检测目标数据库是否有跟源数据库相同的字段，如果没有，则不用检测，直接可以在目标数据库新增用户字段，否则需要检测用户，如果设置了跳过检测用户则记录跳过的用户数目，否则用户名为用户名＋随机号
    'response.Write "Select "&other_userid&" From "&UserToTable&" Where "&t_username&"='" & rs("username") & "'"
	'response.Write ""&t_username&""
	If rst1.Eof Then '-------------------------B-----------begin
	    ChkUser=False 
		rsTo.addnew
		SusNum=SusNum+1
		'rsTo("username")=rs("username")
		rsTo(""&other_username&"")=rs("username")
	Else
	    ChkUser=True
	  If ChkJump=True Then '--------------------C---------begin
	     jumpnum=jumpnum+1 
	     'rsTo("username")="!@#$%"
	   Else 
	   	Randomize
		rsTo(""&other_username&"")=rs("username") & CINT(1000*RND)
		'ChkUser=False
	   End If '---------------------------------C---------end
	End If'----------------------------------B------------end
	rst1.Close 
	'rsTo("username")=rs("username")
  If ChkUser=False Then' 如果没有重名，则设置rstemp来保存缓存资料'----------D---begin 
  	
	Set rsTemp=connTo.Execute("select count("&other_userid&") from "&UserToTable)'查询目标数据库表PE
	
	If ID_Auto="1" then
	rsTo(""&other_userid&"")=rsTemp(0)+1'设置目标数据插入字段userid=所查询目标数据库表总数值＋1
	 rsTo("userid")=rsTemp(0)+1
	rsTemp.close
    end if
	set hl_rs=server.CreateObject("Adodb.recordset")
    hl_sql="select * from hl_field_set where Transfer_id="&Transfer_id
	hl_rs.open hl_sql,hl_conn,1,1
	do while not hl_rs.eof 
    if hl_rs("hl_field_name")="other" then
	   rsTo(""&hl_rs("field_name")&"")=hl_rs("other_default")
	end if
	   if hl_rs("hl_field_name")="userpassword" and len(rs(""&hl_rs("hl_field_name")&""))=32 then
	      rsTo(""&hl_rs("field_name")&"")=Mid(rs(""&hl_rs("hl_field_name")&""),9,16)
		 else
rsTo(""&hl_rs("field_name")&"")=rs(""&hl_rs("hl_field_name")&"")
		 end if
	 hl_rs.movenext
	 loop
	
	
  End If '-------------------------------------------D-----------------End
ElseIf TransType="2"  Then 'TransType=2为从其它系统传到恒浪
	Set rsT1=CreateObject("adodb.recordset")
    rst1.Open "Select id From "&UserToTable&" Where username='" & rs(""&other_username&"") & "'",connTo,1,3
    'response.Write "Select userid From "&UserToTable&" Where username='" & rs(""&other_username&"") & "'"
	If rst1.Eof Then
	  
	    ChkUser=False
	    rsTo.addnew
		SusNum=SusNum+1
		rsTo("username")=rs(""&other_username&"")
		'rsTo("user_domain")=rs("username")
	Else
	    ChkUser=True 
	  If ChkJump=True Then 
	    jumpnum=jumpnum+1 
	    else
		Randomize
		rsTo("username")=rs(""&other_username&"") & CINT(10*RND)
		'rsTo("user_domain")=rs("username")& CINT(10*RND)
	   End If 
	End If
	rst1.Close 
	'rsTo("username")=rs("username")
  If ChkUser=False Then 
  	set hl_rs=server.CreateObject("Adodb.recordset")
    hl_sql="select * from hl_field_set where Transfer_id="&Transfer_id
	hl_rs.open hl_sql,hl_conn,1,1
	do while not hl_rs.eof
	   if hl_rs("hl_field_name")="userpassword" and len(rs(""&hl_rs("field_name")&""))=32 then
	      rsTo(""&hl_rs("hl_field_name")&"")=Mid(rs(""&hl_rs("field_name")&""),9,16)
	      
		 else
	      
if hl_rs("hl_field_name")="other" then
response.Write "other<br>"
rsTo(""&hl_rs("hl_field_name")&"")=hl_rs("other_default")
else
rsTo(""&hl_rs("hl_field_name")&"")=rs(""&hl_rs("field_name")&"")
end if
		 end if
		
	 hl_rs.movenext
	 loop
  End If 
End if'----------------------------A----------------------------End
rsTo.update
rs.movenext
RecordIndex = RecordIndex + 1
If (RecordIndex Mod 10) = 0 Then
Call RefreshPercentBar
End If
TotalRecordIndex = TotalRecordIndex + 1
Loop
rs.close
rsTo.close
Set rs=Nothing 
Set rsTo=Nothing
call RefreshPercentBar()
End Sub

sub Show_err(errmsg)
Dim strErr
		strErr=strErr & "  <br><tr align='center' bgColor='#e9effc'><td colspan='2' height='22' class='title'><strong>错误信息</strong></td></tr>" & vbcrlf
		strErr=strErr & "  <tr bgColor='#ffffff'><td colspan='2' height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & errmsg &"</td></tr>" & vbcrlf
		strErr=strErr & "  <tr align='center' bgColor='#ffffff'><td colspan='2'><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></td></tr>" & vbcrlf
		strErr=strErr & "</table>" & vbcrlf
		response.write strErr
	end sub

Sub DelTransferSet()
set hl_rs=server.CreateObject("Adodb.recordset")
    hl_sql="delete * from hl_transfer_set where id="&replace(Trim(request("id")),"'","")
	hl_rs.open hl_sql,hl_conn,1,3
	'hl_rs.close
set hl_rs=nothing
response.Redirect "Admin_Data_Transfer.asp"
End Sub

Sub Echo(sStr)
	Response.Write sStr
End Sub
sub chkErr(err,message)
		if err then
			err.clear
			response.write "<script language=""javascript"">alert('"&message&"');</script>"
			response.end
		end if
end Sub

Sub RefreshPercentBar()
    Response.Write "<script>" & vbCrLf
    Response.Write "Info_CurrentUpdate.innerHTML=""<font color='blue'>正在转移用户数据</font>"";" & vbCrLf
    If RecordNum > 0 Then
        Response.Write "PercentBar.width="
        If Fix((RecordIndex / RecordNum) * 400) = 0 Then
           Response.Write "1;" & vbCrLf
        Else
           Response.Write Fix((RecordIndex / RecordNum) * 400) & ";" & vbCrLf
        End If
        Response.Write "Info_CurrentPercent.innerHTML=""" & FormatNumber(RecordIndex / RecordNum * 100, 2, -1) & """;" & vbCrLf
        Response.Write "Info_CurrentRecord.innerHTML=""" & RecordIndex & "/" & RecordNum & """;" & vbCrLf
    End If
    Response.Write "</script>" & vbCrLf
    Response.Flush
End Sub

%>

