form1.frm

用VB实现把Oracle与Sql SERver 2000实时同步

      .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



Private Sub GenDTSPackage_click()
    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") = Text1.Text
    oConnection.ConnectionProperties("Data Source") = Text3.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 = Text3.Text
    oConnection.UserID = Text1.Text
    oConnection.ConnectionTimeout = 60
    oConnection.UseTrustedConnection = False
    oConnection.UseDSL = False
    oConnection.Password = Text2.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") = Text6.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 = Text6.Text
    oConnection.UseTrustedConnection = False
    oConnection.UseDSL = False
    oConnection.UserID = Text6.Text
    oConnection.Password = Text5.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 Text5.Text, Text6.Text, Text4.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