⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 movedata.asp

📁 XXX档案美女图片站适合给图片广告的站长下载使用
💻 ASP
📖 第 1 页 / 共 2 页
字号:
<% 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
Dim DBC,UpdateConn
Set DBC = New DataBaseClass
DBC.ConnStr = "DBQ=" + server.mappath("SunData/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
'判断权限
%>


<%
'判断权限结束

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)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -