Click here to Skip to main content
15,886,873 members
Articles / Productivity Apps and Services / Microsoft Office

InfoPath GUID Updator

Rate me:
Please Sign up or sign in to vote.
4.00/5 (1 vote)
31 May 2009CPOL1 min read 19.4K   165   3  
Update the Infopath Managed Data Connection's GUID without open file
Imports System.IO
Imports System.Xml
Imports Microsoft.Office.Interop.InfoPath


Public Class Form1
    Dim g_TempPath As String = "c:\windows\temp"
    Dim g_CabSdkBin As String = System.Environment.CurrentDirectory & "\CabSdk\bin"
    Dim g_ExtractExe As String = PathCombine(g_CabSdkBin, "extract.exe")
    Dim g_MakecabExe As String = PathCombine(g_CabSdkBin, "makecab.exe")
    Dim g_XsfNamespace As String = "http://schemas.microsoft.com/office/infopath/2003/solutionDefinition"

    Dim dt As New DataTable

    Private Sub btnUpdate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnUpdate.Click
        ExtractFilesFromXSN(txtResourceFile.Text, g_TempPath)

        Dim bAns As Boolean
        Dim sErr As String = ""
        Dim sContents As String = GetFileContents(g_TempPath & "\manifest.xsf", sErr)
        If sErr = "" Then
            For i As Integer = 0 To dt.Rows.Count - 1
                If rdDevToProd.Checked Then
                    sContents = Replace(sContents, dt.Rows(i)("DevGUID"), dt.Rows(i)("ProdGUID"))
                End If
                If rdProdToDev.Checked Then
                    sContents = Replace(sContents, dt.Rows(i)("ProdGUID"), dt.Rows(i)("DevGUID"))
                End If
            Next

            'Save to different file
            bAns = SaveTextToFile(sContents, g_TempPath & "\manifest.xsf", sErr)
            If bAns Then
                MessageBox.Show("File Saved.", "GUID Updator", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Else
                MessageBox.Show("Error saving file.", "GUID Updator", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End If

        Else
            MessageBox.Show("Error retrieving file: " & sErr, "GUID Updator", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End If

        CreateXSNFromFiles(g_TempPath, "manifest.xsf", txtResourceFile.Text)
    End Sub

    Public Function GetFileContents(ByVal FullPath As String, _
       Optional ByRef ErrInfo As String = "") As String

        Dim strContents As String
        Dim objReader As StreamReader
        Try

            objReader = New StreamReader(FullPath)
            strContents = objReader.ReadToEnd()
            objReader.Close()
            Return strContents
        Catch Ex As Exception
            ErrInfo = Ex.Message
        End Try
    End Function


    Public Function SaveTextToFile(ByVal strData As String, _
     ByVal FullPath As String, _
       Optional ByVal ErrInfo As String = "") As Boolean

        Dim Contents As String
        Dim bAns As Boolean = False
        Dim objReader As StreamWriter
        Try


            objReader = New StreamWriter(FullPath)
            objReader.Write(strData)
            objReader.Close()
            bAns = True
        Catch Ex As Exception
            ErrInfo = Ex.Message

        End Try
        Return bAns
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        dt.Columns.Add("Type")
        dt.Columns.Add("DevGUID")
        dt.Columns.Add("ProdGUID")

        Dim nav As XPath.XPathNavigator

        Dim xnDocument As New XPath.XPathDocument("syn.xml")
        nav = xnDocument.CreateNavigator

        Dim xnIte As XPath.XPathNodeIterator = nav.Select("/guidsyn/group/syn")
        Dim c As Integer = xnIte.Count


        Do While (xnIte.MoveNext)
            Dim navBind = xnIte.Current

            Dim dr As DataRow = dt.NewRow
            dr.Item("Type") = navBind.GetAttribute("type", "")
            dr.Item("DevGUID") = navBind.GetAttribute("development", "")
            dr.Item("ProdGUID") = navBind.GetAttribute("production", "")
            dt.Rows.Add(dr)

        Loop
        dgType.DataSource = dt
    End Sub



    Function ExtractFilesFromXSN(ByVal xsnInputPath, ByVal outputFolder) As Integer
        Try
            If Not File.Exists(g_MakecabExe) Then
                Throw New Exception("CABSDK not found.Copy CABSDK in the application Startup Path.")
            End If
            Dim Parameters As String

            ' "/Y" prevents prompting before overwriting
            ' "/E" extract all files
            ' "/L" location to extract to

            If outputFolder <> Nothing Then
                Parameters = "/Y /E /L " + QuoteString(outputFolder)
            End If
            Dim output As String
            output = ShellExecute(QuoteString(g_ExtractExe) _
                + " " + Parameters _
                + " " + QuoteString(xsnInputPath), True)
        Catch ex As Exception
            Throw New Exception("Could not exctract the files from xsn.", ex)
        End Try

        'Trace(output)
    End Function

    Sub CreateXSNFromFiles(ByVal inputFolder As String, ByVal xsfName As String, ByVal xsnOutputPath As String)
        Try

            If Not File.Exists(g_MakecabExe) Then
                Throw New Exception("CABSDK not found.Copy CABSDK in the application Startup Path.")
            End If

            Dim tempName As String = Path.GetFileNameWithoutExtension(Path.GetTempFileName())
            Dim tempFolder = Path.GetTempPath()
            Dim tempPath = PathCombine(tempFolder, tempName)

            Dim ddfString As String = ""
            ddfString += ".Set DiskDirectoryTemplate='" + tempFolder + "'" + Environment.NewLine
            ddfString += ".Set CabinetNameTemplate='" + tempName + "'" + Environment.NewLine

            Dim xsfDom As XmlDocument = New XmlDocument
            xsfDom.Load(PathCombine(inputFolder, xsfName))
            Dim nm As New XmlNamespaceManager(xsfDom.NameTable)
            nm.AddNamespace("xsf", g_XsfNamespace)

            ddfString += QuoteString(PathCombine(inputFolder, xsfName)) + Environment.NewLine
            Dim fileNodes As XmlNodeList = xsfDom.SelectNodes("/xsf:xDocumentClass/xsf:package/xsf:files/xsf:file/@name", nm)
            Dim i As Integer
            For i = 0 To fileNodes.Count - 1
                ddfString += QuoteString(PathCombine(inputFolder, fileNodes(i).InnerText)) + Environment.NewLine
            Next

            Dim ddfPath As String = PathCombine(tempFolder, "makecab.ddf")
            SaveToFile(ddfString, ddfPath)
            Dim output As String
            output = ShellExecute(QuoteString(g_MakecabExe) + " /V1 /F " + QuoteString(ddfPath), True)
            'Trace(output)
            File.Delete(ddfPath)

            ' Move the XSN to its new home
            If File.Exists(xsnOutputPath) Then
                File.Delete(xsnOutputPath)
            End If

            File.Move(tempPath, xsnOutputPath)

            ' Delete setup files output into current directory by CAB process
            Dim oScratchFiles() As String = {"setup.inf", "setup.rpt"}
            Dim strScratchFile As String
            For Each strScratchFile In oScratchFiles
                If File.Exists(strScratchFile) Then
                    File.Delete(strScratchFile)
                End If
            Next

            'Delete temp folder
            Dim dTemp As New DirectoryInfo(g_TempPath)
            dTemp.Delete(True)

        Catch ex As Exception
            Throw New Exception("Could not create XSN file from files.", ex)
        End Try
    End Sub

    Function SaveToFile(ByVal data As String, ByVal filePath As String)
        Dim fs As FileStream = File.Create(filePath)
        fs.Close()
        Dim TextStream As TextWriter = New StreamWriter(filePath)
        TextStream.Write(data)
        TextStream.Flush()
        TextStream.Close()
        TextStream = Nothing
    End Function

    Function PathCombine(ByVal dir, ByVal file) As String
        Return Path.Combine(dir, file)
    End Function


    Function QuoteString(ByVal str As String) As String
        Return ("""" + str + """")
    End Function

    Function ShellExecute(ByVal str As String, ByVal flagWait As Boolean) As String
        If flagWait = Nothing Then
            flagWait = True
        End If
        Return Shell(str, AppWinStyle.Hide, flagWait, 1 * 60000)
    End Function

    Private Sub btnResourceFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnResourceFile.Click
        OpenFileDialog1.ShowDialog()

        If Path.IsPathRooted(OpenFileDialog1.FileName) Then
            txtResourceFile.Text = OpenFileDialog1.FileName
            g_TempPath = Path.GetDirectoryName(OpenFileDialog1.FileName) & "\Temp"
            btnUpdate.Enabled = True
        Else
            txtResourceFile.Text = vbNullString
            btnUpdate.Enabled = True
        End If
      
    End Sub
End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Malaysia Malaysia
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions