某事业单位很早以前开发了一套基于Oracle7.03数据库的管理系统，工作在WINDOWS 下，采用C/S工作模式，数据库的字符集为WE8ISO8859P1。由于工作需要，需开发一套在此基础上的查询系统。为保证原系统的安全和完整性，要求查询系统不得直接使用原数据库，影响目前系统的运行。只能通过中间件技术实现查询系统对原数据库的访问，同时由于原系统在使用过程中发现数据存取的速度很慢，要求查询系统使用SQL SERVER 2000数据库进行查询。
二、解决方案分析
根据用户的需求和原系统的工作模式，可采用的方案主要有以下三种：
1、 利用SQL SERVER 的作业调度功能，定时执行数据迁移，实现数据同步。
DTS（数据转换服务）是微软从SQL SERVER 7.0 开始引入的。DTS的主要目的是在系统之间迁移数据和数据库对象。DTS原来是用作SQL SERVER OLAP服务的ETL工具。后来微软意识到DTS 不仅可以作为OLAP 服务的数据抽取和载入工具，还可以实现异种数据库间的迁移，因此扩充了DTS的功能。在SQL SERVER 2000中提供了简单易用的DTS 设计器。利用DTS设计器可以很方便地解决本文涉及的问题。但是，如果要迁移的对象比较多，利用DTS设计器的工作量就相当大了。因此，提出了第二种解决方案。
2、 利用DTS 编程实现数据的定时迁移。
该方法原理简单，但需要对 DTS 有一定的了解，性能也比较好。熟悉VB、VC、DELPHI等任一种编程语言，均可以利用SQL Server 提供的 DTS COM接口实现数据的迁移。
DTS 迁移规范保存在一个称为包的实体中，DTS包是基本的DTS组件的容器，这些组件包括连接、任务、转换、工作流，不同的组件完成不同的功能，它们共同构成数据迁移的实现主体。要通过DTS编程实现数据库的迁移，至少需要两个连接对象。其中，一个提供数据，一个接收数据；至少需要一个转换对象，完成数据从源到目的服务器的转换；至少需要两个任务对象，完成迁移之前的目的服务器上的数据表的删除和重建；至少需要三个工作流对象，为迁移工作设计执行的步骤。
为了实现定时执行，程序还要完成对SQL SERVER AGENT 进行编程实现迁移作业的提交和调度。由于SQL SERVER 的作业调度是通过 SQL SERVER AGENT 来管理的，因此需要在启动SQL SERVER 时同时启动SQL SERVER AGENT。
3、 采用中间件技术
前面两种方案都是利用DTS，离不开SQL Server 的DTS。利用中间件技术，可以通过实现一服务程序，定时将数据从ORACLE服务器取出然后转换成SQL SERVER 数据库的数据格式，传入SQL SERVER。其工作原理如下图：
 |
该技术可以通过通过ODBC 或OLE DB技术编程实现数据的定时获取和转换传出。对于编程的工作量较大，原因在于ORACLE 和SQL SERVER的数据类型的不一致必须通过类型转换实现数据的一致。同时效率也比较低。由于作为一种服务程序长驻内存，对程序的质量要求至少不得出现内存泄露，否则，可能使服务器瘫痪。不过这种方案的好处在于可以脱离SQL SERVER ，维护的工作量相对要轻一些。
比较上述的三种方案，从实现的难度上比较，第一种最低，最后一种最高。从效率上比较，最后一种最低，第一种与第二种最高。从可维护性来比较，第一种最低，最后一种最高。
综合三种方案，笔者认为第二中方案较好。发布到目标系统上，只需在现场运行一次数据迁移的任务安装程序，就能实现SQL Server 定时从Oracle服务器迁移数据。同时，所有的工作量也只是选择要迁移的数据表。该工作，如果要迁移的表是已知的，甚至可以从文件中直接读入，就能实现任务的安装。
下面介绍采用第二种方案用VB编写在SQL SERVER上能定时自动进行数据迁移任务的安装程序的方法。
三、数据迁移的实现
为了能在目标机上顺利实现数据迁移，将DTS包存储到SQL SERVER，在SQL SEVRE AGENT 的作业调度中采用DTSRUN 来加载和执行DTS包。这样，所有的工作只需作一次，就可将整个数据迁移的DTS包和SQL SERVER的作业发布到目标机上。
（一）算法设计
（二）关键技术说明
要实现数据的迁移，必须考虑两个问题，第一、数据的迁移要求目标系统上的数据与ORACLE 数据库中的数据要一致，因此，目标数据库中的相应表必须在迁移之前被删除。所以迁移任务的第一个是对相应表执行删除的SQL 任务；第二、由于目标表被删除，迁移的数据失去寄托，因此迁移任务的第二步必须在目标系统上重建相应的表。在建表时，由于ORACLE 数据库的数据类型与SQL SERVER 不一致，因此必须进行类型转换。它们之间的对应关系和转换要求如下表：
Oracle Microsoft SQL Server
CHAR
建议使用CHAR 类型。这种类型的数据由于采用固定长度存储，其存取速度在某些情况下要比使用 VARCHAR 类型快。
VARCHAR2 和 LONG
VARCHAR 或 TEXT。 (如果在ORACLE 中的长度超过8000字节应在SQL SERVER 中使用 TEXT 类型，否则使用 VARCHAR 数据类型。)
RAW 和 LONG RAW
VARBINARY 或 IMAGE. (如果在ORACLE 中的长度超过8000字节应在SQL SERVER 中使用 IMAGE 类型，否则使用 VARBINARY 数据类型。)
NUMBER
如果整型在0 至255 之间，用TINYINT。
如果整型在-32768 至32767之间，用 SMALLINT。
如果整型在-2,147,483,648 至2,147,483,647 之间，用 INT。
如果需要浮点数，使用 NUMERIC (ORACLE 数据列中有PRECISION 和 SCALE值).
注意：
1、尽量不要使用 FLOAT 或 REAL ，这是因为在转换时数据有四舍五入。
2、如果自己的把握性不大，最好使用 NUMERIC，该类型与ORACLE的NUMBER 类型最接近。
DATE 和 DATETIME
（三）程序设计
1、 界面设计
2、 编码
(1) 在整个程序运行过程中，需要两个全局变量：DTS 包 oPackage 和Oracle 服务器连接 oraCon。
当设置好连接参数后，单击“连接Oracle服务器”，将与 ORACLE 服务器连接，并取出所有表。然后填充第一个列表框，并在下面表格中显示相应的数据（如果选中了“显示数据”）
Private Sub Command1_Click()
Dim rst As New ADODB.Recordset
With oraCon
.Provider = "OraOLEDB.Oracle.1"
.Properties("User ID") = Text2(0).Text
.Properties("Password") = Text3(0).Text
.Properties("Data Source") = Text1(0).Text
.Properties("Persist Security Info") = True
.Open
End With
With rst
.Source = "select * from all_tables where tablespace_name<>''SYSTEM'' order by owner,table_name"
.ActiveConnection = oraCon
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
End With
RefreshGrid rst
FillTabList rst
rst.Close
Command1.Enabled = False
End Sub
(2) 在第一个列表框中双击数据表列表，将选中的表加入第二个列表，如果“显示数据”被选中，将显示相应表的数据。同时显示表的结构信息。在第二个列表框中双击数据表将选中项移出该列表框。
Private Sub List1_DblClick()
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim tmpStr As String
List2.AddItem (List1.List(List1.ListIndex))
If Check1.Value = 1 Then
With rst
.Source = "select * from " & List1.List(List1.ListIndex)
.ActiveConnection = oraCon
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
End With
RefreshGrid rst
rst.Close
End If
tmpStr = List1.List(List1.ListIndex)
strSQL = "SELECT COLUMN_ID, COLUMN_NAME, DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE "
strSQL = strSQL & "FROM SYS.ALL_TAB_COLUMNS WHERE TABLE_NAME="
strSQL = strSQL & "''" & Mid(tmpStr, InStr(1, tmpStr, ".", vbTextCompare) + 1) & "''"
strSQL = strSQL & " and OWNER=''" & Mid(tmpStr, 1, InStr(1, tmpStr, ".", vbTextCompare) - 1) & "''"
With rst
.Source = strSQL
.ActiveConnection = oraCon
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
End With
rst.MoveFirst
RefreshPropGrid rst
rst.Close
PropGrid.Visible = True
SQLScriptList.Visible = False
End Sub
Private Sub RefreshGrid(rst As ADODB.Recordset)
Dim fld As ADODB.Field
On Error Resume Next
FlxGrid1.Clear
rst.MoveFirst
If rst.EOF Then
Exit Sub
End If
With FlxGrid1
.Redraw = False
.Clear
.FixedCols = 0
.FixedRows = 0
.Cols = rst.Fields.Count
rst.MoveLast
.Rows = rst.RecordCount + 1
.Row = 0
.Col = 0
For Each fld In rst.Fields
.Text = fld.Name
.ColAlignment(.Col) = 1
.ColWidth(.Col) = Me.TextWidth(fld.Name & "AA")
If .Col < rst.Fields.Count - 1 Then
.Col = .Col + 1
End If
Next
rst.MoveFirst
Do Until rst.EOF
.Row = .Row + 1
.Col = 0
For Each fld In rst.Fields
If Not (IsNull(fld.Value)) Then
.Text = fld.Value
If .ColWidth(.Col) < Me.TextWidth(fld.Value & "AA") Then
.ColWidth(.Col) = Me.TextWidth(fld.Value & "AA")
End If
End If
If .Col < rst.Fields.Count - 1 Then
.Col = .Col + 1
End If
Next
rst.MoveNext
Loop
.FixedRows = 1
.Redraw = True
End With
End Sub
Private Sub FillTabList(rst As ADODB.Recordset)
rst.MoveFirst
Do Until rst.EOF
List1.AddItem (Trim(rst.Fields("Owner").Value) & "." & Trim(rst.Fields("Table_Name").Value))
rst.MoveNext
Loop
End Sub
Private Sub RefreshPropGrid(rst As ADODB.Recordset)
Dim fld As ADODB.Field
On Error Resume Next
PropGrid.Clear
If rst.EOF Then
Exit Sub
End If
With PropGrid
.Redraw = False
.Clear
.FixedCols = 0
.FixedRows = 0
.Cols = rst.Fields.Count
rst.MoveLast
.Rows = rst.RecordCount + 1
.Row = 0
.Col = 0
For Each fld In rst.Fields
.Text = fld.Name
.ColAlignment(.Col) = 1
.ColWidth(.Col) = Me.TextWidth(fld.Name & "AA")
If .Col < rst.Fields.Count - 1 Then
.Col = .Col + 1
End If
Next
rst.MoveFirst
Do Until rst.EOF
.Row = .Row + 1
.Col = 0
For Each fld In rst.Fields
If Not (IsNull(fld.Value)) Then
.Text = fld.Value
If .ColWidth(.Col) < Me.TextWidth(fld.Value & "AA") Then
.ColWidth(.Col) = Me.TextWidth(fld.Value & "AA")
End If
End If
If .Col < rst.Fields.Count - 1 Then
.Col = .Col + 1
End If
Next
rst.MoveNext
Loop
.FixedRows = 1
.Redraw = True
End With
End Sub
（3）选择完要迁移的数据表后，执行“生成中间件”，将在SQL SERVER 服务器中生成能复制数据的DTS 包。并设置相应的执行顺序。关键代码如下：
Private Sub GenDTSPackage()
Set oPackage = oPackageOld
oPackage.Name = "OraToSql"
oPackage.Description = "Oracle 数据库转换为 SQL Server 数据库 "
oPackage.WriteCompletionStatusToNTEventLog = False
oPackage.FailOnError = False
oPackage.PackagePriorityClass = 2
oPackage.MaxConcurrentSteps = 4
oPackage.LineageOptions = 0
oPackage.UseTransaction = True
oPackage.TransactionIsolationLevel = 4096
oPackage.AutoCommitTransaction = True
oPackage.RepositoryMetadataOptions = 0
oPackage.UseOLEDBServiceComponents = True
oPackage.LogToSQLServer = False
oPackage.LogServerFlags = 0
oPackage.FailPackageOnLogFailure = False
oPackage.ExplicitGlobalVariables = False
oPackage.PackageType = 0
''---------------------------------------------------------------------------
'' Create Package Connection Information
''---------------------------------------------------------------------------
Dim oConnection As DTS.Connection2
''-----------------------------------------------------------------------------------------------------
'' Create The Connection Link To Oracle Server
''-----------------------------------------------------------------------------------------------------
Set oConnection = oPackage.Connections.New("OraOLEDB.Oracle")
oConnection.ConnectionProperties("Persist Security Info") = True
oConnection.ConnectionProperties("User ID") = Text2(0).Text
oConnection.ConnectionProperties("Data Source") = Text1(0).Text
oConnection.ConnectionProperties("Window Handle") = 0
oConnection.ConnectionProperties("Locale Identifier") = 2052
oConnection.ConnectionProperties("Prompt") = 2
oConnection.ConnectionProperties("OLE DB Services") = -1
oConnection.Name = "Oracle Provider for OLE DB"
oConnection.ID = 1
oConnection.Reusable = True
oConnection.ConnectImmediate = False
oConnection.DataSource = Text1(0).Text
oConnection.UserID = Text2(0).Text
oConnection.ConnectionTimeout = 60
oConnection.UseTrustedConnection = False
oConnection.UseDSL = False
oConnection.Password = Text3(0).Text
oPackage.Connections.Add oConnection
Set oConnection = Nothing
''------------------------------------------------------------------------------------------------------
'' Create the Second Connection Link To SQL Server
''------------------------------------------------------------------------------------------------------
Set oConnection = oPackage.Connections.New("SQLOLEDB")
oConnection.ConnectionProperties("Integrated Security") = "SSPI"
oConnection.ConnectionProperties("Persist Security Info") = True
oConnection.ConnectionProperties("Initial Catalog") = Text1(1).Text
oConnection.ConnectionProperties("Data Source") = Text4.Text
oConnection.ConnectionProperties("Application Name") = "DTS 设计器"
oConnection.Name = "Microsoft OLE DB Provider for SQL Server"
oConnection.ID = 2
oConnection.Reusable = True
oConnection.ConnectImmediate = False
oConnection.DataSource = Text4.Text
oConnection.ConnectionTimeout = 60
oConnection.Catalog = Text1(1).Text
oConnection.UseTrustedConnection = False
oConnection.UseDSL = False
oConnection.UserID = Text2(1).Text
oConnection.Password = Text3(1).Text
oPackage.Connections.Add oConnection
Set oConnection = Nothing
''---------------------------------------------------------------------------
'' Create DTSPackage Steps Information
''---------------------------------------------------------------------------
Dim lnLoop As Integer
Dim tmpStr As String
Dim oStep As DTS.Step2
Dim oPrecConstraint As DTS.PrecedenceConstraint
For lnLoop = 0 To List2.ListCount - 1
Set oStep = oPackage.Steps.New
oStep.Name = "DTSStep_DTSDataPumpTask_" & lnLoop
oStep.Description = "DTS Task " & lnLoop
oStep.ExecutionStatus = 1
oStep.TaskName = "DTSTask_DTSDataPumpTask_" & lnLoop
oStep.CommitSuccess = False
oStep.RollbackFailure = True
oStep.ScriptLanguage = "VBScript"
oStep.AddGlobalVariables = True
oStep.RelativePriority = 3
oStep.CloseConnection = False
oStep.ExecuteInMainThread = False
oStep.IsPackageDSORowset = False
oStep.JoinTransactionIfPresent = False
oStep.DisableStep = False
oStep.FailPackageOnError = False
oPackage.Steps.Add oStep
Set oStep = Nothing
''--------------------------------------------------------------------------------------------------
'' Create Package Tasks Information
''--------------------------------------------------------------------------------------------------
tmpStr = List2.List(lnLoop)
Call Task_Sub(oPackage, Mid(tmpStr, 1, InStr(1, tmpStr, ".", vbTextCompare) - 1), Mid(tmpStr, _
InStr(1, tmpStr, ".", vbTextCompare) + 1), lnLoop)
Next
Call preTaskTable
''-------------------------------------------------------------------------------------------------
'' Add SQLExecute Task:Drop Table ---> Create Table --> DTSStep_DTSDataPumpTask
''-------------------------------------------------------------------------------------------------
Set oStep = oPackage.Steps.New
oStep.Name = "DTSStep_DTSExecuteSQLTask_1"
oStep.Description = "Drop Table"
oStep.ExecutionStatus = 1
oStep.TaskName = "DTSTask_DTSExecuteSQLTask_1"
oStep.CommitSuccess = False
oStep.RollbackFailure = False
oStep.ScriptLanguage = "VBScript"
oStep.AddGlobalVariables = True
oStep.RelativePriority = 3
oStep.CloseConnection = False
oStep.ExecuteInMainThread = False
oStep.IsPackageDSORowset = False
oStep.JoinTransactionIfPresent = False
oStep.DisableStep = False
oStep.FailPackageOnError = False
oPackage.Steps.Add oStep
Set oStep = Nothing
Set oStep = oPackage.Steps.New
oStep.Name = "DTSStep_DTSExecuteSQLTask_2"
oStep.Description = "Create Table"
oStep.ExecutionStatus = 1
oStep.TaskName = "DTSTask_DTSExecuteSQLTask_2"
oStep.CommitSuccess = False
oStep.RollbackFailure = False
oStep.ScriptLanguage = "VBScript"
oStep.AddGlobalVariables = True
oStep.RelativePriority = 3
oStep.CloseConnection = False
oStep.ExecuteInMainThread = False
oStep.IsPackageDSORowset = False
oStep.JoinTransactionIfPresent = False
oStep.DisableStep = False
oStep.FailPackageOnError = False
oPackage.Steps.Add oStep
Set oStep = Nothing
Set oStep = oPackage.Steps("DTSStep_DTSDataPumpTask_0")
Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSExecuteSQLTask_2")
oPrecConstraint.StepName = "DTSStep_DTSExecuteSQLTask_2"
oPrecConstraint.PrecedenceBasis = 0
oPrecConstraint.Value = 4
oStep.PrecedenceConstraints.Add oPrecConstraint
Set oPrecConstraint = Nothing
''------------- a precedence constraint for steps defined below
Set oStep = oPackage.Steps("DTSStep_DTSExecuteSQLTask_2")
Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSExecuteSQLTask_1")
oPrecConstraint.StepName = "DTSStep_DTSExecuteSQLTask_1"
oPrecConstraint.PrecedenceBasis = 0
oPrecConstraint.Value = 4
oStep.PrecedenceConstraints.Add oPrecConstraint
Set oPrecConstraint = Nothing
For lnLoop = 1 To List2.ListCount - 1
Set oStep = oPackage.Steps("DTSStep_DTSDataPumpTask_" & lnLoop)
Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSDataPumpTask_" & (lnLoop - 1))
oPrecConstraint.StepName = "DTSStep_DTSDataPumpTask_" & (lnLoop - 1)
oPrecConstraint.PrecedenceBasis = 0
oPrecConstraint.Value = 4
oStep.PrecedenceConstraints.Add oPrecConstraint
Set oPrecConstraint = Nothing
Next
''---------------------------------------------------------------------------
'' Save And DTSPackage In SQLServer
''---------------------------------------------------------------------------
oPackage.SaveToSQLServer Text4.Text, Text2(1).Text, Text3(1).Text
oPackage.UnInitialize
Set oPackage = Nothing
Set oPackageOld = Nothing
End Sub
''-----------------------------------------------------------------------------------------------------
'' Create Step Drop and Create Table
''-----------------------------------------------------------------------------------------------------
''------------- define Task_Sub2 for task DTSTask_DTSExecuteSQLTask_1 (drop)
Private Sub preTaskTable()
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim tmpStr As String
Dim lnLoop As Integer
Dim strTask1, strTask2 As String
strTask1 = ""
strTask2 = ""
For lnLoop = 0 To List2.ListCount - 1
tmpStr = List2.List(lnLoop)
strSQL = "SELECT COLUMN_ID, COLUMN_NAME, DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE "
strSQL = strSQL & "FROM SYS.ALL_TAB_COLUMNS WHERE TABLE_NAME="
strSQL = strSQL & "''" & Mid(tmpStr, InStr(1, tmpStr, ".", vbTextCompare) + 1) & "''"
strSQL = strSQL & " and OWNER=''" & Mid(tmpStr, 1, InStr(1, tmpStr, ".", vbTextCompare) - 1) & "''"
With rst
.Source = strSQL
.ActiveConnection = oraCon
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
End With
strTask2 = strTask2 & SQLCreateTable(rst, Mid(tmpStr, InStr(1, tmpStr, ".", _
vbTextCompare) + 1))
strTask1 = strTask1 & "DROP TABLE " & Mid(tmpStr, InStr(1, tmpStr, ".", vbTextCompare) + 1) & vbCrLf
rst.Close
Next
Dim oTask As DTS.Task
Dim oLookup As DTS.Lookup
Dim oCustomTask2 As DTS.ExecuteSQLTask2
Set oTask = oPackage.Tasks.New("DTSExecuteSQLTask")
oTask.Name = "DTSTask_DTSExecuteSQLTask_1"
Set oCustomTask2 = oTask.CustomTask
oCustomTask2.Name = "DTSTask_DTSExecuteSQLTask_1"
oCustomTask2.Description = "Drop Table from SQL Server"
oCustomTask2.SQLStatement = strTask1
oCustomTask2.ConnectionID = 2
oCustomTask2.CommandTimeout = 0
oCustomTask2.OutputAsRecordset = False
oPackage.Tasks.Add oTask
Set oCustomTask2 = Nothing
Set oTask = Nothing
Set oTask = oPackage.Tasks.New("DTSExecuteSQLTask")
oTask.Name = "DTSTask_DTSExecuteSQLTask_2"
Set oCustomTask2 = oTask.CustomTask
oCustomTask2.Name = "DTSTask_DTSExecuteSQLTask_2"
oCustomTask2.Description = "Create Table in SQL Server"
oCustomTask2.SQLStatement = strTask2
oCustomTask2.ConnectionID = 2
oCustomTask2.CommandTimeout = 0
oCustomTask2.OutputAsRecordset = False
oPackage.Tasks.Add oTask
Set oCustomTask2 = Nothing
Set oTask = Nothing
End Sub
''------------------------------------------------------------------------------------------------------
'' Function SQLCreateTable(rst As ADODB.Recordset, TableName As String)
''------------------------------------------------------------------------------------------------------
Private Function SQLCreateTable(rst As ADODB.Recordset, TableName As String)
Dim strRtn As String
Dim tmpStr, strType As String
strRtn = "Create Table " & TableName & "(" & vbCrLf
rst.MoveFirst
Do Until rst.EOF
strRtn = strRtn & " " & rst.Fields("COLUMN_NAME") & " "
tmpStr = rst.Fields("DATA_TYPE")
strType = tmpStr
Select Case tmpStr
Case "CHAR"
strType = "CHAR"
Case "VARCHAR2"
If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
strType = "VARCHAR"
Else
strType = "TEXT"
End If
Case "LONG"
If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
strType = "VARCHAR"
Else
strType = "TEXT"
End If
Case "RAW"
If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
strType = "VARBINARY"
Else
strType = "IMAGE"
End If
Case "LONG RAW"
If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
strType = "VARBINARY"
Else
strType = "IMAGE"
End If
Case "NUMBER"
strType = "DECIMAL"
Case "DATE"
strType = "DATETIME"
End Select
strRtn = strRtn & strType
If strType <> "DATETIME" Then
strRtn = strRtn & "("
If Not IsNull(rst.Fields("DATA_PRECISION")) Then
strRtn = strRtn & rst.Fields("DATA_PRECISION") & "," & rst.Fields("DATA_SCALE")
Else
strRtn = strRtn & rst.Fields("DATA_LENGTH")
End If
strRtn = strRtn & ")"
End If
rst.MoveNext
If Not rst.EOF Then
strRtn = strRtn & "," & vbCrLf
End If
Loop
strRtn = strRtn & ");" & vbCrLf
SQLCreateTable = strRtn
End Function
''------------------------------------------------------------------------------------------------------
'' Create DTS Task for the TableName
''------------------------------------------------------------------------------------------------------
Public Sub Task_Sub(ByVal oPackage As Object, Owner As String, TableName As String, TaskNo As Integer)
Dim oTask As DTS.Task
Dim oLookup As DTS.Lookup
Dim oCustomTask1 As DTS.DataPumpTask2
Set oTask = oPackage.Tasks.New("DTSDataPumpTask")
oTask.Name = "DTSTask_DTSDataPumpTask_" & TaskNo
Set oCustomTask1 = oTask.CustomTask
oCustomTask1.Name = "DTSTask_DTSDataPumpTask_" & TaskNo
oCustomTask1.Description = "DTS Task " & TaskNo
oCustomTask1.SourceConnectionID = 1
oCustomTask1.SourceSQLStatement = "select * from " & Owner & "." & TableName
oCustomTask1.DestinationConnectionID = 2
oCustomTask1.DestinationObjectName = TableName
oCustomTask1.ProgressRowCount = 1000
oCustomTask1.MaximumErrorCount = 0
oCustomTask1.FetchBufferSize = 1
oCustomTask1.UseFastLoad = True
oCustomTask1.InsertCommitSize = 0
oCustomTask1.ExceptionFileColumnDelimiter = "|"
oCustomTask1.ExceptionFileRowDelimiter = vbCrLf
oCustomTask1.AllowIdentityInserts = False
oCustomTask1.FirstRow = 0
oCustomTask1.LastRow = 0
oCustomTask1.FastLoadOptions = 2
oCustomTask1.ExceptionFileOptions = 1
oCustomTask1.DataPumpOptions = 0
Call DTS_CustomTask(oCustomTask1)
oPackage.Tasks.Add oTask
Set oCustomTask1 = Nothing
Set oTask = Nothing
End Sub
Private Sub DTS_CustomTask(oTask As DTS.DataPumpTask2)
Dim oTransform As DTS.Transformation2
Set oTransform = _
oTask.Transformations.New("DTS.DataPumpTransformCopy")
oTransform.Name = "CopyColumns"
oTransform.TransformFlags = _
DTSTransformFlag_AllowLosslessConversion
oTask.Transformations.Add oTransform
Set oTransform = Nothing
End Sub
（4）在SQL SERVER AGENT 的作业中生成能定时（本文设置为每天从早晨6:30至晚上11：59每隔6个小时执行一次生成的DTS 包实现数据迁移。
Private Sub GenTaskAgent()
Dim strCmd As String
strCmd = ""
strCmd = strCmd & " BEGIN TRANSACTION" & vbCrLf
strCmd = strCmd & "DECLARE @JobID BINARY(16)" & vbCrLf
strCmd = strCmd & "DECLARE @ReturnCode INT" & vbCrLf
strCmd = strCmd & "SELECT @ReturnCode = 0" & vbCrLf
strCmd = strCmd & "IF (SELECT COUNT(*) FROM msdb.dbo.syscategories WHERE name = N''[Uncategorized (Local)]'') < 1" & vbCrLf
strCmd = strCmd & "EXECUTE msdb.dbo.sp_add_category @name = N''[Uncategorized (Local)]''" & vbCrLf
strCmd = strCmd & "SELECT @JobID = job_id" & vbCrLf
strCmd = strCmd & "From msdb.dbo.sysjobs" & vbCrLf
strCmd = strCmd & "WHERE (name = N''OraToSQL'')" & vbCrLf
strCmd = strCmd & "IF (@JobID IS NOT NULL)" & vbCrLf
strCmd = strCmd & "BEGIN" & vbCrLf
strCmd = strCmd & "IF (EXISTS (SELECT *" & vbCrLf
strCmd = strCmd & " From msdb.dbo.sysjobservers" & vbCrLf
strCmd = strCmd & " WHERE (job_id = @JobID) AND (server_id <> 0)))" & vbCrLf
strCmd = strCmd & "BEGIN" & vbCrLf
strCmd = strCmd & "RAISERROR (N''无法导入作业“OraToSQL_Job”，因为已经有相同名称的多重服务器作业。'', 16, 1)" & vbCrLf
strCmd = strCmd & "GoTo QuitWithRollback" & vbCrLf
strCmd = strCmd & "End" & vbCrLf
strCmd = strCmd & "Else" & vbCrLf
strCmd = strCmd & "EXECUTE msdb.dbo.sp_delete_job @job_name = N''OraToSQL_Job''" & vbCrLf
strCmd = strCmd & "SELECT @JobID = NULL" & vbCrLf
strCmd = strCmd & "End" & vbCrLf
strCmd = strCmd & "BEGIN" & vbCrLf
strCmd = strCmd & "EXECUTE @ReturnCode = msdb.dbo.sp_add_job @job_id = @JobID OUTPUT , @job_name = N''OraToSQL_Job'', @owner_login_name = N''sa'', @description = N''Nothing'', @category_name = N''[Uncategorized (Local)]'', @enabled = 1, @notify_level_email = 0, @notify_level_page = 0, @notify_level_netsend = 0, @notify_level_eventlog = 3, @delete_level= 0" & vbCrLf
strCmd = strCmd & "IF (@@ERROR <> 0 OR @ReturnCode <> 0) GOTO QuitWithRollback" & vbCrLf
strCmd = strCmd & "EXECUTE @ReturnCode = msdb.dbo.sp_add_jobstep @job_id = @JobID, @step_id = 1, @step_name = N''CopyToSQL'', @command = N''DTSRun /s " & Text4.Text & " /u sa /p " & Text3(1).Text & _
" /n OraToSql'', @database_name = N'''', @server = N'''', @database_user_name = N'''', @subsystem = N''CmdExec'', @cmdexec_success_code = 0, @flags = 2, @retry_attempts = 0, @retry_interval = 1, @output_file_name = N''C:\DTS.Log'', @on_success_step_id = 0, @on_success_action = 1, @on_fail_step_id = 0, @on_fail_action = 2" & vbCrLf
strCmd = strCmd & "IF (@@ERROR <> 0 OR @ReturnCode <> 0) GOTO QuitWithRollback" & vbCrLf
strCmd = strCmd & "EXECUTE @ReturnCode = msdb.dbo.sp_update_job @job_id = @JobID, @start_step_id = 1" & vbCrLf
strCmd = strCmd & "IF (@@ERROR <> 0 OR @ReturnCode <> 0) GOTO QuitWithRollback" & vbCrLf
strCmd = strCmd & " EXECUTE @ReturnCode = msdb.dbo.sp_add_jobschedule @job_id = @JobID, @name = N''EverDay Do'', @enabled = 1, @freq_type = 4, @active_start_date = 20030305, @active_start_time = 63000, @freq_interval = 1, @freq_subday_type = 8, @freq_subday_interval = 6, @freq_relative_interval = 0, @freq_recurrence_factor = 0, @active_end_date = 99991231, @active_end_time = 235959" & vbCrLf
strCmd = strCmd & "IF (@@ERROR <> 0 OR @ReturnCode <> 0) GOTO QuitWithRollback" & vbCrLf
strCmd = strCmd & "EXECUTE @ReturnCode = msdb.dbo.sp_add_jobserver @job_id = @JobID, @server_name = N''(local)''" & vbCrLf
strCmd = strCmd & "IF (@@ERROR <> 0 OR @ReturnCode <> 0) GOTO QuitWithRollback" & vbCrLf
strCmd = strCmd & "End" & vbCrLf
strCmd = strCmd & "COMMIT TRANSACTION" & vbCrLf
strCmd = strCmd & "GoTo EndSave" & vbCrLf
strCmd = strCmd & "QuitWithRollback:" & vbCrLf
strCmd = strCmd & "IF (@@TRANCOUNT > 0) ROLLBACK TRANSACTION" & vbCrLf
strCmd = strCmd & "EndSave:" & vbCrLf
Dim oSqlCon As ADODB.Connection
Dim oSqlCmd As New ADODB.Command
Set oSqlCon = New ADODB.Connection
With oSqlCon
.Provider = "SQLOLEDB"
.Properties("User ID") = Text2(1).Text
.Properties("Password") = Text3(1).Text
.Properties("Data Source") = Text4.Text
.Properties("Initial Catalog") = Text1(1).Text
.Properties("Persist Security Info") = True
.Open
End With
With oSqlCmd
.ActiveConnection = oSqlCon
.CommandText = strCmd
.Execute
End With
oSqlCon.Close
End Sub
安装程序运行完后进入SQL SERVER 企业管理器，应能在“数据转换服务”的“本地包”中发现一名为“OraToSql”的本地DTS包，同时在“SQL SERVER 代理”的“作业”中应有一“OraToSQL_Job”的作业。都可以进行修改。
四、结束语
本文介绍的数据库迁移技术，不仅适用于ORACLE 和SQL SERVER ，同样适用与其他同种数据库系统的数据库复制和异种数据库的迁移。
本文介绍的程序，运行环境为：WIN2000 SERVER，SQL SERVER 2000，ORACLE 8i。由于程序有600多行，限于篇幅，没有全部列出。如需要完整的源程序，请与作者联系：wfq_wanglan@sina.com
