<% Option Explicit %>
<!--#include file="inc/Cls_DB.asp" -->
<!--#include file="../../Inc/Const.asp" -->
<!--#include file="inc/Function.asp" -->
<!--#include file="inc/PublicFun.asp" -->
<%
Server.ScriptTimeout=30000
'==============================================================================
'软件名称：风讯新闻采集系统V1.0
'最新更新：2004.12
'==============================================================================
'商业注册联系：028-85098980-601,602 技术支持：028-85098980-606、607,客户支持：608
'产品咨询QQ：159410,655071,66252421
'技术支持:所有程序使用问题，请提问到bbs.foosun.net我们将及时回答您
'程序开发：风讯开发组 & 风讯插件开发组
'论坛支持：风讯在线论坛(http://bbs.foosun.net)
'官方网站：www.Foosun.net  演示站点：test.cooin.com    
'网站建设专区：www.cooin.com
'==============================================================================
'免费版本请在新闻首页保留版权信息，并做上本站LOGO友情连接
'==============================================================================
Dim DBC,UpdateConn
Set DBC = New DataBaseClass
DBC.ConnStr = "DBQ=" + server.mappath("FooSunData/Update.mdb") + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set UpdateConn = DBC.OpenConnection()
DBC.ConnStr = "DBQ=" + Server.MapPath(DataBaseConnectStr) + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set Conn = DBC.OpenConnection()
Set DBC = Nothing
'判断权限
%>
<!--#include file="../../Inc/Session.asp" -->
<!--#include file="../../Inc/CheckPopedom.asp" -->
<%
if Not JudgePopedomTF(Session("Name"),"P1406") then Call ReturnError1()
'判断权限结束

Dim MainID,TableNO,DelSource
MainID = Request("MainID")
TableNO = Request("TableNO")
DelSource = Request("DelSource")
if TableNo = "" then
	TableNO = 1
else
	TableNO = CInt(TableNO)
end if
Dim SourceDBType,SServer,SourceDB,SUser,SPassWord,ObjectDBType,OServer,ObjectDB,OUser,OPassWord
Dim SourceConn,SourceConnStr,ObjectConn,ObjectConnStr '数据库连结变量
Dim STable,OTable
Dim TableSOID,SFieldArray,OFieldArray
Dim i  '全局循环变量
Dim MoveDataNum,ErrorMoveDataNum
Dim ResponseInfoStr,OverFlag
Dim ResponseErrorInfo
Dim ObjectFlag '建立对象成功或者失败标志
Dim SourceRS,ObjectRS '数据库记录集变量
Dim RelateInfoArray '要保存值的字段  
Dim ValueOfSaveToFlushStr  
RelateInfoArray = "" 
ValueOfSaveToFlushStr = ""
ResponseInfoStr = "" 
MoveDataNum = 0
ErrorMoveDataNum = 0
ResponseErrorInfo = "" 
ObjectFlag = True
if MainID <> "" then 
	OverFlag = GetDBInfo()
	if OverFlag = False then 
		ResponseInfoStr = "得到数据库转移信息失败" 
		ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false);parent.MoveDataEndFun();</script>" 
		ShowInfo ResponseInfoStr
		Response.End
	end if
	SourceConnStr = GetConnStr(SourceDBType,SServer,SourceDB,SUser,SPassWord)
	ObjectConnStr = GetConnStr(ObjectDBType,OServer,ObjectDB,OUser,OPassWord)
	Set SourceConn = GetConn(SourceConnStr)
	if ObjectFlag = False then
		ResponseInfoStr = "连结源数据库失败"
		ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false);parent.MoveDataEndFun();</script>"
		ShowInfo ResponseInfoStr
		Response.End
	end if
	Set ObjectConn = GetConn(ObjectConnStr)
	if ObjectFlag = False then
		Set SourceConn = Nothing
		ResponseInfoStr = "连结目标数据库失败"
		ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false);parent.MoveDataEndFun();</script>"
		ShowInfo ResponseInfoStr
		Response.End
	end if
	OverFlag = GetTableInfo()
	if OverFlag = True then
		TableNO = TableNO + 1
		GetFieldInfo
		Set SourceRS = GetRS(SourceConn,STable,True)
		if ObjectFlag = False then
			Set SourceConn = Nothing
			ResponseInfoStr = "NO:" & TableNO - 1 & " 打开源数据库记录集失败"
			ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false);parent.MoveDataEndFun();</script>"
			ResponseInfoStr = ResponseInfoStr & "<meta http-equiv=""refresh"" content=""1;url=MoveData.asp?MainID=" & MainID & "&TableNO=" & TableNO & "&DelSource=" & DelSource & """>"
		end if
		if Not (ObjectFlag = False) then 
			Set ObjectRS = GetRS(ObjectConn,OTable,False)
			if ObjectFlag = False then
				Set SourceConn = Nothing
				ResponseInfoStr = "NO:" & TableNO - 1 & " 打开目标数据库记录集失败"
				ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false);parent.MoveDataEndFun();</script>"
				ResponseInfoStr = ResponseInfoStr & "<meta http-equiv=""refresh"" content=""1;url=MoveData.asp?MainID=" & MainID & "&TableNO=" & TableNO & "&DelSource=" & DelSource & """>"
			end if
		end if
		if Not (ObjectFlag = False) then 
			MoveData
			if ResponseErrorInfo <> "" then
				ResponseInfoStr = "NO:" & TableNO - 1 & " 从" & STable & "到" & OTable & "转移失败<br><strong>错误信息</strong>:<font color=""#990000"">" & ResponseErrorInfo & "</font><br><br>"
			else
				ResponseInfoStr = "NO:" & TableNO - 1 & " 成功地从" & STable & "到" & OTable & "转移" & MoveDataNum & "条数据<br><br>"
			end if
			ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',false)</script>"
			ResponseInfoStr = ResponseInfoStr & "<meta http-equiv=""refresh"" content=""1;url=MoveData.asp?MainID=" & MainID & "&TableNO=" & TableNO & "&DelSource=" & DelSource & """>"
		end if
	else
		if (TableNO - 1) = 0 then
			ResponseInfoStr = "<strong>转移结果</strong>：没有要转移的表<br><br>"
		else
			DealRelateInfo
			ResponseInfoStr = "<strong>转移结果</strong>：共转移" & TableNO - 1 & "个表<br><br>"
		end if
		ResponseInfoStr = "<script language=""JavaScript"">parent.AddShowInfo('" & ResponseInfoStr & "',true);parent.MoveDataEndFun();</script>"
	end if
	Set SourceRS = Nothing
	Set ObjectRS = Nothing
	Set SourceConn = Nothing
	Set ObjectConn = Nothing
	Set UpdateConn = Nothing
	Set Conn = Nothing
	ShowInfo ResponseInfoStr
end if

Function DealRelateInfo()
	Dim RSFlushTableObj,DealInfo,DealInfoArray,DealInfoLoopVar,TempDealInfoArray,ExecuteSql
	Set RSFlushTableObj = UpdateConn.Execute("Select * from FlushTable where DBSOID='" & MainID & "'")
	do while Not RSFlushTableObj.Eof
		DealInfo = RSFlushTableObj("OldValue")
		if Not (ISNull(DealInfo) OR DealInfo = "") then
			DealInfoArray = Split(DealInfo,"$$$")
			for DealInfoLoopVar = LBound(DealInfoArray) to UBound(DealInfoArray)
				TempDealInfoArray = Split(DealInfoArray(DealInfoLoopVar),":")
				if InStr(LCase(TempDealInfoArray(4)),"int") <> 0 then
					ExecuteSql = "Update " & TempDealInfoArray(1) & " Set " & TempDealInfoArray(2) & "=" & TempDealInfoArray(3) & " where " & TempDealInfoArray(2) & "=" & TempDealInfoArray(0) & ""
				else
					ExecuteSql = "Update " & TempDealInfoArray(1) & " Set " & TempDealInfoArray(2) & "='" & TempDealInfoArray(3) & "' where " & TempDealInfoArray(2) & "='" & TempDealInfoArray(0) & "'"
				end if
				ObjectConn.Execute(ExecuteSql)
				'Response.Write(ISObject(ObjectConn))
				'Response.End
			Next
		end if
		RSFlushTableObj.MoveNext
	Loop
	Set RSFlushTableObj = Nothing
	UpdateConn.Execute("Delete from FlushTable where DBSOID='" & MainID & "'")
End Function

Function MoveData()
	Dim LoopVar,TempSField,TempOField,SaveToFlushLoopVar
	Dim UserDataFun,TempUserData,ExecuteSql,ObjectFieldType
	On Error Resume Next
	if Not SourceRS.Eof then
		do while Not SourceRS.Eof
			ObjectRS.AddNew
			for LoopVar = LBound(SFieldArray) to UBound(SFieldArray)
				TempSField = SFieldArray(LoopVar)
				TempOField = OFieldArray(LoopVar)
				TempUserData = ""
				ObjectFieldType = GetFieldType(ObjectRS.Fields(TempOField).Type)
				'Response.Write(ObjectRS.Fields(TempOField).Name & "---" & ObjectFieldType & "<br>")
				if Left(TempSField,1) = "!" And Right(TempSField,1) = "!" then
					UserDataFun = Mid(TempSField,2,Len(TempSField)-2)
					if UserDataFun = "GetRandomID18" then
						TempUserData = GetRandomID18
						ObjectRS(TempOField) = TempUserData
					else
						TempUserData = Mid(TempSField,2,Len(TempSField)-2)
						ObjectRS(TempOField) = TempUserData
					end if
				else
					if Not IsNull(SourceRS(TempSField)) then
						if ObjectFieldType = "SmallInt" OR ObjectFieldType = "Integer" OR ObjectFieldType = "UnsignedInt" OR ObjectFieldType = "UnsignedTinyInt" OR ObjectFieldType = "UnsignedSmallInt" then
							TempUserData = CInt(SourceRS(TempSField))
						elseif ObjectFieldType = "BigInt" OR ObjectFieldType = "UnsignedBigInt" then
							TempUserData = CLng(SourceRS(TempSField))
						elseif ObjectFieldType = "Single" then
							TempUserData = CLng(SourceRS(TempSField))
						elseif ObjectFieldType = "Double" then
							TempUserData = CLng(SourceRS(TempSField))
						elseif ObjectFieldType = "Numeric" OR ObjectFieldType = "Numeric" then
							TempUserData = CLng(SourceRS(TempSField))
						elseif ObjectFieldType = "Boolean" then
							TempUserData = CBool(SourceRS(TempSField))
						else
							TempUserData = SourceRS(TempSField)
						end if
					else
						TempUserData = SourceRS(TempSField)
					end if
					ObjectRS(TempOField) = TempUserData
				end if
				for SaveToFlushLoopVar = LBound(RelateInfoArray) to UBound(RelateInfoArray)
					Dim TempSaveToFlushArray,TempSaveToFlushSourceField,TempSaveToFlushObjectField
					Dim RelateInfoSourceTable,RelateInfoSourceField
					Dim RelateInfoObjectTable,RelateInfoObjectField
					TempSaveToFlushArray = Split(RelateInfoArray(SaveToFlushLoopVar),"---")
					TempSaveToFlushSourceField = Split(TempSaveToFlushArray(0),".")
					TempSaveToFlushObjectField = Split(TempSaveToFlushArray(1),".")
					RelateInfoSourceTable = TempSaveToFlushSourceField(0)
					RelateInfoSourceField = TempSaveToFlushSourceField(1)
					RelateInfoObjectTable = TempSaveToFlushObjectField(0)
					RelateInfoObjectField = TempSaveToFlushObjectField(1)
					if LCase(RelateInfoSourceTable) = LCase(STable) And RelateInfoSourceTable = RelateInfoObjectTable then
						if LCase(RelateInfoSourceField) = LCase(TempOField) then
							if ValueOfSaveToFlushStr = "" then
								ValueOfSaveToFlushStr = RelateInfoSourceField & ":" & SourceRS(RelateInfoSourceField) & "," & RelateInfoObjectField & ":" & CStr(TempUserData) & ":" & ObjectFieldType
							else
								ValueOfSaveToFlushStr = ValueOfSaveToFlushStr & "$$$" & RelateInfoSourceField & ":" & SourceRS(RelateInfoSourceField) & "," & RelateInfoObjectField & ":" & CStr(TempUserData) & ":" & ObjectFieldType
							end if
						end if
					elseif LCase(RelateInfoSourceTable) = LCase(STable) And RelateInfoSourceTable <> RelateInfoObjectTable then
						Dim NotSameTableRelateStr
						if LCase(RelateInfoSourceField) = LCase(TempOField) then
							if NotSameTableRelateStr = "" then
								NotSameTableRelateStr = SourceRS(RelateInfoSourceField) & ":" & RelateInfoObjectTable & ":" & RelateInfoObjectField & ":" & TempUserData & ":" & ObjectFieldType
							else
								NotSameTableRelateStr = NotSameTableRelateStr & "$$$" & SourceRS(RelateInfoSourceField) & ":" & RelateInfoObjectTable & ":" & RelateInfoObjectField & ":" & TempUserData & ":" & ObjectFieldType
							end if
						end if
					end if
				Next
			Next
			'Response.End
			SourceRS.MoveNext
			ObjectRS.UpDate
			if Err.Number <> 0 then
				ResponseErrorInfo = Replace(Replace(Err.Description,"'",""),"""","")
				Set SourceRS = Nothing
				Set ObjectRS = Nothing
				Exit Function
			else
				MoveDataNum = MoveDataNum + 1
			end if
		Loop
		if DelSource = "1" then
			SourceConn.Execute("Delete from " & STable & "")
		end if
		if NotSameTableRelateStr <> "" then  '处理不同表之间的关联
			UpdateConn.Execute("Insert into FlushTable(DBSOID,OldValue,NewValue) values('" & MainID & "','" & NotSameTableRelateStr & "','')")
		end if
		if ValueOfSaveToFlushStr <> "" then  '处理相同表之间的关联
			Dim ValueOfSaveToFlushStrArray,FlushArray,FlushSourceArray,FlushObjectArray
			ValueOfSaveToFlushStrArray = Split(ValueOfSaveToFlushStr,"$$$")
			for SaveToFlushLoopVar = LBound(ValueOfSaveToFlushStrArray) to UBound(ValueOfSaveToFlushStrArray)
				FlushArray = Split(ValueOfSaveToFlushStrArray(SaveToFlushLoopVar),",")
				FlushSourceArray = Split(FlushArray(0),":")
				FlushObjectArray = Split(FlushArray(1),":")
				if InStr(LCase(FlushObjectArray(2)),"int") <> 0 then
					ExecuteSql = "Update " & OTable & " Set " & FlushObjectArray(0) & "=" & FlushObjectArray(1) & " where " & FlushObjectArray(0) & "=" & FlushSourceArray(1) & ""
				else
					ExecuteSql = "Update " & OTable & " Set " & FlushObjectArray(0) & "='" & FlushObjectArray(1) & "' where " & FlushObjectArray(0) & "='" & FlushSourceArray(1) & "'"
				end if
				ObjectConn.Execute(ExecuteSql)
			Next
		end if
	end if
End Function

Function GetFieldInfo()
	Dim RsFieldObj,TempSFieldStr,TempOFieldStr
	TempSFieldStr = ""
	TempOFieldStr = ""
	Set RsFieldObj = UpdateConn.Execute("Select * from FieldSO where TableSOID=" & TableSOID & "")
	do while Not RsFieldObj.Eof
		if TempSFieldStr = "" then
			TempSFieldStr = RsFieldObj("SField")
		else
			TempSFieldStr = TempSFieldStr & "$$$" & RsFieldObj("SField")
		end if
		if TempOFieldStr = "" then
			TempOFieldStr = RsFieldObj("OField")
		else
			TempOFieldStr = TempOFieldStr & "$$$" & RsFieldObj("OField")
		end if
		RsFieldObj.MoveNext
	Loop
	Set RsFieldObj = Nothing
	if Not (TempSFieldStr = "" OR TempOFieldStr = "") then
		SFieldArray = Split(TempSFieldStr,"$$$")
		OFieldArray = Split(TempOFieldStr,"$$$")
	else
		SFieldArray = Array()
		OFieldArray = Array()
	end if
	Dim RSRelateInfoObj
	Set RSRelateInfoObj = UpdateConn.Execute("Select * from RelateInfo where DBSOID='" & MainID & "'")
	do while Not RSRelateInfoObj.Eof
		if RelateInfoArray = "" then
			RelateInfoArray = RSRelateInfoObj("SRelate") & "---" & RSRelateInfoObj("ORelate")
		else
			RelateInfoArray = RelateInfoArray & "$$$" & RSRelateInfoObj("SRelate") & "---" & RSRelateInfoObj("ORelate")
		end if
		RSRelateInfoObj.MoveNext
	Loop
	Set RSRelateInfoObj = Nothing
	if RelateInfoArray <> "" then
		RelateInfoArray = Split(RelateInfoArray,"$$$")
	else
		RelateInfoArray = Array()
	end if
End Function

Function GetTableInfo()
	Dim RsTableObj
	Set RsTableObj = Server.CreateObject("ADODB.RecordSet")
	RsTableObj.Open "Select * from TableSO where DBSOID='" & MainID & "'",UpdateConn,1,1
	if Not RsTableObj.Eof then
		RsTableObj.Move TableNo - 1
		if RsTableObj.Eof then
			GetTableInfo = False
			Exit Function
		end if
		STable = RsTableObj("STable")
		OTable = RsTableObj("OTable")
		TableSOID = RsTableObj("ID")
		GetTableInfo = True
	else
		GetTableInfo = False
	end if
	Set RsTableObj = Nothing
End Function

Function GetDBInfo()
	Dim RsUpdateObj
	if MainID = "" then
		GetDBInfo = False
		Exit Function
	end if
	Set RsUpdateObj = UpdateConn.Execute("Select * from DBSO where MainID='" & MainID & "'")
	if Not RsUpdateObj.Eof then
		SourceDBType = RsUpdateObj("SourceDBType")
		SServer = RsUpdateObj("SServer")
		SourceDB = RsUpdateObj("SourceDB")
		SUser = RsUpdateObj("SUser")
		SPassWord = RsUpdateObj("SPassWord")
		ObjectDBType = RsUpdateObj("ObjectDBType")
		OServer = RsUpdateObj("OServer")
		ObjectDB = RsUpdateObj("ObjectDB")
		OUser = RsUpdateObj("OUser")
		OPassWord = RsUpdateObj("OPassWord")
		GetDBInfo = True
	else
		GetDBInfo = False
	end if
	Set RsUpdateObj = Nothing
End Function

Function GetConnStr(DBType,DBServer,DBName,DBUser,DBPassWord)
	if DBType = 1 then
		GetConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;Server=" & DBServer & ";User ID=" & DBUser & ";Password=" & DBPassWord & ";Database=" & DBName & ";"
	else
		if DBName = "1" then
			GetConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBServer & ";Jet OLEDB:Database Password=" & DBPassWord & ";Persist Security Info=False"
		else
			GetConnStr = "DBQ=" + server.mappath(DBServer) + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
		end if
	end if
End Function

Function GetRS(ConnObj,Table,Flag)
	Dim TempRS
	On Error Resume Next
	Set TempRS = Server.CreateObject("ADODB.RecordSet")
	if Flag then
		TempRS.Open "Select * from " & Table,ConnObj,3,3
	else
		TempRS.Open "Select * from " & Table & " where 1=0",ConnObj,3,3
	end if
	Set GetRS = TempRS
	Set TempRS = Nothing
	if Err.Number <> 0 then
		ObjectFlag = False
		Set GetRS = Nothing
	else
		ObjectFlag = True
	end if
End Function

Function GetConn(ConnStr)
	Dim TempConn
	On Error Resume Next
	Set TempConn = Server.CreateObject("ADODB.Connection") 
	TempConn.Open ConnStr 
	Set GetConn = TempConn 
	Set TempConn = Nothing 
	if Err.Number <> 0 then
		ObjectFlag = False
		Set GetConn = Nothing
	else
		ObjectFlag = True
	end if
End Function

Sub ShowInfo(InfoStr)
	Response.Write(InfoStr)
End Sub
%>