应用错误收集

我最后深入挖掘了SQL 2000文档（构建SQL Server应用程序/ DTS编程/编程DTS应用程序/ DTS对象模型）并创建了一个VBS脚本来读取包和编写XML文件。它不完整，可以通过多种方式进行改进，但这是一个很大的开始：

GetPackages.vbs

Option Explicit

Sub GetProperties (strPackageName, dtsProperties, xmlDocument, xmlProperties)
    Dim dtsProperty

    If Not dtsProperties Is Nothing Then
        For Each dtsProperty in dtsProperties
            If dtsProperty.Set Then
                Dim xmlProperty
                Set xmlProperty = xmlProperties.insertBefore ( _
                    xmlDocument.createElement ("Property"), _
                    xmlProperties.selectSingleNode ("Property[@Name > '" & dtsProperty.Name & "']"))

                'properties
                'xmlProperty.setAttribute "Get",    dtsProperty.Get
                'xmlProperty.setAttribute "Set",    dtsProperty.Set
                xmlProperty.setAttribute "Type",    dtsProperty.Type
                xmlProperty.setAttribute "Name",    dtsProperty.Name

                If not isnull(dtsProperty.Value) Then
                    xmlProperty.setAttribute "Value",   dtsProperty.Value
                End If

                'collections
                'getting properties of properties causes a stack overflow
                'GetProperties strPackageName, dtsProperty.Properties, xmlDocument, xmlProperty.appendChild (xmlDocument.createElement ("Properties"))
            End If
        Next
    End If
End Sub

Sub GetOLEDBProperties (strPackageName, dtsOLEDBProperties, xmlDocument, xmlOLEDBProperties)
    Dim dtsOLEDBProperty

    For Each dtsOLEDBProperty in dtsOLEDBProperties
        If dtsOLEDBProperty.IsDefaultValue = 0 Then
            Dim xmlOLEDBProperty
            Set xmlOLEDBProperty = xmlOLEDBProperties.insertBefore ( _
                xmlDocument.createElement ("OLEDBProperty"), _
                xmlOLEDBProperties.selectSingleNode ("OLEDBProperty[@Name > '" & dtsOLEDBProperty.Name & "']"))

            'properties
            xmlOLEDBProperty.setAttribute "Name",           dtsOLEDBProperty.Name
            'xmlOLEDBProperty.setAttribute "PropertyID",        dtsOLEDBProperty.PropertyID
            'xmlOLEDBProperty.setAttribute "PropertySet",       dtsOLEDBProperty.PropertySet
            xmlOLEDBProperty.setAttribute "Value",          dtsOLEDBProperty.Value
            'xmlOLEDBProperty.setAttribute "IsDefaultValue",    dtsOLEDBProperty.IsDefaultValue

            'collections
            'these properties are the same as the ones directly above
            'GetProperties strPackageName, dtsOLEDBProperty.Properties, xmlDocument, xmlOLEDBProperty.appendChild (xmlDocument.createElement ("Properties"))
        End If
    Next
End Sub

Sub GetConnections (strPackageName, dtsConnections, xmlDocument, xmlConnections)
    Dim dtsConnection2

    For Each dtsConnection2 in dtsConnections
        Dim xmlConnection2
        Set xmlConnection2 = xmlConnections.insertBefore ( _
            xmlDocument.createElement ("Connection2"), _
            xmlConnections.selectSingleNode ("Connection2[@Name > '" & dtsConnection2.Name & "']"))

        'properties
        xmlConnection2.setAttribute "ID",       dtsConnection2.ID
        xmlConnection2.setAttribute "Name",     dtsConnection2.Name
        xmlConnection2.setAttribute "ProviderID",   dtsConnection2.ProviderID

        'collections
        GetProperties strPackageName, dtsConnection2.Properties, xmlDocument, xmlConnection2.appendChild (xmlDocument.createElement ("Properties"))

        Dim dtsOLEDBProperties
        On Error Resume Next
        Set dtsOLEDBProperties = dtsConnection2.ConnectionProperties

        If Err.Number = 0 Then
            On Error Goto 0
            GetOLEDBProperties strPackageName, dtsOLEDBProperties, xmlDocument, xmlConnection2.appendChild (xmlDocument.createElement ("ConnectionProperties"))
        Else
            MsgBox Err.Description & vbCrLf & "ProviderID: " & dtsConnection2.ProviderID & vbCrLf & "Connection Name: " & dtsConnection2.Name, , strPackageName
            On Error Goto 0
        End If

    Next
End Sub

Sub GetGlobalVariables (strPackageName, dtsGlobalVariables, xmlDocument, xmlGlobalVariables)
    Dim dtsGlobalVariable2

    For Each dtsGlobalVariable2 in dtsGlobalVariables
        Dim xmlGlobalVariable2
        Set xmlGlobalVariable2 = xmlGlobalVariables.insertBefore ( _
            xmlDocument.createElement ("GlobalVariable2"), _
            xmlGlobalVariables.selectSingleNode ("GlobalVariable2[@Name > '" & dtsGlobalVariable2.Name & "']"))

        'properties
        xmlGlobalVariable2.setAttribute "Name",     dtsGlobalVariable2.Name

        If Not Isnull(dtsGlobalVariable2.Value) Then
            xmlGlobalVariable2.setAttribute "Value",    dtsGlobalVariable2.Value
        End If

        'no extended properties

        'collections
        'GetProperties strPackageName, dtsGlobalVariable2.Properties, xmlDocument, xmlGlobalVariable2.appendChild (xmlDocument.createElement ("Properties"))
    Next
End Sub

Sub GetSavedPackageInfos (strPackageName, dtsSavedPackageInfos, xmlDocument, xmlSavedPackageInfos)
    Dim dtsSavedPackageInfo

    For Each dtsSavedPackageInfo in dtsSavedPackageInfos
        Dim xmlSavedPackageInfo
        Set xmlSavedPackageInfo = xmlSavedPackageInfos.appendChild (xmlDocument.createElement ("SavedPackageInfo"))

        'properties
        xmlSavedPackageInfo.setAttribute "Description",     dtsSavedPackageInfo.Description
        xmlSavedPackageInfo.setAttribute "IsVersionEncrypted",  dtsSavedPackageInfo.IsVersionEncrypted
        xmlSavedPackageInfo.setAttribute "PackageCreationDate", dtsSavedPackageInfo.PackageCreationDate
        xmlSavedPackageInfo.setAttribute "PackageID",       dtsSavedPackageInfo.PackageID
        xmlSavedPackageInfo.setAttribute "PackageName",     dtsSavedPackageInfo.PackageName
        xmlSavedPackageInfo.setAttribute "VersionID",       dtsSavedPackageInfo.VersionID
        xmlSavedPackageInfo.setAttribute "VersionSaveDate", dtsSavedPackageInfo.VersionSaveDate
    Next
End Sub

Sub GetPrecedenceConstraints (strPackageName, dtsPrecedenceConstraints, xmlDocument, xmlPrecedenceConstraints)
    Dim dtsPrecedenceConstraint

    For Each dtsPrecedenceConstraint in dtsPrecedenceConstraints
        Dim xmlPrecedenceConstraint
        Set xmlPrecedenceConstraint = xmlPrecedenceConstraints.insertBefore ( _
            xmlDocument.createElement ("PrecedenceConstraint"), _
            xmlPrecedenceConstraints.selectSingleNode ("PrecedenceConstraint[@StepName > '" & dtsPrecedenceConstraint.StepName & "']"))

        'properties
        xmlPrecedenceConstraint.setAttribute "StepName",    dtsPrecedenceConstraint.StepName

        'collections
        GetProperties   strPackageName, dtsPrecedenceConstraint.Properties, xmlDocument, xmlPrecedenceConstraint.appendChild (xmlDocument.createElement ("Properties"))
    Next
End Sub

Sub GetSteps (strPackageName, dtsSteps, xmlDocument, xmlSteps)
    Dim dtsStep2

    For Each dtsStep2 in dtsSteps
        Dim xmlStep2
        Set xmlStep2 = xmlSteps.insertBefore ( _
            xmlDocument.createElement ("Step2"), _
            xmlSteps.selectSingleNode ("Step2[@Name > '" & dtsStep2.Name & "']"))

        'properties
        xmlStep2.setAttribute "Name",       dtsStep2.Name
        xmlStep2.setAttribute "Description",    dtsStep2.Description

        'collections
        GetProperties           strPackageName, dtsStep2.Properties,        xmlDocument, xmlStep2.appendChild (xmlDocument.createElement ("Properties"))
        GetPrecedenceConstraints    strPackageName, dtsStep2.PrecedenceConstraints, xmlDocument, xmlStep2.appendChild (xmlDocument.createElement ("PrecedenceConstraints"))
    Next
End Sub

Sub GetColumns (strPackageName, dtsColumns, xmlDocument, xmlColumns)
    Dim dtsColumn

    For Each dtsColumn in dtsColumns
        Dim xmlColumn
        Set xmlColumn = xmlColumns.appendChild (xmlDocument.createElement ("Column"))

        GetProperties strPackageName, dtsColumn.Properties, xmlDocument, xmlColumn.appendChild (xmlDocument.createElement ("Properties"))
    Next
End Sub

Sub GetLookups (strPackageName, dtsLookups, xmlDocument, xmlLookups)
    Dim dtsLookup

    For Each dtsLookup in dtsLookups
        Dim xmlLookup
        Set xmlLookup = xmlLookups.appendChild (xmlDocument.createElement ("Lookup"))

        GetProperties strPackageName, dtsLookup.Properties, xmlDocument, xmlLookup.appendChild (xmlDocument.createElement ("Properties"))
    Next
End Sub

Sub GetTransformations (strPackageName, dtsTransformations, xmlDocument, xmlTransformations)
    Dim dtsTransformation

    For Each dtsTransformation in dtsTransformations
        Dim xmlTransformation
        Set xmlTransformation = xmlTransformations.appendChild (xmlDocument.createElement ("Transformation"))

        GetProperties strPackageName, dtsTransformation.Properties, xmlDocument, xmlTransformation.appendChild (xmlDocument.createElement ("Properties"))
    Next
End Sub

Sub GetTasks (strPackageName, dtsTasks, xmlDocument, xmlTasks)
    Dim dtsTask

    For each dtsTask in dtsTasks
        Dim xmlTask 
        Set xmlTask = xmlTasks.insertBefore ( _
            xmlDocument.createElement ("Task"), _
            xmlTasks.selectSingleNode ("Task[@Name > '" & dtsTask.Name & "']"))

        ' The task can be of any task type, and each type of task has different properties.

        'properties
        xmlTask.setAttribute "CustomTaskID",    dtsTask.CustomTaskID
        xmlTask.setAttribute "Name",        dtsTask.Name
        xmlTask.setAttribute "Description", dtsTask.Description

        'collections
        GetProperties strPackageName, dtsTask.Properties, xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("Properties"))

        If dtsTask.CustomTaskID = "DTSDataPumpTask" Then
            GetOLEDBProperties  strPackageName, dtsTask.CustomTask.SourceCommandProperties,     xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("SourceCommandProperties"))
            GetOLEDBProperties  strPackageName, dtsTask.CustomTask.DestinationCommandProperties,    xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("DestinationCommandProperties"))
            GetColumns      strPackageName, dtsTask.CustomTask.DestinationColumnDefinitions,    xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("DestinationColumnDefinitions"))
            GetLookups      strPackageName, dtsTask.CustomTask.Lookups,             xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("Lookups"))
            GetTransformations  strPackageName, dtsTask.CustomTask.Transformations,         xmlDocument, xmlTask.appendChild (xmlDocument.createElement ("Transformations"))
        End If
    Next
End Sub

Sub FormatXML (xmlDocument, xmlElement, intIndent)
    Dim xmlSubElement

    For Each xmlSubElement in xmlElement.selectNodes ("*")
        xmlElement.insertBefore xmlDocument.createTextNode (vbCrLf & String (intIndent + 1, vbTab)), xmlSubElement
        FormatXML xmlDocument, xmlSubElement, intIndent + 1
    Next

    If xmlElement.selectNodes ("*").length > 0 Then
        xmlElement.appendChild xmlDocument.createTextNode (vbCrLf & String (intIndent, vbTab))
    End If
End Sub

Sub GetPackage (strServerName, strPackageName)
    Dim dtsPackage2
    Set dtsPackage2 = CreateObject ("DTS.Package2")

    Dim DTSSQLStgFlag_Default
    Dim DTSSQLStgFlag_UseTrustedConnection

    DTSSQLStgFlag_Default = 0
    DTSSQLStgFlag_UseTrustedConnection = 256

    On Error Resume Next
    dtsPackage2.LoadFromSQLServer strServerName, , , DTSSQLStgFlag_UseTrustedConnection, , , , strPackageName

    If Err.Number = 0 Then
        On Error Goto 0
        'fsoTextStream.WriteLine dtsPackage2.Name

        Dim xmlDocument
        Set xmlDocument = CreateObject ("Msxml2.DOMDocument.3.0")

        Dim xmlPackage2
        Set xmlPackage2 = xmlDocument.appendChild (xmlDocument.createElement ("Package2"))

        'properties
        xmlPackage2.setAttribute "Name", dtsPackage2.Name

        'collections
        GetProperties       strPackageName, dtsPackage2.Properties,     xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement("Properties"))
        GetConnections      strPackageName, dtsPackage2.Connections,    xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement ("Connections"))
        GetGlobalVariables  strPackageName, dtsPackage2.GlobalVariables,    xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement ("GlobalVariables"))
        'SavedPackageInfos only apply to DTS packages saved in structured storage files
        'GetSavedPackageInfos   strPackageName, dtsPackage2.SavedPackageInfos,  xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement ("SavedPackageInfos"))
        GetSteps        strPackageName, dtsPackage2.Steps,      xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement ("Steps"))
        GetTasks        strPackageName, dtsPackage2.Tasks,      xmlDocument, xmlPackage2.appendChild (xmlDocument.createElement ("Tasks"))

        FormatXML xmlDocument, xmlPackage2, 0
        xmlDocument.save strPackageName + ".xml"
    Else
        MsgBox Err.Description, , strPackageName
        On Error Goto 0
    End If
End Sub

Sub Main
    Dim strServerName
    strServerName = Trim (InputBox ("Server:"))

    If strServerName  "" Then
        Dim cnSQLServer 
        Set cnSQLServer = CreateObject ("ADODB.Connection")
        cnSQLServer.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=msdb;Data Source=" & strServerName

        Dim rsDTSPackages
        Set rsDTSPackages = cnSQLServer.Execute ("SELECT DISTINCT name FROM sysdtspackages ORDER BY name")

        Dim strPackageNames

        Do While Not rsDTSPackages.EOF
            GetPackage strServerName, rsDTSPackages ("name")
            rsDTSPackages.MoveNext
        Loop

        rsDTSPackages.Close
        set rsDTSPackages = Nothing

        cnSQLServer.Close
        Set cnSQLServer = Nothing

        Dim strCustomTaskIDs
        Dim strCustomTaskID

        MsgBox "Finished", , "GetPackages.vbs"
    End If
End Sub

Main

您可以尝试使用系统表sysdtspackages，如Transferring DTS Packages中的sqldts.com所示。
此外，在新版本激增之前，曾经有许多可用于MS SQL 2000的工具。我在Red Gate Labs免费下载了一个名为DTS Package Compare的文件。

为了完整起见，我启动了另一个VBS脚本来读取由GetPackages.vbs生成的XML文件，并将其另存为另一个SQL Server上的DTS包。这甚至不太完整，但我希望它最终会有用。

PushPackages.vbs

Option Explicit

Sub SetProperties (dtsProperties, xmlProperties)
    dim xmlProperty

    For Each xmlProperty in xmlProperties.selectNodes ("Property[@Set='-1']")
        dtsProperties.Item (xmlProperty.getAttribute ("Name")).Value = xmlProperty.getAttribute ("Value")
    Next
End Sub

Sub SetOLEDBProperties (dtsOLEDBProperties, xmlOLEDBProperties)
    dim xmlOLEDBProperty

    For Each xmlOLEDBProperty in xmlOLEDBProperties.selectNodes ("OLEDBProperty")
        dtsOLEDBProperties.Item (xmlOLEDBProperty.getAttribute ("Name")).Value = xmlOLEDBProperty.getAttribute ("Value")
    Next
End Sub

Sub SetConnections (dtsConnections, xmlConnections)
    dim dtsConnection2
    dim xmlConnection2

    For each xmlConnection2 in xmlConnections.selectNodes ("Connection2")
        set dtsConnection2 = dtsConnections.New (xmlConnection2.getAttribute ("ProviderID"))
        SetProperties       dtsConnection2.Properties,      xmlConnection2.selectSingleNode ("Properties")
        SetOLEDBProperties  dtsConnection2.ConnectionProperties,    xmlConnection2.selectSingleNode ("ConnectionProperties")
        dtsConnections.Add dtsConnection2
    Next
End Sub

Sub SetGlobalVariables (dtsGlobalVariables, xmlGlobalVariables)
    dim xmlGlobalVariable2

    For Each xmlGlobalVariable2 in xmlGlobalVariables.selectNodes ("GlobalVariable2")
        dtsGlobalVariables.AddGlobalVariable xmlGlobalVariable2.getAttribute ("Name"), xmlGlobalVariable2.getAttribute ("Value")
    Next
End Sub

Sub SetPrecedenceConstraints (dtsPrecedenceConstraints, xmlPrecedenceConstraints)
    dim xmlPrecedenceConstraint
    dim dtsPrecedenceConstraint

    For Each xmlPrecedenceConstraint in xmlPrecedenceConstraints.selectNodes ("PrecedenceConstraint")
        set dtsPrecedenceConstraint = dtsPrecedenceConstraints.New (xmlPrecedenceConstraint.getAttribute ("StepName"))
        SetProperties dtsPrecedenceConstraint.Properties, xmlPrecedenceConstraint.selectSingleNode ("Properties")
        dtsPrecedenceConstraints.Add dtsPrecedenceConstraint
    Next
End Sub

Sub SetSteps (dtsSteps, xmlSteps)
    dim xmlStep2
    dim dtsStep2

    For Each xmlStep2 in xmlSteps.selectNodes ("Step2")
        set dtsStep2 = dtsSteps.New
        SetProperties dtsStep2.Properties, xmlStep2.selectSingleNode ("Properties")
        dtsSteps.Add dtsStep2
    Next

    For Each xmlStep2 in xmlSteps.selectNodes ("Step2")
        set dtsStep2 = dtsSteps.Item (xmlStep2.getAttribute ("Name"))
        SetPrecedenceConstraints dtsStep2.PrecedenceConstraints, xmlStep2.selectSingleNode ("PrecedenceConstraints")
    Next
End Sub

Sub SetTasks (dtsTasks, xmlTasks)
    dim xmlTask
    dim dtsTask

    For Each xmlTask in xmlTasks.selectNodes ("Task")
        set dtsTask = dtsTasks.New (xmlTask.getAttribute ("CustomTaskID"))
        SetProperties dtsTask.Properties, xmlTask.selectSingleNode ("Properties")
        dtsTasks.Add dtsTask
    Next
End Sub

Sub CreatePackage (strServerName, strFileName)
    Dim fsoFileSystem
    set fsoFileSystem = CreateObject ("Scripting.FileSystemObject")

    Dim dtsPackage2
    Set dtsPackage2 = CreateObject ("DTS.Package2")

    Dim DTSSQLStgFlag_Default
    Dim DTSSQLStgFlag_UseTrustedConnection

    DTSSQLStgFlag_Default = 0
    DTSSQLStgFlag_UseTrustedConnection = 256

    Dim xmlDocument
    Set xmlDocument = CreateObject ("Msxml2.DOMDocument.3.0")
    xmlDocument.load strFileName

    Dim xmlPackage2
    set xmlPackage2 = xmlDocument.selectSingleNode ("Package2")

    'properties
    SetProperties dtsPackage2.Properties, xmlPackage2.selectSingleNode ("Properties")

    'collections
    SetConnections      dtsPackage2.Connections,    xmlPackage2.selectSingleNode ("Connections")
    SetGlobalVariables  dtsPackage2.GlobalVariables,    xmlPackage2.selectSingleNode ("GlobalVariables")
    SetSteps        dtsPackage2.Steps,      xmlPackage2.selectSingleNode ("Steps")
    SetTasks        dtsPackage2.Tasks,      xmlPackage2.selectSingleNode ("Tasks")

    On Error Resume Next
    dtsPackage2.SaveToSQLServer strServerName, , , DTSSQLStgFlag_UseTrustedConnection

    If Err.Number Then
        MsgBox Err.Description
    End If
End Sub

Sub Main
    Dim strServerName
    Dim strFileName

    If WScript.Arguments.Count  2 Then
        MsgBox "Usage: PushPackages servername filename"
    Else
        strServerName = WScript.Arguments (0)
        strFileName = WScript.Arguments (1)
        CreatePackage strServerName, strFileName
    End If
End Sub

Main

此工具（DTSDoc）在记录DTS包方面做得很好。它可以从命令行运行，这对于使文档保持最新非常有用。它有一些积极的评论：

Review by ASP Alliance

Review by Mike Gunderloy (LARKWARE)

如何为SQL Server上的每个DTS包创建一个人类可读的脚本？

4 个答案: