📄 movedata.asp
字号:
<% 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 + -