Visual Studio Localization Tools

vs-localization-tools.vb

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics
Imports System.Resources
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Collections

Public Module LocalizationTools

    Private Const EmptyResxTemplate As String = "E:\Empty.resx"
    Private Const KeyOnlyMarkup = "<%$ Resources:##KeyName## %>"
    Private Const LiteralMarkup As String = "<asp:Literal Text=""<%$ Resources:##KeyName## %>"" runat=""server""/>"

    Private Enum ReplaceType
        Literal
        KeyOnly
    End Enum

    Sub MoveSelectedTextToResxAndReplaceWithLiteral()
        MoveSelectedTextToResx(ReplaceType.Literal)
    End Sub

    Sub MoveSelectedTextToResxAndReplaceWithKeyOnly()
        MoveSelectedTextToResx(ReplaceType.KeyOnly)
    End Sub

    Private Sub MoveSelectedTextToResx(ByVal replaceType As ReplaceType)

        Dim Selection As TextSelection = DTE.ActiveDocument.Selection
        Dim SelectedText As String = Selection.Text

        Dim iCol As Long = Selection.AnchorPoint.DisplayColumn
        Dim iRow As Long = Selection.AnchorPoint.Line

        If (String.IsNullOrEmpty(Selection.Text)) Then
            MsgBox("No text selected", MsgBoxStyle.Exclamation, "Error")
            Exit Sub
        End If

        WriteToPane("Moving " & SelectedText & " to resource file")

        Dim CurrentPath As String = DTE.ActiveDocument.FullName
        Dim CurrentFilename As String = Path.GetFileName(CurrentPath)
        Dim CurrentFolder As String = CurrentPath.Substring(0, CurrentPath.LastIndexOf("\"))
        Dim ResourceFilename = CurrentFilename & ".resx"
        Dim ResourceFolder = Path.Combine(CurrentFolder, "App_LocalResources")
        Dim ResourcePath = Path.Combine(ResourceFolder, ResourceFilename)

        If (Not Directory.Exists(ResourceFolder)) Then
            Directory.CreateDirectory(ResourceFolder)
            WriteToPane("Created resource folder: " & ResourceFolder)
        End If

        If (Not File.Exists(ResourcePath)) Then
            If (Not File.Exists(EmptyResxTemplate)) Then
                MsgBox("Resx file does not exist, and template does not exist either")
                Exit Sub
            End If

            File.Copy(EmptyResxTemplate, ResourcePath)
            WriteToPane(String.Format("Copied empty resx template from {0} to {1}", EmptyResxTemplate, ResourcePath))
        End If

        Dim DefaultKey As String = Selection.Text.Replace(" ", String.Empty)

        If (DefaultKey.Length > 15) Then
            DefaultKey = DefaultKey.Substring(0, 15)
        End If

        DefaultKey = SanitizeDefaultKey(DefaultKey)

        DefaultKey &= "Text"

        Dim MessageBoxTitle As String = IIf(replaceType = LocalizationTools.ReplaceType.KeyOnly, "Replace text with key", "Replace text with literal control")
        Dim MessageBoxText As String = "Please enter the key name for the resx file.  The following value will be inserted: " & vbCrLf & vbCrLf & SelectedText

        Dim KeyName As String = InputBox(MessageBoxText, MessageBoxTitle, DefaultKey)

        If (String.IsNullOrEmpty(KeyName)) Then
            MsgBox("Key name is required", MsgBoxStyle.Exclamation, "Error")
            Exit Sub
        End If

        Dim ReplaceTemplate As String = IIf(replaceType = LocalizationTools.ReplaceType.KeyOnly, KeyOnlyMarkup, LiteralMarkup)

        Dim Replacement As String = ReplaceTemplate.Replace("##KeyName##", KeyName)

        Dim RandomString = Guid.NewGuid.ToString()
        Selection.Text = RandomString

        DTE.Documents.SaveAll()
        WriteToPane("Saved all documents")

        DTE.ActiveDocument.Close()
        WriteToPane("Closed document before rewrite")

        Dim NewText As String = File.ReadAllText(CurrentPath).Replace(RandomString, Replacement)
        File.WriteAllText(CurrentPath, NewText)
        WriteToPane("Rewrote data")

        Dim item As EnvDTE.ProjectItem = DTE.Solution.FindProjectItem(CurrentPath)

        If (Not item Is Nothing) Then
            item.Open()
            item.Document.Activate()
            WriteToPane("Reopened file")

            item.Document.Selection.MoveToDisplayColumn(iRow, iCol)
        End If

        UpdateResourceFile(ResourcePath, KeyName, SelectedText)

        WriteToPane("Successfully replaced " & SelectedText & " with " & Replacement)
        WriteToPane("All done" & vbCrLf & vbCrLf)

    End Sub

    Private Function SanitizeDefaultKey(ByVal Key As String) As String
        Dim r As New Regex("(?:[^a-z0-9 ]|(?<=['""])s)", RegexOptions.IgnoreCase Or RegexOptions.CultureInvariant Or RegexOptions.Compiled)
        Return r.Replace(Key, [String].Empty)
    End Function

    Private Sub UpdateResourceFile(ByVal Path As String, ByVal NewKey As String, ByVal NewValue As Object)

        Dim resourceEntries As New Hashtable()

        Dim reader As New ResXResourceReader(Path)
        If reader IsNot Nothing Then
            Dim id As IDictionaryEnumerator = reader.GetEnumerator()
            For Each d As DictionaryEntry In reader
                If d.Value Is Nothing Then
                    resourceEntries.Add(d.Key.ToString(), "")
                Else
                    resourceEntries.Add(d.Key.ToString(), d.Value.ToString())
                End If
            Next
            reader.Close()
        End If

        resourceEntries(NewKey) = NewValue

        Dim resourceWriter As New ResXResourceWriter(Path)

        For Each key As String In resourceEntries.Keys
            resourceWriter.AddResource(key, resourceEntries(key))
        Next

        resourceWriter.Generate()
        resourceWriter.Close()

        WriteToPane("Updated resource file")

    End Sub

    Private Sub WriteToPane(ByVal Message As String)

        Const PaneName As String = "Localization"

        Dim win As Window = DTE.Windows.Item(EnvDTE.Constants.vsWindowKindOutput)
        Dim ow As OutputWindow = win.Object
        Dim owPane As OutputWindowPane

        For i As Integer = 1 To ow.OutputWindowPanes.Count
            If (ow.OutputWindowPanes.Item(i).Name = PaneName) Then
                owPane = ow.OutputWindowPanes.Item(i)
                Exit For
            End If
        Next

        If (owPane Is Nothing) Then
            owPane = ow.OutputWindowPanes.Add(PaneName)
        End If

        owPane.Activate()
        owPane.OutputString(DateTime.Now.ToString("dd MMM yyyy HH:mm:ss") & " : " & Message & vbCrLf)
    End Sub

End Module