Introduction
I was once involved in a VSS 6.0 migration to TFS for hundreds of applications. Due to the quantities of applications, I thought manual migration one app by one app is tedious and prone to errors. Hence I wrote some codes to assist with the work.
Background
In my case, use of VSS 6.0 has been a long time. There are many checkouts left there. Some developers even forget what files they have checked out. Some files are checked out even by developers who are gone. So I have to write codes to list the checked files and send the list to related developers, or have the
administrator do something for the files checked out by developers who left the company.
Using the code
The codes are listed as follows:
Imports System.IO
Imports System.Text
Imports System.Xml
Imports System.Collections.ObjectModel
Imports SourceSafeTypeLib
Imports EnvDTE
Imports Microsoft.TeamFoundation.Server
Imports Microsoft.TeamFoundation.Client
Imports Microsoft.TeamFoundation.Framework.Common
Imports Microsoft.TeamFoundation.Framework.Client
Imports Microsoft.TeamFoundation.VersionControl.Common
Imports Microsoft.TeamFoundation.VersionControl.Client
Module VssTfsMigration
Dim vssDatabasePathName As String = "C:\My\VSS\srcsafe.ini"
Dim vssDatabaseName As String = "VSS"
Dim vssLogin As String = "sliu"
Dim vssPwd As String = "sliu"
Dim tfs As TfsTeamProjectCollection = Nothing
Dim tfsUri As Uri = New Uri("http://TeamServer:8181/tfs")
Dim tfsCollectionName As String = "CompanyTFSSourceCodes"
Dim tfsWorkspacePath As String = "C:\temp"
Dim tfsWorkspaceOwnerName As String = "scott liu"
Dim tfsWorkspaceComputerName As String = Environment.MachineName
Dim analyzeSettingsFilePathName As String = "C:\My\VSS\_migration\analyzeSettings.xml"
Dim analyzeOutputFilePathName As String = "C:\My\VSS\_migration\logs\vssAnalyzeResults.xml"
Dim migrationSettingsFilePathName As String = "C:\My\VSS\_migration\migrateSettings.xml"
Dim migrationUserMapFilePathName As String = "C:\My\VSS\_migration\UserMap.xml"
Dim migrationOutputFilePathName As String = "C:\My\VSS\_migration\logs\vssMigrationResults.xml"
Dim teamProjectXmlFileFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
Dim migrationSqlServerInstanceName As String = "scott-liu"
Sub Main()
End Sub
Sub CreateTeamProject(projectNames As List(Of String))
Dim studio As DTE = Nothing
Dim processTemplateName As String = "MSF for Agile Software Development 6.0″
Dim batchProjectFileSpec As String = vbEmpty
If (tfs Is Nothing) OrElse (tfs.Uri.AbsoluteUri.ToLower <> tfsUri.AbsoluteUri.ToLower) Then
tfs = TfsTeamProjectCollectionFactory.GetTeamProjectCollection(tfsUri)
End If
Try
If studio Is Nothing Then
Const VS_DTE_ID As String = "VisualStudio.DTE.11.0″ Dim typeDTE As Type = Type.GetTypeFromProgID(VS_DTE_ID)
studio = DirectCast(Activator.CreateInstance(typeDTE, True), DTE)
If (studio Is Nothing) OrElse (studio.DTE Is Nothing) Then
Throw New InvalidOperationException(studio.FullName & " not available")
End If
End If
For Each projectName As String In projectNames
batchProjectFileSpec = WriteTeamProjectXmlFile(tfsUri.ToString() + _
"/" + tfsCollectionName, projectName, teamProjectXmlFileFolder, Path.GetTempPath)
If Not String.IsNullOrEmpty(batchProjectFileSpec) And Not ProjectExists(projectName) Then
Console.WriteLine("Creating project {0} …", projectName)
studio.ExecuteCommand("View.TfsTeamExplorer")
studio.ExecuteCommand("File.BatchNewTeamProject", batchProjectFileSpec)
CreateTfsWorkspace(projectName, tfsWorkspaceOwnerName, tfsWorkspaceComputerName)
End If
Next
Catch ex As Exception
Console.Write(ex.Message)
Console.Read()
Finally
If Not studio Is Nothing Then
studio.Quit()
End If
End Try
Console.WriteLine("Done. Please check to make sure team project(s) created successfully.")
Console.ReadLine()
End Sub
Function ProjectExists(sProjectName As String) As Boolean
Dim bExists As Boolean
Dim configurationServer As New TfsConfigurationServer(tfsUri)
configurationServer = TfsConfigurationServerFactory.GetConfigurationServer(tfsUri)
Dim collectionNodes As ReadOnlyCollection(Of CatalogNode)
Dim gVar As Guid() = New Guid() {CatalogResourceTypes.ProjectCollection}
collectionNodes = configurationServer.CatalogNode.QueryChildren(gVar, False, CatalogQueryOptions.None)
For Each collectionNode In collectionNodes
Dim collectionId As Guid = New Guid(collectionNode.Resource.Properties("InstanceID"))
Dim teamProjectCollection As New TfsTeamProjectCollection(tfsUri)
teamProjectCollection = configurationServer.GetTeamProjectCollection(collectionId)
Dim hVar As Guid() = New Guid() {CatalogResourceTypes.TeamProject}
Dim projectNodes As ReadOnlyCollection(Of CatalogNode)
projectNodes = collectionNode.QueryChildren(hVar, False, CatalogQueryOptions.None)
For Each projectNode In projectNodes
If projectNode.Resource.DisplayName = sProjectName Then
bExists = True
Console.WriteLine("Project {0} exists in TFS. ", sProjectName)
Exit For
End If
Next
If bExists Then Exit For
Next
Return bExists
End Function
Sub CreateTfsWorkspace(projectName As String, sWorkspaceOwnerName As String, _
sWorkspaceComputerName As String, Optional bGetSourceFiles As Boolean = False, _
Optional bCreate As Boolean = True)
Dim ws As Workspace
Dim configurationServer As New TfsConfigurationServer(tfsUri)
configurationServer = TfsConfigurationServerFactory.GetConfigurationServer(tfsUri)
If tfsWorkspacePath.EndsWith(Path.DirectorySeparatorChar) Then
tfsWorkspacePath.TrimEnd(Path.DirectorySeparatorChar)
End If
Dim collectionNodes As ReadOnlyCollection(Of CatalogNode)
Dim gVar As Guid() = New Guid() {CatalogResourceTypes.ProjectCollection}
collectionNodes = configurationServer.CatalogNode.QueryChildren(gVar, False, CatalogQueryOptions.None)
For Each collectionNode In collectionNodes
Dim collectionId As Guid = New Guid(collectionNode.Resource.Properties("InstanceID"))
Dim teamProjectCollection As New TfsTeamProjectCollection(tfsUri)
teamProjectCollection = configurationServer.GetTeamProjectCollection(collectionId)
Dim hVar As Guid() = New Guid() {CatalogResourceTypes.TeamProject}
Dim projectNodes As ReadOnlyCollection(Of CatalogNode)
projectNodes = collectionNode.QueryChildren(hVar, False, CatalogQueryOptions.None)
For Each projectNode In projectNodes
Dim projName As String = projectNode.Resource.DisplayName
If Not projectName.Equals(projName) Then Continue For
Try
Dim tfsProjecCollection As TfsTeamProjectCollection
tfsProjecCollection = TfsTeamProjectCollectionFactory.GetTeamProjectCollection(tfsUri)
Dim vcs As VersionControlServer = tfsProjecCollection.GetService(Of VersionControlServer)()
Dim repository As String = "$/" + projectName
Dim wsParams As CreateWorkspaceParameters = New CreateWorkspaceParameters(projectName)
wsParams.Location = WorkspaceLocation.Server
wsParams.PermissionProfile = _
WorkspacePermissionProfile.BuiltInProfiles(CInt(WorkspacePermissionProfile.BuiltInIndexes.Public))
wsParams.OwnerName = sWorkspaceOwnerName
wsParams.Computer = sWorkspaceComputerName
If bCreate Then
ws = vcs.CreateWorkspace(wsParams)
Dim ws_folder As WorkingFolder = New WorkingFolder(repository, _
tfsWorkspacePath + Path.DirectorySeparatorChar + projectName)
ws.CreateMapping(ws_folder)
If bGetSourceFiles Then
Console.WriteLine(projectName + ": Getting Files.")
ws.Get()
Console.WriteLine("Done Getting Files of Project " + projectName)
End If
Else
Dim wss As Workspace() = _
vcs.QueryWorkspaces(projectName, wsParams.OwnerName, wsParams.Computer)
For Each w As Workspace In wss
Console.WriteLine("Deleting workspace {0} …", w.Name)
w.Delete()
Next
End If
Catch ex As Exception
Console.WriteLine("Exception Encountered: ")
Console.Write(ex.Message + "\n")
Finally
If Not ws Is Nothing Then
End If
End Try
Next
Next
Console.WriteLine("Done Creating Workspace.")
Console.ReadLine()
End Sub
Sub CreateTfsWorkspaces()
Dim configurationServer As New TfsConfigurationServer(tfsUri)
configurationServer = TfsConfigurationServerFactory.GetConfigurationServer(tfsUri)
If tfsWorkspacePath.EndsWith(Path.DirectorySeparatorChar) Then
tfsWorkspacePath.TrimEnd(Path.DirectorySeparatorChar)
End If
Dim collectionNodes As ReadOnlyCollection(Of CatalogNode)
Dim gVar As Guid() = New Guid() {CatalogResourceTypes.ProjectCollection}
collectionNodes = _
configurationServer.CatalogNode.QueryChildren(gVar, False, CatalogQueryOptions.None)
For Each collectionNode In collectionNodes
Dim collectionId As Guid = New Guid(collectionNode.Resource.Properties("InstanceID"))
Dim teamProjectCollection As New TfsTeamProjectCollection(tfsUri)
teamProjectCollection = configurationServer.GetTeamProjectCollection(collectionId)
Dim hVar As Guid() = New Guid() {CatalogResourceTypes.TeamProject}
Dim projectNodes As ReadOnlyCollection(Of CatalogNode)
projectNodes = collectionNode.QueryChildren(hVar, False, CatalogQueryOptions.None)
For Each projectNode In projectNodes
CreateTfsWorkspace(projectNode.Resource.DisplayName, _
tfsWorkspaceOwnerName, tfsWorkspaceComputerName)
Next
Next
Console.WriteLine("Done Creating Workspaces.")
Console.ReadLine()
End Sub
Function GetVssProjects() As List(Of String)
Dim vssDatabase As New VSSDatabase
vssDatabase.Open(vssDatabasePathName, vssLogin, vssPwd)
Dim vssFolder As IVSSItem = vssDatabase.VSSItem("$/", False)
Dim projects As New List(Of String)
Dim items As IVSSItems = vssFolder.Items(False)
Dim item As IVSSItem
For Each item In items
If item.Type = VSSItemType.VSSITEM_PROJECT Then projects.Add(item.Name)
Console.WriteLine(item.Name)
End If
Next
Console.WriteLine("Press Enter to continue …")
Console.Read()
GetVssProjects = projects
End Function
Sub GetCheckouts()
Dim vssDatabase As New VSSDatabase
vssDatabase.Open(vssDatabasePathName, vssLogin, vssPwd)
Dim vssFolder As IVSSItem = vssDatabase.VSSItem("$/", False)
Dim item As IVSSItem
Dim checkoutItems As New StringBuilder
For Each item In vssFolder.Items
If item.Type = VSSItemType.VSSITEM_PROJECT Then
GetCheckoutItems(item, checkoutItems)
End If
Next
SaveTextToFile(checkoutItems.ToString())
Console.Write("finished")
Console.Read()
End Sub
Private Sub GetCheckoutItems(item As IVSSItem, ByRef checkoutItems As StringBuilder)
Dim subitem As IVSSItem
For Each subitem In item.Items
If subitem.Type = VSSItemType.VSSITEM_FILE Then
If subitem.IsCheckedOut = VSSFileStatus.VSSFILE_CHECKEDOUT Or _
subitem.IsCheckedOut = VSSFileStatus.VSSFILE_CHECKEDOUT_ME Then
Dim checkouts As IVSSCheckouts
Dim checkout As IVSSCheckout
checkouts = subitem.Checkouts
Dim sProjectName As String = "", sUserName As String = "", dDate As Date
For Each checkout In checkouts
sProjectName = checkout.Project
sUserName = checkout.Username
dDate = checkout.Date
Next
Console.WriteLine(sUserName + "," + subitem.Spec + "," + dDate)
checkoutItems.AppendLine(sUserName + "," + subitem.Spec + "," + dDate)
End If
ElseIf subitem.Type = VSSItemType.VSSITEM_PROJECT Then
GetCheckoutItems(subitem, checkoutItems)
End If
Next
End Sub
Sub SaveTextToFile(ByVal data As String)
Dim mydocpath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
Using outfile As StreamWriter = New StreamWriter(mydocpath + "\checkouts.txt", True)
outfile.Write(data)
End Using
End Sub
Function WriteTeamProjectXmlFile(tfsCollection As String, _
sProjectName As String, xmlFileFolderPath As String, _
logFolderPath As String) As String
Dim settings As XmlWriterSettings = New XmlWriterSettings()
settings.OmitXmlDeclaration = False
settings.ConformanceLevel = ConformanceLevel.Document
settings.CloseOutput = False
settings.Indent = True
If xmlFileFolderPath.EndsWith(Path.DirectorySeparatorChar) Then
xmlFileFolderPath = xmlFileFolderPath.TrimEnd(Path.DirectorySeparatorChar)
End If
If logFolderPath.EndsWith(Path.DirectorySeparatorChar) Then
logFolderPath = logFolderPath.TrimEnd(Path.DirectorySeparatorChar)
End If
Dim strm As MemoryStream = New MemoryStream()
Dim writer As XmlWriter = XmlWriter.Create(strm, settings)
writer.WriteStartDocument()
writer.WriteStartElement("Project")
writer.WriteStartElement("TFSName")
writer.WriteString(tfsCollection)
writer.WriteEndElement()
writer.WriteStartElement("LogFolder")
writer.WriteString(logFolderPath)
writer.WriteEndElement()
writer.WriteStartElement("ProjectName")
writer.WriteString(sProjectName)
writer.WriteEndElement()
writer.WriteStartElement("ProjectSiteEnabled")
writer.WriteString("true")
writer.WriteEndElement()
writer.WriteStartElement("ProjectSiteTitle")
writer.WriteString(sProjectName)
writer.WriteEndElement()
writer.WriteStartElement("ProjectSiteDescription")
writer.WriteString(sProjectName + " Project")
writer.WriteEndElement()
writer.WriteStartElement("SccCreateType")
writer.WriteString("New")
writer.WriteEndElement()
writer.WriteStartElement("SccBranchFromPath")
writer.WriteString("")
writer.WriteEndElement()
writer.WriteStartElement("ProcessTemplateName")
writer.WriteString("MSF for Agile Software Development 6.0")
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndDocument()
writer.Flush()
writer.Close()
strm.Seek(0, SeekOrigin.Begin)
Dim ns As XNamespace = "ProjectCreationSettingsFileSchema.xsd"
Dim xDoc As XDocument = XDocument.Load(strm)
strm.Close()
For Each node As XElement In xDoc.Descendants
node.Name = ns + node.Name.LocalName
Next
Dim batchProjectFileSpec As String = xmlFileFolderPath + _
Path.DirectorySeparatorChar + sProjectName + ".xml"
xDoc.Save(batchProjectFileSpec)
Return batchProjectFileSpec
End Function
Sub WriteMigrationSettingsXmlFile(tfsUri As Uri, tfsCollection As String, _
migrationSettingsFilePath As String, migrationOutputFilePath As String, _
Optional userMapFilePath As String = vbNullString)
Dim settings As XmlWriterSettings = New XmlWriterSettings()
settings.OmitXmlDeclaration = False
settings.ConformanceLevel = ConformanceLevel.Document
settings.CloseOutput = False
settings.Indent = True
Dim vssProjects As List(Of String) = GetVssProjects()
Dim strm As MemoryStream = New MemoryStream()
Dim writer As XmlWriter = XmlWriter.Create(strm, settings)
writer.WriteStartDocument()
writer.WriteStartElement("SourceControlConverter")
writer.WriteStartElement("ConverterSpecificSetting")
writer.WriteStartElement("Source")
writer.WriteAttributeString("name", vssDatabaseName)
writer.WriteStartElement("VSSDatabase")
writer.WriteAttributeString("name", Path.GetDirectoryName(vssDatabasePathName))
writer.WriteEndElement()
writer.WriteStartElement("UserMap")
writer.WriteAttributeString("name", userMapFilePath)
writer.WriteEndElement()
writer.WriteStartElement("SQL")
writer.WriteAttributeString("Server", migrationSqlServerInstanceName)
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteStartElement("ProjectMap")
For Each project As String In vssProjects
writer.WriteStartElement("Project")
writer.WriteAttributeString("Source", "$/" + project)
writer.WriteAttributeString("Destination", "$/" + project)
writer.WriteEndElement()
Next
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteStartElement("Settings")
writer.WriteStartElement("TeamFoundationServer")
writer.WriteAttributeString("name", tfsUri.Host)
writer.WriteAttributeString("port", tfsUri.Port)
writer.WriteAttributeString("protocol", tfsUri.Scheme)
writer.WriteAttributeString("collection", _
tfsUri.AbsolutePath.Trim("/") + "/" + tfsCollectionName)
writer.WriteEndElement()
writer.WriteStartElement("Output")
writer.WriteAttributeString("file", migrationOutputFilePath)
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndDocument()
writer.Flush()
writer.Close()
strm.Position = 0
Dim xDoc As XDocument = XDocument.Load(strm)
strm.Close()
xDoc.Save(migrationSettingsFilePath)
End Sub
Sub WriteAnalyzeSettingsXmlFile(analyzeSettingsFilePath As String, _
analyzeOutputFilePath As String, userMapFilePath As String)
Dim settings As XmlWriterSettings = New XmlWriterSettings()
settings.OmitXmlDeclaration = False
settings.ConformanceLevel = ConformanceLevel.Document
settings.CloseOutput = False
settings.Indent = True
Dim strm As MemoryStream = New MemoryStream()
Dim writer As XmlWriter = XmlWriter.Create(strm, settings)
writer.WriteStartDocument()
writer.WriteStartElement("SourceControlConverter")
writer.WriteStartElement("ConverterSpecificSetting")
writer.WriteStartElement("Source")
writer.WriteAttributeString("name", vssDatabaseName)
writer.WriteStartElement("VSSDatabase")
writer.WriteAttributeString("name", Path.GetDirectoryName(vssDatabasePathName))
writer.WriteEndElement()
writer.WriteStartElement("UserMap")
writer.WriteAttributeString("name", userMapFilePath)
writer.WriteEndElement()
writer.WriteStartElement("SQL")
writer.WriteAttributeString("Server", migrationSqlServerInstanceName)
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteStartElement("ProjectMap")
writer.WriteStartElement("Project")
writer.WriteAttributeString("Source", "$/")
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteStartElement("Settings")
writer.WriteStartElement("Output")
writer.WriteAttributeString("file", analyzeOutputFilePath)
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndElement()
writer.WriteEndDocument()
writer.Flush()
writer.Close()
strm.Position = 0
Dim xDoc As XDocument = XDocument.Load(strm)
strm.Close()
xDoc.Save(analyzeSettingsFilePath)
End Sub
Sub AnalyzeBeforeMigration()
WriteAnalyzeSettingsXmlFile(analyzeSettingsFilePathName, _
analyzeOutputFilePathName, migrationUserMapFilePathName)
If File.Exists(migrationUserMapFilePathName) Then File.Delete(migrationUserMapFilePathName)
If File.Exists(analyzeOutputFilePathName) Then File.Delete(analyzeOutputFilePathName)
Console.WriteLine("Now please open a new cmd window …")
Console.WriteLine("And type in cd /d ""C:\Program Files (x86)\Microsoft Visual SourceSafe Upgrade""")
Console.WriteLine("And then type in VssUpgrade analyze " + analyzeSettingsFilePathName)
Console.WriteLine("And then password when prompted: " + vssPwd)
Console.Read()
End Sub
Sub LaunchMigration(migrationSettingsFilePath As String)
Dim psi As New Diagnostics.ProcessStartInfo("cmd.exe")
psi.RedirectStandardInput = True
psi.UseShellExecute = False
Using p As Diagnostics.Process = Diagnostics.Process.Start(psi)
p.StandardInput.WriteLine("cd /d ""C:\Program Files" & _
" (x86)\Microsoft Visual SourceSafe Upgrade""")
p.StandardInput.WriteLine("VssUpgrade migrate " + migrationSettingsFilePath)
p.WaitForExit()
End Using
End Sub
Sub FixOlderThan6Issue()
Dim psi As New Diagnostics.ProcessStartInfo("cmd.exe")
psi.RedirectStandardInput = True
psi.UseShellExecute = False
Using p As Diagnostics.Process = Diagnostics.Process.Start(psi)
p.StandardInput.WriteLine("cd /d ""C:\Program " & _
"Files (x86)\Microsoft Visual Studio\COMMON\VSS\win32""")
p.StandardInput.WriteLine("ddupd.exe " + _
Path.GetDirectoryName(vssDatabasePathName) + _
Path.DirectorySeparatorChar + "data")
p.WaitForExit()
End Using
End Sub
End Module
We can sequentially run the methods in the Main Sub one by one as required by the migration process. For example, run
GetCheckouts()
to get a checkout list, run AnalyzeBeforeMigration() to analyze the VSS database and fix any errors before the migration.
Before launching the migration, we should create corresponding projects in TFS. This is done by method
CreateTeamProject()
. Also we need prepare a setting file for the migration, which is done by WriteMigrationSettingsXmlFile method. If required, user mapping info should get ready before hand (in my case, it is not required, so there is no codes for such).
Points of Interest
I publish the codes for reference and analysis only, especially in terms of SourceSafe and TFS programming. Though the codes assisted me much in the migration process, readers cannot just do copy-and-paste thing and hope it run exactly as expected.