在 VB 中动态创建 DTS 包

Andrey Chuvahin

4.00/5 (2投票s)

2006年2月22日

CPOL

7分钟阅读

53120

623

示例动态配置 DTS 包，用于将 DBF 文件传输到 SQL Server，使用 VB。

引言

大多数从事数据访问领域的开发人员都会遇到在其应用程序工作的数据数据库之间移动数据的碰撞。该程序是特定目标的解决方案——将数据从 DBF 格式的表复制到 Microsoft SQL Server 数据库。该解决方案的一个特点是——DTS 包将为 DBF 文件动态创建。它被实现为一个 DCOM 客户端/服务器应用程序（类dbf_dynaimport）。这样的解决方案工作方式如下：应用程序的服务器部分被实现为一个 DCOM 组件，它从应用程序的客户端接收参数：要传输的 DBF 文件的路径、目标 SQL 服务器的名称、目标数据库的名称。要传输的 DBF 文件的路径也可以接受文件夹路径或单个 DBF 表的路径作为值。如果其值是文件夹路径，则包将配置为处理该文件夹中的所有 DBF 文件。服务器组件使用 Microsoft OLE DB Provider for Visual FoxPro 从 DBF 文件获取结构，并使用此信息配置和执行 DTS 包，为此使用 Microsoft DTS Package Object Library，因此应用程序的服务器部分需要 SQL Server。但是，此条件并不意味着服务器组件需要安装在每个 SQL Server 上。一个组件可以用于将数据传输到本地网络上可访问的其他 SQL 服务器，当然，前提是配置了安全性（下面将描述服务器部分的安装和配置）。让我们更详细地考虑类的创建。

I. 服务器应用程序

I.I 使用 ADO 获取 DBF 文件结构

为此，该类使用内部函数 - get_struct。get_struct 接受 DBF 表所在的文件夹路径作为参数。结果是，该函数返回一个动态二维数组。第一列是字段名，第二列是 CREATE TABLE SQL 语句的一部分，其中包含此文本字段的字段类型及其大小的信息。

Private Function get_struct(path As String) As String()
On Error GoTo Error_Handler
  Dim db As New ADODB.Connection, rs As New ADODB.Recordset
  Dim cSql As String, table_name As String, tbl As String
  Dim d As New Collection, c As Variant, f() As String, i As Integer
    If Right(path, 1) <> "\" Then
      tbl = Replace(Right(path, Len(path) - InStrRev(path, "\")), ".dbf", "")
      path = Left(path, InStr(path, "\"))
    End If

在这里，我们确定分配给单个 DBF 文件或文件夹的参数path。

db.CursorLocation = adUseClient
db.Open "DRIVER={Microsoft FoxPro VFP Driver (*.dbf)};" & _
    "SourceDB=" & path & ";SourceType=DBF;deleted=no"
Set rs = db.OpenSchema(adSchemaColumns, Array(Empty, Empty, tbl, table_name))
If rs.RecordCount = 0 Then Err.Raise vbObjectError + 513, "dbf_dynaimport", _
    "Open " & path & tbl & " fault!"

使用 ADO OpenSchema 方法获取数据库架构信息。它返回一个包含列信息的 Recordset。此方法的第二个参数指定约束列 table_name，当参数 path 分配给单个 DBF 文件时，它会限制查询结果。否则，如果 path 分配给文件夹，则变量 tbl 为空，因此返回的 recordset 将不受限制，并将包含该文件夹中所有 DBF 文件的所有列的信息。如果 OpenSchema 未返回任何记录，则意味着从该文件或文件夹检索信息时存在问题。例如，所需的目录中没有文件。因此，无论如何，如果 RecordCount 等于零，我们将向客户端应用程序引发错误。

    On Error Resume Next
    While Not rs.EOF
        d.Add CStr(rs("TABLE_NAME")), CStr(rs("TABLE_NAME"))
        rs.MoveNext
    Wend
    Err.Clear
    On Error GoTo Error_Handler

在返回的记录集中，TABLE_NAME 字段将包含表名。不幸的是，我还没有弄清楚如何过滤结果，以便它只包含该字段的唯一值。因此，我为此使用集合 d。它仅填充该字段的唯一值。

    ReDim Preserve f(d.Count, 2)
    For i = 1 To d.Count
        f(i, 1) = d(i)
        rs.Filter = "TABLE_NAME = '" & d(i) & "'"
        cSql = "[dbo].[" & d(i) & "] ( "
        While Not rs.EOF
            cSql = cSql & "[" & CStr(rs("COLUMN_NAME")) & "] "
            Select Case CInt(rs("DATA_TYPE"))
                Case 3
                  cSql = cSql & "[int] "
                Case 5
                  cSql = cSql & "[float] "
                Case 11
                  cSql = cSql & "[bit] "
                Case 128
                  cSql = cSql & "[image] "
                Case 129
                  If CLng(rs("CHARACTER_MAXIMUM_LENGTH")) = 2147483647 Then _
                  cSql = cSql & "[text] " Else cSql = cSql & "[varchar] (" _
                  & CStr(rs("CHARACTER_MAXIMUM_LENGTH")) & ") "
                Case 131
                  cSql = cSql & "[numeric] " & IIf(CInt(rs("NUMERIC_SCALE")) _
                  = 0, "(" & CInt(rs("NUMERIC_PRECISION")) & ", ", "(" & _
                  CInt(rs("NUMERIC_PRECISION")) - 1 & ", ") & _
                  CInt(rs("NUMERIC_SCALE")) & ") "
                Case 133, 135
                  cSql = cSql & "[datetime] "
            End Select
            cSql = cSql & ", "
            rs.MoveNext
        Wend
        cSql = Left(cSql, Len(cSql) - 2) & ")"
        f(i, 2) = cSql
'        Debug.Print f(i, 1) & "     " & f(i, 2)
    Next i
    get_struct = f
    Set rs = Nothing
    Set db = Nothing
Exit Function
Error_Handler:
Err.Raise Err.Number, "dbf_dynaimport", Err.Description
End Function

我们通过循环遍历集合 d，并使用具有 TABLE_NAME 条件字符串的 Filter 属性。它将记录集限制为具有相同表名的记录。然后移动到过滤后的记录，并查看 DATA_TYPE、CHARACTER_MAXIMUM_LENGTH、NUMERIC_SCALE 和 NUMERIC_PRECISION 列。基于此信息，将 OLE DB 类型指示符映射到 Microsoft SQL Server 数据类型。

I.II 使用 Microsoft DTS Package Object Library 创建 DTS 包

为此，我使用了一个外部函数 trans，该函数直接从客户端应用程序接收参数。根据这些参数，将配置和执行 DTS 包。如果执行成功，我们将在 SQL Server 上获得表。如果执行失败，服务器组件会向客户端应用程序引发错误。

Public Sub trans(pvd As ProviderType, path As String, srv As String, _
db As String)
On Error GoTo Error_Handler

    Dim f() As String
    f = get_struct(path)

类中的第一个操作是调用 get_struct 函数来获取表的结构。

    Dim oPackage As New DTS.Package
    Dim oConnection As DTS.Connection
    Dim oTask As DTS.Task
    Dim oStep As DTS.Step
    Dim oTransform As DTS.Transformation
    Dim oPumpTask As DTS.DataPumpTask
    Dim oEsqlTask As DTS.ExecuteSQLTask
    Dim oPrecConstraint As DTS.PrecedenceConstraint
    Dim i As Integer, j As Integer, n As Integer, tbl As String
    
    With oPackage
        .Name = "DTS Package"
        .FailOnError = True
        .WriteCompletionStatusToNTEventLog = True
    End With

我们将变量 goPackage 实例化为 DTS.Package 对象 - 它是 Microsoft DTSPackage Object Library 层次结构中的最高层。

Select Case pvd
       Case jet
         Set oConnection = oPackage.Connections.New("Microsoft.Jet.OLEDB.4.0")
         oConnection.ConnectionProperties("Extended Properties") = "dBase 5.0"
       Case vfpole
           Set oConnection = oPackage.Connections.New("VFPOLEDB")
End Select
    oConnection.ID = 1
    oConnection.DataSource = path
    oPackage.Connections.Add oConnection
    Set oConnection = Nothing

我们设置源连接。服务器组件可以使用 Jet OLEDB 或 Visual Foxpro OLEDB Provider。此选择由 pvd 参数定义。

    Set oConnection = oPackage.Connections.New("SQLOLEDB")
    With oConnection
        .ID = 2
        .DataSource = srv
        .Catalog = db
        .UseTrustedConnection = True
    End With
    oPackage.Connections.Add oConnection
    Set oConnection = Nothing

设置目标连接

For n = LBound(f) To UBound(f)
    tbl = f(n, 1)
i = i + 1

我们通过循环遍历数组 f。如果变量 path 包含单个文件的路径，则变量 n 等于一，因此循环执行一次。否则，如果 path 分配给文件夹，则 n 大于一，并且循环执行多次。我们使用循环来设置配置包中的 Tasks 和 Steps 对象，因为它们的数量取决于要传输的文件数量。

    Set oTask = oPackage.Tasks.New("DTSExecuteSQLTask")
    Set oEsqlTask = oTask.CustomTask
    With oEsqlTask
        .Name = "SQLTask" & i
        .SQLStatement = "if exists(SELECT [name] FROM [" & db & _
        "].[dbo].[sysobjects] WHERE [name] = '" & tbl & _
        "' AND type = 'U') DROP TABLE [" & db & "].[dbo].[" & tbl _
        & "] CREATE TABLE [" & db & "]." & f(n, 2)
        .ConnectionID = 2
    End With
    oPackage.Tasks.Add oTask
    Set oEsqlTask = Nothing
    Set oTask = Nothing

向 Tasks 集合添加创建一个表任务。它的 ExecuteSQLTask 对象是通过调用 Tasks.New 方法并带有类名参数 DTSExecuteSQLTask 来创建的。此任务将根据 oEsqlTask.SQLStatement 属性的值在 DB 中创建一个空表。除了常规的 CREATE TABLE SQL 语句外，我还添加了一个 SQL 语句来检查是否存在同名表（if exists）。如果表已存在，它将被删除。此行为可以更改，但在当前实现中是这样做的。oEsqlTask 链接到 Connection 2。

    Set oTask = oPackage.Tasks.New("DTSDataPumpTask")
    Set oPumpTask = oTask.CustomTask
    With oPumpTask
        .Name = "PumpTask" & i
        .SourceConnectionID = 1
        .SourceSQLStatement = "select * from " & tbl
        .DestinationConnectionID = 2
        .DestinationObjectName = "[" & db & "].[dbo].[" & tbl & "]"
    End With

向 Tasks 集合添加第二个 Task 对象。它的 Transform Data Task 对象是通过调用 Tasks.New 方法并带有类名参数 DTSDataPumpTask 来创建的。Transform Data Task 对象在源连接和目标连接之间执行数据转换。源连接由 SourceConnectionID 属性指定，目标连接由 DestinationConnectionID 属性指定。oPumpTask.SourceSQLStatement 属性是来自 DBF 文件的 SQL select 命令。

   Set oTransform = oPumpTask.Transformations.New("DTS.DataPumpTransformCopy")
   With oTransform
       .Name = "Transform"
       .TransformFlags = DTSTransformFlag_Default
   End With
   oPumpTask.Transformations.Add oTransform
   oPackage.Tasks.Add oTask
   Set oTask = Nothing
j = j + 1

向 oPumpTask.Transformations 集合添加 Transformation 对象，其中包含有关从源表到目标表字段转换的信息。它在 TransformFlags 属性中使用 DTSTransformFlag_Default 常量。

    Set oStep = oPackage.Steps.New
    oStep.Name = "Step" & j
    oStep.TaskName = "SQLTask" & i
    oPackage.Steps.Add oStep
    Set oStep = Nothing
j = j + 1
    Set oStep = oPackage.Steps.New
    oStep.Name = "Step" & j
    oStep.TaskName = "PumpTask" & i
    oPackage.Steps.Add oStep

向 Steps 集合添加两个 Step 对象，这些对象包含包流程和已完成任务的信息。这两个步骤都通过行 goPackage.Steps.Add oStep 添加到包中。

    Set oPrecConstraint = oStep.PrecedenceConstraints.New("Step" & j - 1)
    oStep.PrecedenceConstraints.Add oPrecConstraint
    Set oPrecConstraint = Nothing
    Set oStep = Nothing
Next n

向 PrecedenceConstraints 集合添加 PrecedenceConstraint 对象，该对象确定在包执行下一个名为 Step2 的步骤之前应遵守的条件。条件由 PrecedenceBasis 和 Value 属性定义。此处使用默认值，因此在代码中省略了这些属性。默认情况下，PrecedenceBasis 等于 DTSStepPrecedenceBasis_ExecResult 常量，即它基于执行结果。Value 等于 DTSStepExecResult_Success 常量，表示 Step 执行成功。因此，只有在 Step1 的执行状态等于成功时，才会执行 Step2。

If usr = "" Then oPackage.Execute Else oPackage.SaveToSQLServer srv, _
usr, pwd
Set oPackage = Nothing
Exit Sub

最后，包配置完毕，可以执行或保存到 SQL Server。此选择由外部属性 save 定义。执行或保存后，对象将被销毁，并且 sub 将正常退出。

Error_Handler:
Err.Raise Err.Number, "dbf_dynaimport", "Execution of Package failed, " & _
"Description: " & Err.Description & vbCrLf & sAccumStepErrors(oPackage)

最后是 Sub Error_Handler。

II. 客户端应用程序

来自可能客户端应用程序的小示例代码

Dim c As New trans_svr.dbf_dynaimport
c.trans vfpole, "C:\", "strong_server", "pubs"

或者

c.trans jet, "\\rrp\d\test\1.dbf", "strong_server", "pubs"

或者

c.save("sa") = "pass"
c.trans jet, "\\rrp\d\test\", "strong_server", "pubs"

III. 部署应用程序

为了开发和部署此应用程序作为 DCOM 应用程序，我使用了一篇非常好的 Microsoft 文章

在该文章的“设置服务器安全性”部分，我建议仅为此应用程序调整安全设置

在服务器计算机上，单击“开始”按钮，然后选择“运行”。在“运行”对话框中，键入 Dcomcnfg，然后单击“确定”。
选择“默认属性”选项卡，并验证“启用此计算机上的分布式 COM”是否已选中。
选择“应用程序”选项卡，突出显示服务器 trans_svr.dbf_dynaimport，然后单击“属性”按钮。
选择“常规”选项卡，将“身份验证级别”设置为“默认”，然后选择“位置”选项卡。唯一应检查的选项是“在此计算机上运行应用程序”。
选择“安全性”选项卡，并选中“使用自定义访问权限”和“使用自定义启动权限”选项。单击“访问(启动)权限”的“编辑...”按钮，并使用“添加”按钮添加将访问(启动)应用程序的用户或组。例如，Domain Users。还将 SYSTEM 帐户添加到访问和启动权限。
选择“标识”选项卡。在此选项卡上，您需要指定将标识应用程序服务器部分的帐户。此帐户将是 SQL Server 信任的帐户。设置 Windows 用户帐户就足够了，并将此帐户添加到 SQL Server 安全登录。然后指定此登录可以访问哪些数据库，并将 db_ddladmin、db_datareader、db_datawriter 数据库角色添加到这些数据库。此外，服务器组件还可以与域中的其他 SQL Servers 一起使用。只需将此 Windows 用户帐户添加到这些 SQL Server，如上所示。

必须记住，应用程序的服务器部分具有如 Windows 帐户访问权限等访问权限，这些权限将被识别。作为参数传递给服务器组件的文件路径对于此 Windows 帐户可能不可见。可以使用通用命名约定 (UNC) 作为参数。

待办事项

如果我有时间，我可能会创建一个类似的组件，用于将数据从 Excel、Access 传输到 SQL。我也可能为现代版本的 .NET 和 SQL Server 开发相同的组件。