DB to VSS V2

,

This is an update/improved version of my script that I'm pleased to see is rated in the top 10! It will script off all of your objects in your database and if they differ from the scripted version in your VSS db, automatically check it in. If the object does not exist in VSS, this script creates it. I use it to make ensure if code gets overwritten, I have the previous version.

V2 of this VBScript is now called from a batch file, so you can pass in the required parameters instead of having to hack to the script about. Save the script as dbtovss2.vbs and follow the instructions in the comments at the top of the script.

I have amended the comments at the top of the script to include instructions on how to register TLBINF32.DLL

'===============================================================================
'- 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 at hotmail.com)   Original Version
'
' V.1
' Extensivley Modified to be a VB Script (was a VB BAS module)
' David Jackson
'
' V.2
' Changed to takes parameters instead of hardcoded server names &tc.
' David Jackson
'
' V2.1
' Fixed bug where was passing in VSS_ROOTPROJECT_NAME instead of SCRIPT_DIRECTORY to 
' MakeSureDirectoryTreeExists function
' David Jackson - 14:24 21/10/2004
'
' Instructions.
' To use this script, you need to create a project in VSS & create various sub projects.
' 
'       -/$
'         |-Databases
'               |-pubs
'                   |-Defaults
'                   |-Rules
'                   |-StoredProcedures 
'                   |-Tables 
'                   |-UserDefinedDataTypes 
'                   |-UserDefinedFunctions 
'                   |-Views 
'
'
' You then need to create a batch file to pass in the required parameters.
'
'	@Echo Off
'	::SQLServer1
'	cscript dbtovss2.vbs -w C:\Temp\pubs -r $/Databases/pubs/ -i \\VSSServer\VSS\Data\srcsafe.ini -u Admin -p secret -s SQLServer1 -d pubs
'	::call it again for a different SQL db
'	cscript dbtovss2.vbs -w C:\Temp\dbname2 -r $/Databases/dbname2/ -i \\VSSServer\VSS\Data\srcsafe.ini -u Admin -p secret -s SQLServer1 -d dbname2
'	::End of Batch file
'
' This  needs to run on a PC with both a VSS & SQL client installed, as well as having TLBINF32.DLL registered. 
' To register TLBINF32.DLL, open a command line in the folder you have copied TLBINF32.DLL to and type:
'
' Regsvr32 TLBINF32.DLL
'

' TLBINF32.DLL is shipped on the Visual Studio 6.0 and Visual Basic 6.0 CDs.  
' According to Microsoft it is redistributable,
' so look for it at http://glossopian.co.uk/Uploads/Main/TLBINF32.zip.
'
' If you create the structure above, this script will script off the pubs db 'out of the box'
'
'============================================================================================
Option Explicit

Dim SCRIPT_DIRECTORY, VSS_ROOTPROJECT_NAME, VSS_INI_PATH, VSS_USERNAME, VSS_PASSWORD, SQL_SERVERNAME, SQL_DBNAME
'General Constants
SCRIPT_DIRECTORY       = GetArgs( "w", "C:\Temp" ) 'working directory on local machine

'SourceSafe Constants
VSS_ROOTPROJECT_NAME   = GetArgs( "r", "$/Databases/pubs/" )
VSS_INI_PATH           = GetArgs( "i", "C:\Program Files\Microsoft Visual Studio\Common\VSS\srcsafe.ini" )
VSS_USERNAME           = GetArgs( "u", "Admin" )
VSS_PASSWORD           = GetArgs( "p", "Secret" )

'SQL DMO Constants
SQL_SERVERNAME         = GetArgs( "s", "(local)" )
SQL_DBNAME             = GetArgs( "d", "pubs" )

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

'FileSystemObject constants
Const ForReading = 1
Const ForWriting = 2

MakeSureDirectoryTreeExists(SCRIPT_DIRECTORY)

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 in 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 folders
    oFSO.DeleteFolder SCRIPT_DIRECTORY, 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 & sObjectType & "/"
            Set oVSSItem = oVSSDatabase.VSSItem(sVSSItemPath)
            'set up clean working directory
            sCurrDirectory = SCRIPT_DIRECTORY & "\" & sObjectType
            '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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 GetArgs( sSwitch, sDefaultValue )
'-----------------------------------------------------
' Checks the command line arguments for a given switch and returns the associated
' string, if found. If not found, the defaultValue is returned instead.
dim ArgCount, bMatch
ArgCount = 0
bMatch = 0
do while ArgCount < WScript.arguments.length
    if Eval((WScript.arguments.item(ArgCount)) = ("-" + (sSwitch))) Or Eval((WScript.arguments.item(ArgCount)) = ("/" + (sSwitch))) then
        bMatch = 1
        Exit do
    else
        ArgCount = ArgCount + 1
    end if
Loop
if ( bMatch = 1 ) then
        GetArgs = ( WScript.arguments.item(ArgCount + 1) )
    else
        GetArgs = ( sDefaultValue )
end if

End Function
    
'----------------------------------------------------------------------
Function MakeSureDirectoryTreeExists(dirName)
'----------------------------------------------------------------------
'like it says on the tin
    Dim aFolders, newFolder, i
    Dim oFS
    
    Set oFS = CreateObject("Scripting.FileSystemObject")

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

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

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

         If Not oFS.FolderExists(newFolder) Then
            oFS.CreateFolder newFolder
         End If
      Next
   End If
       Set oFS = Nothing
End Function

Rate

Share

Share

Rate