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