modmain.bas

连接SQL用连接查询SQL字段做新表等等对新人比较有价值

                Next objCatalog
                StatusMessage "  * " & CStr(i2) & " FullText Catalogs scripted."
                DoEvents
            End If
            Close #iFileNumber
            
            If bScriptDBTables Then
                'Script Tables, Indexes and Triggers
                StatusMessage "  - Generating scripts for Tables, Indexes and Triggers:"
                iFileNumber = FreeFile
                strFile = strDir & strYYYYMMDD & "." & objDatabase.Name & "_Tables.sql"
                Open strFile For Output As #iFileNumber
                i2 = 0
                For Each objTab In objDatabase.Tables
                    If Not objTab.SystemObject Then
                        i2 = i2 + 1
                        StatusMessage "    - Generating T-SQL code for Table " & CStr(i2) & ": " & objTab.Name
                        strScript = objTab.Script(ScriptType:=cTableScriptOptions, Script2Type:=IIf(bScriptDBFullText, SQLDMOScript2_FullTextIndex, SQLDMOScript2_Default))
                        DoEvents
                        Print #iFileNumber, strScript
                        DoEvents
                    End If
                Next objTab
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Tables scripted."
                DoEvents
            End If
            
            If bScriptDBViews Then
                'Script Views
                StatusMessage "  - Generating scripts for Views:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_Views.sql" For Output As #iFileNumber
                i2 = 0
                For Each objView In objDatabase.Views
                    If Not objView.SystemObject Then
                        i2 = i2 + 1
                        StatusMessage "    - Generating T-SQL code for View " & CStr(i2) & ": " & objView.Name
                        strScript = objView.Script(ScriptType:=cScriptOptions)
                        DoEvents
                        Print #iFileNumber, strScript
                        DoEvents
                    End If
                Next objView
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Views scripted."
                DoEvents
            End If
                
            If bScriptDBSPs Then
                'Script Stored Procedures
                StatusMessage "  - Generating scripts for Stored Procedures:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_Procs.sql" For Output As #iFileNumber
                i2 = 0
                For Each objProc In objDatabase.StoredProcedures
                    If Not objProc.SystemObject Then
                        i2 = i2 + 1
                        StatusMessage "    - Generating T-SQL code for Procedure " & CStr(i2) & ": " & objProc.Name
                        strScript = objProc.Script(ScriptType:=cScriptOptions)
                        DoEvents
                        Print #iFileNumber, strScript
                        DoEvents
                    End If
                Next objProc
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Stored Procedures scripted."
                DoEvents
            End If
            
            If bScriptDBRules Then
                'Script Rules
                StatusMessage "  - Generating scripts for Rules:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_Rules.sql" For Output As #iFileNumber
                i2 = 0
                For Each objRule In objDatabase.Rules
                    i2 = i2 + 1
                    StatusMessage "    - Generating T-SQL code for Rule " & CStr(i2) & ": " & objRule.Name
                    strScript = objRule.Script(ScriptType:=cScriptOptions)
                    DoEvents
                    Print #iFileNumber, strScript
                    DoEvents
                Next objRule
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Rules scripted."
                DoEvents
            End If
            
            If bScriptDBDefaults Then
                'Script Defaults
                StatusMessage "  - Generating scripts for Defaults:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_Defaults.sql" For Output As #iFileNumber
                i2 = 0
                For Each objDefault In objDatabase.Defaults
                    i2 = i2 + 1
                    StatusMessage "    - Generating T-SQL code for Default " & CStr(i2) & ": " & objDefault.Name
                    strScript = objDefault.Script(ScriptType:=cScriptOptions)
                    DoEvents
                    Print #iFileNumber, strScript
                    DoEvents
                Next objDefault
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Defaults scripted."
                DoEvents
            End If
            
            If bScriptDBUsers Then
                'Script Users
                StatusMessage "  - Generating scripts for Users:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_Users.sql" For Output As #iFileNumber
                i2 = 0
                For Each objUser In objDatabase.Users
                    If Not objUser.SystemObject Then
                        i2 = i2 + 1
                        StatusMessage "    - Generating T-SQL code for User " & CStr(i2) & ": " & objUser.Name
                        strScript = objUser.Script(ScriptType:=cScriptOptions, Script2Type:=SQLDMOScript2_LoginSID)
                        DoEvents
                        Print #iFileNumber, strScript
                        DoEvents
                    End If
                Next objUser
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Users scripted."
                DoEvents
            End If
            
            If bScriptDBRoles Then
                'Script Database Roles
                StatusMessage "  - Generating scripts for Database Roles:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_DBRoles.sql" For Output As #iFileNumber
                i2 = 0
                For Each objRole In objDatabase.DatabaseRoles
                    If Not objRole.IsFixedRole Then
                        i2 = i2 + 1
                        StatusMessage "    - Generating T-SQL code for Database Role " & CStr(i2) & ": " & objRole.Name
                        strScript = objRole.Script(ScriptType:=cScriptOptions)
                        DoEvents
                        Print #iFileNumber, strScript
                        DoEvents
                    End If
                Next objRole
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " Database Roles scripted."
                DoEvents
            End If
            
            If bScriptDBUDTs Then
                'Script User Defined Datatypes
                StatusMessage "  - Generating scripts for User Defined Datatypes:"
                iFileNumber = FreeFile
                Open strDir & strYYYYMMDD & "." & objDatabase.Name & "_UDTs.sql" For Output As #iFileNumber
                i2 = 0
                For Each objUDT In objDatabase.UserDefinedDatatypes
                    i2 = i2 + 1
                    StatusMessage "    - Generating T-SQL code for User Defined Datatype " & CStr(i2) & ": " & objUDT.Name
                    strScript = objUDT.Script(ScriptType:=cScriptOptions)
                    DoEvents
                    Print #iFileNumber, strScript
                    DoEvents
                Next objUDT
                Close #iFileNumber
                StatusMessage "  * " & CStr(i2) & " User Defined Datatypes scripted."
                DoEvents
            End If
            
            StatusMessage "* Database " & objDatabase.Name & " scripted."
NextDatabase:
        Next j
        StatusMessage CStr(i) & " Databases scripted."
    End If
    
    StatusMessage "Ready."
    Exit Sub
    
ErrorHandler:       ' Error-handling routine.
    StatusMessage "Error: 0x" & Hex$(Err.Number) & vbTab & Error(Err.Number)
    Select Case Err.Number
        Case &H35           'File does not exist
            StatusMessage "Error deleting file. Resuming with next one."
            Resume Next
        Case &H80030002     'DTS Package version number to high
            StatusMessage "DTS Package " & strPackageName & " has wrong version number. Package skipped."
            Resume NextDTSPackage
        Case &H80045510     'Nonexistant database
            StatusMessage "Database " & vDatabases(j) & " does not exist. Resuming with next one."
            i = i - 1
            Resume NextDatabase
        Case Else           'Unanticipated error
            If bNoGUI Then
                If strCheckPoint = "databases" Then
                    StatusMessage "Error scripting database. Resuming with next one."
                    Resume NextDatabase
                Else
                    StatusMessage "Unanticipated error."
                    StatusMessage "Checkpoint: " & strCheckPoint
                    StatusMessage "Aborting program."
                    SaveLog strLogFile
                End If
            Else
                msgResult = MsgBox("An SQL-DMO error occurred. The error has been written to the log. " & _
                                   "Do you want to abort the program?" & vbNewLine & vbNewLine & _
                                   "Choose 'Abort' to abort the program, 'Retry' to retry the action that caused " & _
                                   "the error, or 'Ignore' to stop scripting this database and continue with " & _
                                   "the next one (if any). ", vbExclamation Or vbAbortRetryIgnore, "Error!")
                Select Case msgResult
                    Case vbAbort
                        Close #iFileNumber
                        StatusMessage "Program aborted by user."
                        SaveLog strLogFile
                        Unload frmMain
                    Case vbRetry
                        StatusMessage "Retrying..."
                        Resume
                    Case vbIgnore
                        Close #iFileNumber
                        If strCheckPoint = "databases" Then
                            StatusMessage "Ignoring error, resuming with next database."
                            Resume NextDatabase
                        Else
                            StatusMessage "Error cannot be ignored. Aborting program."
                            MsgBox "Sorry, unable to continue from this point. Program will be terminated instead.", _
                                   vbCritical, "Critical Error!"
                            SaveLog strLogFile
                            Unload frmMain
                        End If
                End Select
            End If
    End Select
End Sub

Private Sub Main()
    Dim vaSwitches As Variant, vTemp As Variant
    Dim strSwitch As String, strValue As String
    Dim i As Integer
    
    'Parse out the command-line parameters (if any)
    vaSwitches = Split(Command$, "/")
    On Error Resume Next
    For i = 1 To UBound(vaSwitches)
        vTemp = Split(CStr(vaSwitches(i)), "=")
        strSwitch = UCase$(Trim$(CStr(vTemp(0))))
        strValue = Trim$(CStr(vTemp(1)))
        Select Case strSwitch
            Case "S", "SERVER"                  'Servername
                strServerNameSW = strValue
            Case "U", "USER"                    'Login
                strLoginSW = strValue
            Case "P", "PW", "PASSWORD"          'Password
                strPasswordSW = strValue
            Case "DB", "DATABASE"               'Databases (comma-delimited list)
                vDatabasesSW = Split(strValue, ",")
            Case "DBA", "DBAOPTIONS"            'DBA Scriptiong options. "ALL" or any combination of A, D, L and J
                If UCase$(strValue) = "ALL" Then
                    bSaveDTSPackagesSW = True
                    bScriptAlertsSW = True
                    bScriptServerLoginsSW = True
                    bScriptAgentJobsSW = True
                    bScriptBackupDevicesSW = True
                Else
                    If InStr(UCase$(strValue), "D") > 0 Then bSaveDTSPackagesSW = True
                    If InStr(UCase$(strValue), "A") > 0 Then bScriptAlertsSW = True
                    If InStr(UCase$(strValue), "L") > 0 Then bScriptServerLoginsSW = True
                    If InStr(UCase$(strValue), "J") > 0 Then bScriptAgentJobsSW = True
                    If InStr(UCase$(strValue), "B") > 0 Then bScriptBackupDevicesSW = True
                End If
            Case "DEL"                          'Number of weeks to keep old files
                iDelWeeksSW = CInt(strValue)
                bDelOldFilesSW = True
            Case "DIR", "DEST", "DESTDIR"       'Destination directory for the scripts
                strDestDirSW = strValue
                If Right$(strDestDirSW, 1) <> "\" Then strDestDirSW = strDestDirSW & "\"
            Case "BG", "BACK", "BACKGROUND"
                bRunUnAttendedSW = True
        End Select
    Next i
    DoEvents
    'Determine if the program will be run unattended
    If (Len(strServerNameSW) = 0 Or Len(strDestDirSW) = 0) Or _
       (UBound(vDatabasesSW) = 0 And Not bRunUnAttendedSW) Then       'GUI
        bNoGUI = False
        frmMain.Show
    Else        'Unattended
        bNoGUI = True
        With objServer
            .Name = strServerNameSW
            .ApplicationName = App.Title
            DoEvents
            strLogFile = strDestDirSW & Format(Date, "yyyymmdd") & "." & objServer.Name & "_Log.txt"
            If Len(strLoginSW) > 0 Then
                .LoginSecure = False
                .Login = strLoginSW
                .Password = strPasswordSW
                StatusMessage "Using Login: " & strLoginSW
            Else
                .Login = ""
                .Password = ""
                .LoginSecure = True
                StatusMessage "Using Trusted Connection"
            End If
            On Error GoTo ErrHandler
            StatusMessage "Connecting to: " & objServer.Name
            .Connect
            DoEvents
            GenerateScripts strServerNameSW, strDestDirSW, vDatabasesSW, .LoginSecure, _
                            strLoginSW, strPasswordSW, bDelOldFilesSW, iDelWeeksSW, _
                            True, True, True, True, True, True, True, True, True, _
                            bSaveDTSPackagesSW, bScriptAlertsSW, bScriptAgentJobsSW, _
                            bScriptServerLoginsSW, bScriptBackupDevicesSW
            DoEvents
            SaveLog strLogFile
            .Close
            DoEvents
        End With
        Set objServer = Nothing
    End If
    Exit Sub
    
ErrHandler:
    StatusMessage "Error: 0x" & Hex$(Err.Number) & vbTab & Error(Err.Number)
    StatusMessage "Failed to connect to the server. Program aborted."
    SaveLog strLogFile
End Sub