Check DB into VSS

'===============================================================================
'- generate scripts to rebuild all objects in [SQL server name]/[SQL database name]
'- check scripts into SourceSafe whenever current script is different than VSS's
'
'Revisions: When, Who, Why
' 03/20/2001    Rich Cowley (cowley_rich@hotmail.com)   Original Version
' 20 May 2004   Dave Jackson - extended & converted to VBScript
'
' Instructions.
' To use this script, you need to create a project in VSS & create sub projects.
' You then need to edit the CONST declarations below to reflect the Top level project.
' 
' example
' -/$
'   |-Production
'         |-Databases
'               |-local
'                   |-pubs
'                       |-Defaults
'                       |-Rules
'                       |-StoredProcedures 
'                       |-Tables 
'                       |-UserDefinedDataTypes 
'                       |-UserDefinedFunctions 
'                       |-Views 
'
' 
' If you create the structure above, this script will script off the pubs db 'out of the box'
' 
Option Explicit
'  =====================================================================  Start of changes you need to make.
'General Constants
Const SCRIPT_DIRECTORY       = "C:\VSSUtils\WorkingDirectory\CheckInNewSQLDDL\pubs2"  'Working directory on local machine

'SourceSafe Constants
Const VSS_ROOTPROJECT_NAME   = "$/Production/Databases/"   'VSS Path to DB Objects Root
Const VSS_SUBPROJECT_NAME    = "local/pubs/"               'VSS Path (appended to above)
Const VSS_INI_PATH           = "C:\Program Files\Microsoft Visual Studio\Common\VSS\srcsafe.ini"  'Path to srcsafe.ini
Const VSS_USERNAME           = "admin"  'VSS User
Const VSS_PASSWORD           = ""       'VSS Password

'SQL DMO Constants
Const SQL_SERVERNAME         = "(local)"  'the name of your SQL Server
Const SQL_DBNAME             = "pubs"     'the Database you want to store in VSS

'  =====================================================================  End of changes you need to make.

Const SQLDMOScript_Default = 4
Const SQLDMOScript_Drops = 1
Const SQLDMOScript_Triggers = 16
Const SQLDMOScript_Indexes = 73736

'FileSystemObject constants
Const ForReading = 1
Const ForWriting = 2

Dim oSQLServer      'As SQLDMO.SQLServer2
Dim oDatabase       'As SQLDMO.Database2
Dim oDatabaseObject
Dim sScript         'As String
Dim oFSO            'As Scripting.FileSystemObject
Dim oFolder         'As Folder
Dim oFile           'As File
Dim oTS             'As Scripting.TextStream
Dim sCurrDirectory  'As String
Dim sFileName       'As String
Dim i               'As Integer
Dim iScriptOptions  'As Integer
Dim sObjectType     'As String

Dim oVSSDatabase    'As SourceSafeTypeLib.VSSDatabase
Dim oVSSItem        'As VSSItem
Dim sVSSItemPath    'As String
Dim sVSSLabel       'As String 'label used when checking items back in
Dim sCheckedScript  'As String

Dim sTempScript1    'As String
Dim sTempScript2    'As String
Dim itemCounter     'As Integer

    '=======================
    'Script every object in the database (tables, views, SPs, etc.)
    'If current script is different than SourceSafe's, check in new version.
    'Add new SourceSafe item if current script was not on SourceSafe to begin with.
    '=======================

    'set up SourceSafe environment
    Set oVSSDatabase = ImportObject("SourceSafe")
    oVSSDatabase.Open VSS_INI_PATH, VSS_USERNAME, VSS_PASSWORD
    'Set counter up
    itemCounter = 0
    'establish SQL Server and FSO environments
    Set oSQLServer = ImportObject("SQLDMO.SQLServer2")
    oSQLServer.LoginSecure = True
    oSQLServer.Connect SQL_SERVERNAME

    Set oDatabase = oSQLServer.Databases(SQL_DBNAME)
    Set oFSO = wScript.CreateObject("Scripting.FileSystemObject")

    '--------
    'Get all objects
    '--------
    GetObjects("Tables")
    GetObjects("Views")
    GetObjects("StoredProcedures")
    GetObjects("Rules")
    GetObjects("Defaults")
    GetObjects("UserDefinedDatatypes")
    GetObjects("UserDefinedFunctions")

    '--------
    'clean up
    '--------
    oSQLServer.Close
    Set oSQLServer = Nothing
    Set oDatabase = Nothing

    Set oVSSItem = Nothing
    Set oVSSDatabase = Nothing
    
    'toss the working sub folders
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\Tables", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\Views", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\StoredProcedures", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\Defaults", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\Rules", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\UserDefinedDataTypes", True
    oFSO.DeleteFolder SCRIPT_DIRECTORY & "\UserDefinedFunctions", True

    Set oFSO = Nothing
    Set oFolder = Nothing
    Set oFile = Nothing
    Set oTS = Nothing
    On Error Goto 0
    'process complete!
    Dim WshShell
    Set WshShell = WScript.CreateObject("WScript.Shell")

    i = WshShell.Popup (itemCounter & " SQL Objects successfully rolled to SourceSafe.", 10, "VSS autorun DB Objects", 64)
    Set WshShell = Nothing

'----------------------------------------------------------------------
Sub GetObjects(byVal objType)
'----------------------------------------------------------------------
    sObjectType = objType
    sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/"
    Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
    'set up clean working directory
    sCurrDirectory = SCRIPT_DIRECTORY & "\" & sObjectType
    'Make sure working folder exists
    MakeSureDirectoryTreeExists(sCurrDirectory)
    'On Error Resume Next
    If oFSO.FolderExists(sCurrDirectory) Then
        oFSO.DeleteFolder sCurrDirectory, True
    End If
    Set oFolder = oFSO.CreateFolder(sCurrDirectory)

    'cycle through the objects
    Select Case objType
            Case "Tables"
                For Each oDatabaseObject In oDatabase.Tables
                    If oDatabaseObject.SystemObject Then
                        'do nothing (bypass system objects)
                    Else
                        iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops + SQLDMOScript_Triggers + SQLDMOScript_Indexes
                        sScript = oDatabaseObject.Script(iScriptOptions)
                        sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                        sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                        On Error Resume Next
                        Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                        If Err = 0 Then 'item is already on SourceSafe
                            oVSSItem.Checkout "Checked out by automated process", sFileName
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.WriteLine (sScript)
                            oTS.Close
                            oVSSItem.Checkin "Schema Altered", sFileName
                            itemCounter = itemCounter + 1
                        Else 'item does not yet exist on SourceSafe; add it
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.Write (sScript)
                            oTS.Close
                            Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                            oVSSItem.Add sFileName
                            itemCounter = itemCounter + 1
                        End If
                        Set oVSSItem = Nothing
                    End If
                Next

            Case "Views"
                For Each oDatabaseObject In oDatabase.Views
                    If oDatabaseObject.SystemObject Then
                        'do nothing (bypass system objects)
                    Else
                        iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops + SQLDMOScript_Triggers + SQLDMOScript_Indexes
                        sScript = oDatabaseObject.Script(iScriptOptions)
                        sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                        sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                        On Error Resume Next
                        Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                        If Err = 0 Then 'item is already on SourceSafe
                            oVSSItem.Checkout "Checked out by automated process", sFileName
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.WriteLine (sScript)
                            oTS.Close
                            oVSSItem.Checkin "Schema Altered", sFileName
                            itemCounter = itemCounter + 1
                        Else 'item does not yet exist on SourceSafe; add it
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.Write (sScript)
                            oTS.Close
                            Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                            oVSSItem.Add sFileName
                            itemCounter = itemCounter + 1
                        End If
                        Set oVSSItem = Nothing
                    End If
                Next

            Case "StoredProcedures"
                For Each oDatabaseObject In oDatabase.StoredProcedures
                    If oDatabaseObject.SystemObject Then
                        'do nothing (bypass system objects)
                    Else
                        iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops
                        sScript = oDatabaseObject.Script(iScriptOptions)
                        sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                        sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                        On Error Resume Next
                        Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                        If Err = 0 Then 'item is already on SourceSafe
                            oVSSItem.Checkout "Checked out by automated process", sFileName
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.WriteLine (sScript)
                            oTS.Close
                            oVSSItem.Checkin "Schema Altered", sFileName
                            itemCounter = itemCounter + 1
                        Else 'item does not yet exist on SourceSafe; add it
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.Write (sScript)
                            oTS.Close
                            Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                            oVSSItem.Add sFileName
                            itemCounter = itemCounter + 1
                        End If
                        Set oVSSItem = Nothing
                    End If
                Next

            Case "Defaults"
                For Each oDatabaseObject In oDatabase.Defaults
                        iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops
                        sScript = oDatabaseObject.Script(iScriptOptions)
                        sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                        sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                        On Error Resume Next
                        Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                        If Err = 0 Then 'item is already on SourceSafe
                            oVSSItem.Checkout "Checked out by automated process", sFileName
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.WriteLine (sScript)
                            oTS.Close
                            oVSSItem.Checkin "Schema Altered", sFileName
                            itemCounter = itemCounter + 1
                        Else 'item does not yet exist on SourceSafe; add it
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.Write (sScript)
                            oTS.Close
                            Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                            oVSSItem.Add sFileName
                            itemCounter = itemCounter + 1
                        End If
                        Set oVSSItem = Nothing
                Next

            Case "Rules"
                For Each oDatabaseObject In oDatabase.Rules
                    If oDatabaseObject.SystemObject Then
                        'do nothing (bypass system objects)
                    Else
                        iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops
                        sScript = oDatabaseObject.Script(iScriptOptions)
                        sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                        sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                        On Error Resume Next
                        Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                        If Err = 0 Then 'item is already on SourceSafe
                            oVSSItem.Checkout "Checked out by automated process", sFileName
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.WriteLine (sScript)
                            oTS.Close
                            oVSSItem.Checkin "Schema Altered", sFileName
                            itemCounter = itemCounter + 1
                        Else 'item does not yet exist on SourceSafe; add it
                            Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                            oTS.Write (sScript)
                            oTS.Close
                            Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                            oVSSItem.Add sFileName
                            itemCounter = itemCounter + 1
                        End If
                        Set oVSSItem = Nothing
                    End If
                Next

            Case "UserDefinedDataTypes"
                For Each oDatabaseObject In oDatabase.UserDefinedDataTypes
                    iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops
                    sScript = oDatabaseObject.Script(iScriptOptions)
                    sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                    sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                    On Error Resume Next
                    Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                    If Err = 0 Then 'item is already on SourceSafe
                        oVSSItem.Checkout "Checked out by automated process", sFileName
                        Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                        oTS.WriteLine (sScript)
                        oTS.Close
                        oVSSItem.Checkin "Schema Altered", sFileName
                        itemCounter = itemCounter + 1
                    Else 'item does not yet exist on SourceSafe; add it
                        Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                        oTS.Write (sScript)
                        oTS.Close
                        Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                        oVSSItem.Add sFileName
                        itemCounter = itemCounter + 1
                    End If
                    Set oVSSItem = Nothing
                Next

            Case "UserDefinedFunctions"
                For Each oDatabaseObject In oDatabase.UserDefinedFunctions
                    iScriptOptions = SQLDMOScript_Default + SQLDMOScript_Drops
                    sScript = oDatabaseObject.Script(iScriptOptions)
                    sVSSItemPath = VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/" & oDatabaseObject.Name & ".sql"
                    sFileName = sCurrDirectory & "\" & oDatabaseObject.Name & ".sql"
                    On Error Resume Next
                    Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
                    If Err = 0 Then 'item is already on SourceSafe
                        oVSSItem.Checkout "Checked out by automated process", sFileName
                        Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                        oTS.WriteLine (sScript)
                        oTS.Close
                        oVSSItem.Checkin "Schema Altered", sFileName
                        itemCounter = itemCounter + 1
                    Else 'item does not yet exist on SourceSafe; add it
                        Set oTS = oFSO.OpenTextFile(sFileName, ForWriting, True)
                        oTS.Write (sScript)
                        oTS.Close
                        Set oVSSItem = oVSSDatabase.VSSItem(VSS_ROOTPROJECT_NAME & VSS_SUBPROJECT_NAME & sObjectType & "/")
                        oVSSItem.Add sFileName
                        itemCounter = itemCounter + 1
                    End If
                    Set oVSSItem = Nothing
                Next

        End Select
End Sub

'----------------------------------------------------------------------
Function ImportObject(sClass)
'----------------------------------------------------------------------
' PURPOSE: Given a classname, this function will:
' + return a reference to the object
' + Import Typelib constants into global namespace
' DEPENDENCY: TLBINF32.DLL must be present and registered
' Derived from Michael Harris' Typelib extraction HTA
' WARNING: Some TLBs contain hundreds of constants!
' Alex K. Angelopoulos posted this on 10/31/02.
'
'Sample usage:
'<CODE>
'Set objIE = ImportObject("InternetExplorer.Application")
'</CODE>
'which is identical to the following code lines, except that
' all approximately 80 constants are defined.
'<CODE>
'Set objIE = CreateObject("InternetExplorer.Application")
'CONST CSC_UPDATECOMMANDS = -1
' ... many more CONST statements
'CONST SWFO_COOKIEPASSED = 4
'</CODE>
'
' Edited and modified to allow repeated calls with
'   the same class.   Paul Randall 11/21/02

Dim objTLIA   'TypeLib Info Application; TLBinf32.dll
Dim objTLII   'TypeLib Interface Info object for the parent of
      ' the object created from the specified class.
      ' Contains a collection of enumeration objects
Dim objCEnum  'One of the enumeration objects
      ' Contains a collection of constant objects
Dim objConstant 'One constant object in the enumeration object
Dim objObject  'The object specified by the class string passed
      ' to this routine.

'strMsg for obtaining the list of constants and their values
Dim strMsg   'List of constants and their values
strMsg = "Typelib constants for: " & sClass & vbcrlf & vbcrlf

Set objObject = CreateObject(sClass)
Set objTLIA = CreateObject("TLI.TLIApplication")
Set objTLII = objTLIA.InterfaceInfoFromObject(objObject).Parent
For Each objCEnum in objTLII.Constants
 ' We only want them if they are visible
 If Left(objCEnum.Name, 1)<>"_" Then
  strMsg = strMsg & "EnumName: " & objCEnum.Name & _
   " contains " & objCEnum.Members.count & " items." & vbcrlf
  For Each objConstant In objCEnum.Members
   strMsg = strMsg & objConstant.name & " = " & objConstant.value & vbcrlf
   On Error Resume Next
   ExecuteGlobal "CONST " & objConstant.Name & "=" & objConstant.Value
   if Err.Number = 1041 then
    if eval(objConstant.Name & "=" & objConstant.Value) then
     'Ignore unchanged values
    else
     MsgBox "Unexpected new value for TypeLib constant" & vbcrlf & _
      "in Function ImportObject(" & sClass & ")" & vbcrlf & _
      "Constant name = " & objConstant.Name & vbcrlf & _
      "Old value = " & eval(objConstant.Name) & vbcrlf & _
      "New value = " & objConstant.Value & vbcrlf & _
      vbcrlf & "Quitting"
     WScript.Quit
    end if
   elseif Err.Number <> 0 then
    MsgBox "Unexpected error in " & _
     "Function ImportObject(" & sClass & ")" & vbcrlf & _
     "Error Number = " & Err.Number & vbcrlf & _
     "Error Description = " & Err.Description & vbcrlf & _
     "Error Source = " & Err.Source & vbcrlf & _
     vbcrlf & "Quitting"
    WScript.Quit
   end if
   On Error GoTo 0
  Next
 else
  strMsg = strMsg & "EnumName: " & objCEnum.Name & _
   " contains " & objCEnum.Members.count & " hidden items." & vbcrlf
 End If
Next
' WriteFile "C:\LogFile.txt", strMsg
Set ImportObject = objObject
End Function

'----------------------------------------------------------------------
Function MakeSureDirectoryTreeExists(dirName)
'----------------------------------------------------------------------
'like it says on the tin
    Dim aFolders, newFolder, i

   ' Check the folder's existence
   If Not oFSO.FolderExists(dirName) Then
      ' Split the various components of the folder's name
      aFolders = split(dirName, "\")

      ' Get the root of the drive
      newFolder = oFSO.BuildPath(aFolders(0), "\")

      ' Scan the various folder and create them
      For i = 1 To UBound(aFolders)
         newFolder = oFSO.BuildPath(newFolder, aFolders(i))

         If Not oFSO.FolderExists(newFolder) Then
            oFSO.CreateFolder newFolder
         End If
      Next
   End If
End Function