Imports System.Reflection.Assembly Public Class RDP Private rdpFilePath As String Public Property rdpPath As String Get Return rdpFilePath End Get Set(value As String) rdpFilePath = value ReadRDPfile() End Set End Property Private ProductName As String ' Full remoteapp name as read from RDP file Public FlatFileTypes As String = "" Public PerUser As Boolean = False Private ProductBaseFileName As String ' RDP filename minus the file extension Public ProductPublisher As String Public ProductVersion As String = "1.0.0.0" Public ProductUpgradeRandom As Boolean = False Public ProductRemoteTag As String = "remote" Public ShortcutInStart As Boolean = True Public ShortcutSubfolderInStart As Boolean = True Public ShortcutOnDesktop As Boolean = True Private rdpFileContents As String Private hasIcon As Boolean Private rdpInTemp As Boolean Public Sub CreateMSI(Optional DestinationPath As String = "") 'Check for wix, exit if not available If Not WixInstalled() Then Exit Sub 'Get RDP file parent folder path Dim rdpParentFolder = My.Computer.FileSystem.GetParentPath(rdpFilePath) 'Get the RDP filename and filename minus extension Dim rdpFileName = My.Computer.FileSystem.GetFileInfo(rdpFilePath).Name ProductBaseFileName = System.IO.Path.GetFileNameWithoutExtension(rdpFileName) 'If DestinationPath not defined then set the path to the same as the rdp file If DestinationPath = "" Then DestinationPath = rdpParentFolder & "\" & ProductBaseFileName & ".msi" 'Set iconpath (whether it exists or not) Dim IconFilePath = rdpParentFolder & "\" & ProductBaseFileName & ".ico" 'Check for icon, set "HasIcon" to true if found hasIcon = My.Computer.FileSystem.FileExists(IconFilePath) 'Get RemoteApp names (short and full) from RDP file contents Dim RemoteAppFullName = ReadRDPProperty("remoteapplicationname") Dim RemoteAppShortName = ReadRDPProperty("remoteapplicationprogram") 'Define wix temp file paths Dim TempPath = Environment.GetEnvironmentVariable("TEMP") Dim wxsPath = TempPath & "\" & ProductBaseFileName & ".wxs" Dim wixobjPath = TempPath & "\" & ProductBaseFileName & ".wixobj" Dim wixpdbPath = TempPath & "\" & ProductBaseFileName & ".wixpdb" Dim msiPath = TempPath & "\" & ProductBaseFileName & ".msi" Dim rdpTempPath = TempPath & "\" & ProductBaseFileName & ".rdp" Dim icoTempPath = TempPath & "\" & ProductBaseFileName & ".ico" 'Define temp files to delete Dim FilesToDelete As List(Of String) = New List(Of String)(New String() {wxsPath, wixobjPath, wixpdbPath}) 'Check if rdp file is already in TEMP folder If rdpParentFolder = TempPath Then rdpInTemp = True 'if RDP file not in temp, copy to temp If Not rdpInTemp Then My.Computer.FileSystem.CopyFile(rdpFilePath, rdpTempPath, True) FilesToDelete.Add(rdpTempPath) If hasIcon Then My.Computer.FileSystem.CopyFile(IconFilePath, icoTempPath, True) FilesToDelete.Add(icoTempPath) End If End If 'Save WXS file containing generated WXS string My.Computer.FileSystem.WriteAllText(wxsPath, GenerateWXSString(), False) Dim CandlePath = WixPath() & "\candle.exe " Dim LightPath = WixPath() & "\light.exe " 'Run Candle.exe and Light.exe to process wxs file Dim CandleExitCode = RunWait(CandlePath, "-out """ & wixobjPath & """ """ & wxsPath & """") 'If Not CandleExitCode = 0 Then Exit Sub Dim LightExitCode = RunWait(LightPath, "-out """ & msiPath & """ """ & wixobjPath & """") 'If Not LightExitCode = 0 Then Exit Sub 'Move MSI file to destination and delete temp files My.Computer.FileSystem.MoveFile(msiPath, DestinationPath, True) DeleteFiles(FilesToDelete) End Sub Public Function WixInstalled() As Boolean If WixPath() = "" Then WixInstalled = False Else WixInstalled = True End If End Function Private Function WixPath() Dim searchExe = "\candle.exe" WixPath = "" If Not Environment.GetEnvironmentVariable("WIX") = "" Then WixPath = Environment.GetEnvironmentVariable("WIX") & "bin" ElseIf My.Computer.FileSystem.DirectoryExists(My.Application.Info.DirectoryPath & "\wix\" & searchExe) Then WixPath = My.Application.Info.DirectoryPath & "\wix" ElseIf My.Computer.FileSystem.DirectoryExists(My.Application.Info.DirectoryPath & "\wix\bin\" & searchExe) Then WixPath = My.Application.Info.DirectoryPath & "\wix\bin" End If End Function Private Sub DeleteFiles(FilesArray As List(Of String)) For Each dFile In FilesArray If My.Computer.FileSystem.FileExists(dFile) Then My.Computer.FileSystem.DeleteFile(dFile) Next End Sub Private Sub ReadRDPfile() 'Check if RDP file exists If Not My.Computer.FileSystem.FileExists(rdpFilePath) Then Exit Sub 'Check that RDP file is an RDP file If Not rdpFilePath.ToLower.EndsWith(".rdp") Then Exit Sub 'Read RDP file into variable rdpFileContents = My.Computer.FileSystem.ReadAllText(rdpFilePath) 'Check RDP file contains a remoteapplicationname value 'If ReadRDPProperty("remoteapplicationname") = "" Then Exit Sub 'Check if RDP file contains a server address If ReadRDPProperty("full address") = "" Then Exit Sub 'Read variables ProductName = ReadRDPProperty("remoteapplicationname") If ProductName = "" Then ProductName = System.IO.Path.GetFileNameWithoutExtension(rdpFilePath) End If If ProductPublisher Is Nothing Then ProductPublisher = ProductName End Sub Public Function ProductUpgradeCode() ' random or generated - maybe allow caller to define? Dim UpgradeCode As String 'Check if ProductUpgradeRandom is true, create a random productcode if so, otherwise generate it from the productname If Not ProductUpgradeRandom Then UpgradeCode = GenerateGUIDfromString(ProductName) Else Dim Rnd = New Random() UpgradeCode = GenerateGUIDfromString(Rnd.Next) End If Return UpgradeCode End Function Public Function MakeProgID(AppName) As String Dim rx As New System.Text.RegularExpressions.Regex("[^a-zA-Z0-9_]") MakeProgID = rx.Replace(AppName, "_") End Function Private Function GenerateWXSString() Dim Rnd = New Random() If ProductPublisher = "" Then ProductPublisher = ProductName Dim RegRoot = "HKLM" If PerUser = True Then RegRoot = "HKCU" Dim AppFilesGuid = GenerateGUIDfromString("AppFiles" & ProductUpgradeCode()) Dim AppStartShortcutsGuid = GenerateGUIDfromString("AppStartShortcuts" & ProductUpgradeCode()) Dim AppDeskShortcutsGuid = GenerateGUIDfromString("AppDeskShortcuts" & ProductUpgradeCode()) Dim ProgID As String = MakeProgID(ProductBaseFileName) Dim wxsString = "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += "" & vbCrLf If Not FlatFileTypes = "" Then wxsString += "" & vbCrLf If Not ProductRemoteTag = "" Then ProductRemoteTag = " (" & ProductRemoteTag & ")" wxsString += "" & vbCrLf wxsString += "" & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf If Not PerUser Then wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " NOT NEWERVERSIONDETECTED" & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf If Not PerUser Then wxsString += " " & vbCrLf Else wxsString += " " & vbCrLf End If wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf If hasIcon Then wxsString += " " & vbCrLf '# Begin filetype association code If Not FlatFileTypes = "" Then For Each FileType In FlatFileTypes.Replace(".", "").Split(",") wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf 'wxsString += " " Next End If '# End FTA code wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf If ShortcutInStart Then wxsString += " " & vbCrLf If ShortcutSubfolderInStart Then wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf Else wxsString += "/>" & vbCrLf End If wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf If ShortcutSubfolderInStart Then wxsString += " " & vbCrLf wxsString += " " & vbCrLf End If If ShortcutOnDesktop Then wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf Else wxsString += "/>" & vbCrLf End If wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf End If wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " & vbCrLf wxsString += " " wxsString += " " & vbCrLf wxsString += " " & vbCrLf If ShortcutInStart Then wxsString += " " & vbCrLf If ShortcutOnDesktop Then wxsString += " " & vbCrLf wxsString += " " & vbCrLf If hasIcon Then wxsString += "" & vbCrLf wxsString += "" & vbCrLf End If wxsString += " " & vbCrLf wxsString += "" & vbCrLf Return wxsString End Function Public Function ReadRDPProperty(rdpProperty As String) As String Dim rdpFileLines = Split(rdpFileContents, vbLf) Dim rdpValue = "" For Each rdpLine In rdpFileLines rdpLine = Replace(rdpLine, vbCr, "") rdpLine = Replace(rdpLine, "|", "") Dim rdpLineSplit = Split(rdpLine, ":", 3) If rdpLineSplit(0) = rdpProperty Then rdpValue = rdpLineSplit(2) End If Next Return rdpValue End Function Private Function GenerateGUIDfromString(TheString As String) Dim TheHash = getMD5Hash(TheString) Dim MyGuid As Guid = New Guid(TheHash) Return MyGuid.ToString End Function Private Function getMD5Hash(ByVal strToHash As String) As String Dim md5Obj As New System.Security.Cryptography.MD5CryptoServiceProvider() Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash) bytesToHash = md5Obj.ComputeHash(bytesToHash) Dim strResult As String = "" Dim b As Byte For Each b In bytesToHash strResult += b.ToString("x2") Next Return strResult End Function Private Function RunWait(App As String, Parameters As String) As Integer Dim proc As New Process proc.StartInfo.CreateNoWindow = True proc.StartInfo.WindowStyle = ProcessWindowStyle.Hidden proc.StartInfo.FileName = App proc.StartInfo.Arguments = Parameters proc.Start() proc.WaitForExit() Return proc.ExitCode End Function End Class