mirror of
https://github.com/kimmknight/remoteapptool.git
synced 2024-11-24 14:37:23 +00:00
364 lines
18 KiB
VB.net
364 lines
18 KiB
VB.net
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 = "<?xml version=""1.0""?>" & vbCrLf
|
|
wxsString += "<?define ProductVersion = """ & ProductVersion & """?>" & vbCrLf
|
|
wxsString += "<?define ProductUpgradeCode = """ & ProductUpgradeCode() & """?>" & vbCrLf
|
|
wxsString += "<?define AppFilesGuid = """ & AppFilesGuid & """?>" & vbCrLf
|
|
wxsString += "<?define AppStartShortcutsGuid = """ & AppStartShortcutsGuid & """?>" & vbCrLf
|
|
wxsString += "<?define AppDeskShortcutsGuid = """ & AppDeskShortcutsGuid & """?>" & vbCrLf
|
|
wxsString += "<?define ProductName = """ & ProductName & """?>" & vbCrLf
|
|
wxsString += "<?define ProductPublisher = """ & ProductPublisher & """?>" & vbCrLf
|
|
wxsString += "<?define ProductBaseFileName = """ & ProductBaseFileName & """?>" & vbCrLf
|
|
wxsString += "<?define RegRoot = """ & RegRoot & """?>" & vbCrLf
|
|
If Not FlatFileTypes = "" Then wxsString += "<?define ProductProgID = """ & ProgID & """?>" & vbCrLf
|
|
If Not ProductRemoteTag = "" Then ProductRemoteTag = " (" & ProductRemoteTag & ")"
|
|
wxsString += "<?define ProductRemoteTag = """ & ProductRemoteTag & """?>" & vbCrLf
|
|
wxsString += "<Wix xmlns=""http://schemas.microsoft.com/wix/2006/wi"">" & vbCrLf
|
|
|
|
wxsString += " <Product Id=""*"" UpgradeCode=""$(var.ProductUpgradeCode)"" " & vbCrLf
|
|
wxsString += " Name=""$(var.ProductName)$(var.ProductRemoteTag)"" Version=""$(var.ProductVersion)"" Manufacturer=""$(var.ProductPublisher)"" Language=""1033"">" & vbCrLf
|
|
wxsString += " <Package InstallerVersion=""200"" Compressed=""yes"" Comments=""Windows Installer Package"""
|
|
If Not PerUser Then
|
|
wxsString += " InstallScope=""perMachine"""
|
|
Else
|
|
wxsString += " InstallPrivileges=""limited"""
|
|
End If
|
|
|
|
wxsString += "/>" & vbCrLf
|
|
wxsString += " <Media Id=""1"" Cabinet=""rdp2msi.cab"" EmbedCab=""yes""/>" & vbCrLf
|
|
If Not PerUser Then wxsString += " <Property Id=""AllUSERS"" Value=""1""/>" & vbCrLf
|
|
wxsString += " <Upgrade Id=""$(var.ProductUpgradeCode)"">" & vbCrLf
|
|
wxsString += " <UpgradeVersion Minimum=""$(var.ProductVersion)"" OnlyDetect=""yes"" Property=""NEWERVERSIONDETECTED""/>" & vbCrLf
|
|
wxsString += " <UpgradeVersion Minimum=""0.0.0"" Maximum=""$(var.ProductVersion)"" IncludeMinimum=""yes"" IncludeMaximum=""no"" " & vbCrLf
|
|
wxsString += " Property=""OLDERVERSIONBEINGUPGRADED""/> " & vbCrLf
|
|
wxsString += " </Upgrade>" & vbCrLf
|
|
wxsString += " <Condition Message=""A newer version of this software is already installed."">NOT NEWERVERSIONDETECTED</Condition>" & vbCrLf
|
|
wxsString += " <Property Id=""MstscProperty"" Value=""mstsc.exe""/>" & vbCrLf
|
|
wxsString += " <Directory Id=""TARGETDIR"" Name=""SourceDir"">" & vbCrLf
|
|
If Not PerUser Then
|
|
wxsString += " <Directory Id=""ProgramFilesFolder"">" & vbCrLf
|
|
Else
|
|
wxsString += " <Directory Id=""LocalAppDataFolder"">" & vbCrLf
|
|
End If
|
|
wxsString += " <Directory Id=""INSTALLDIR"" Name=""RemotePackages"">" & vbCrLf
|
|
wxsString += " <Component Id=""ApplicationFiles"" Guid=""$(var.AppFilesGuid)"">" & vbCrLf
|
|
wxsString += " <File Id=""rdpFile1"" Source=""$(var.ProductBaseFileName).rdp""/>" & vbCrLf
|
|
If hasIcon Then wxsString += " <File Id=""rdpIcon1"" Source=""$(var.ProductBaseFileName).ico""/>" & vbCrLf
|
|
'# Begin filetype association code
|
|
If Not FlatFileTypes = "" Then
|
|
For Each FileType In FlatFileTypes.Replace(".", "").Split(",")
|
|
wxsString += " <File Id=""$(var.ProductProgID)." & FileType & ".ico"" Source=""$(var.ProductBaseFileName)." & FileType & ".ico"" />" & vbCrLf
|
|
wxsString += " <ProgId Id=""remote.$(var.ProductProgID)." & FileType & "file"" Description=""$(var.ProductName) " & FileType & " file"" Icon=""$(var.ProductProgID)." & FileType & ".ico"">" & vbCrLf
|
|
wxsString += " <Extension Id=""" & FileType & """ ContentType=""application/" & FileType & """>" & vbCrLf
|
|
wxsString += " <Verb Id=""open"" Command=""Open"" TargetProperty='MstscProperty' Argument='/REMOTEFILE:""%1"" ""[INSTALLDIR]$(var.ProductBaseFileName).rdp""' />" & vbCrLf
|
|
wxsString += " </Extension>" & vbCrLf
|
|
wxsString += " </ProgId>" & vbCrLf
|
|
'wxsString += " <RegistryValue Root=""$(var.RegRoot)"" Key=""SOFTWARE\Classes\remote.$(var.ProductProgID)." & FileType & "file"" Name=""FriendlyTypeName"" Value=""$(var.ProductName) " & FileType & " file"" Type=""string"" />"
|
|
Next
|
|
End If
|
|
'# End FTA code
|
|
wxsString += " </Component>" & vbCrLf
|
|
wxsString += " </Directory>" & vbCrLf
|
|
wxsString += " </Directory>" & vbCrLf
|
|
|
|
If ShortcutInStart Then
|
|
wxsString += " <Directory Id=""ProgramMenuFolder"">" & vbCrLf
|
|
If ShortcutSubfolderInStart Then wxsString += " <Directory Id=""ProgramMenuSubfolder"" Name=""$(var.ProductName)$(var.ProductRemoteTag)"">" & vbCrLf
|
|
wxsString += " <Component Id=""ApplicationStartShortcuts"" Guid=""$(var.AppStartShortcutsGuid)"">" & vbCrLf
|
|
wxsString += " <Shortcut Id=""rdpStartShortcut1"" Name=""$(var.ProductName)$(var.ProductRemoteTag)"" Description=""$(var.ProductName)$(var.ProductRemoteTag)"" " & vbCrLf
|
|
wxsString += " Target=""[INSTALLDIR]$(var.ProductBaseFileName).rdp"" WorkingDirectory=""INSTALLDIR"""
|
|
|
|
If hasIcon Then
|
|
wxsString += " Icon=""rdpStartIcon.rdp"" IconIndex=""0"">" & vbCrLf
|
|
wxsString += " <Icon Id=""rdpStartIcon.rdp"" SourceFile=""$(var.ProductBaseFileName).ico"" />" & vbCrLf
|
|
wxsString += " </Shortcut>" & vbCrLf
|
|
Else
|
|
wxsString += "/>" & vbCrLf
|
|
End If
|
|
|
|
wxsString += " <RegistryValue Root=""$(var.RegRoot)"" Key=""Software\RDP2MSI\$(var.ProductName)"" " & vbCrLf
|
|
wxsString += " Name=""installed"" Type=""integer"" Value=""1"" KeyPath=""yes""/>" & vbCrLf
|
|
wxsString += " <RemoveFolder Id=""ProgramMenuSubfolder"" On=""uninstall""/>" & vbCrLf
|
|
wxsString += " </Component>" & vbCrLf
|
|
If ShortcutSubfolderInStart Then wxsString += " </Directory>" & vbCrLf
|
|
wxsString += " </Directory>" & vbCrLf
|
|
End If
|
|
|
|
If ShortcutOnDesktop Then
|
|
wxsString += " <Directory Id=""DesktopFolder"">" & vbCrLf
|
|
wxsString += " <Component Id=""ApplicationDesktopShortcuts"" Guid=""$(var.AppDeskShortcutsGuid)"">" & vbCrLf
|
|
wxsString += " <Shortcut Id=""rdpDesktopShortcut1"" Name=""$(var.ProductName)$(var.ProductRemoteTag)"" Description=""$(var.ProductName)$(var.ProductRemoteTag)"" " & vbCrLf
|
|
wxsString += " Target=""[INSTALLDIR]$(var.ProductBaseFileName).rdp"" WorkingDirectory=""INSTALLDIR"""
|
|
|
|
If hasIcon Then
|
|
wxsString += " Icon=""rdpDeskIcon.rdp"" IconIndex=""0"">" & vbCrLf
|
|
wxsString += " <Icon Id=""rdpDeskIcon.rdp"" SourceFile=""$(var.ProductBaseFileName).ico"" />" & vbCrLf
|
|
wxsString += " </Shortcut>" & vbCrLf
|
|
Else
|
|
wxsString += "/>" & vbCrLf
|
|
End If
|
|
|
|
|
|
wxsString += " <RegistryValue Root=""$(var.RegRoot)"" Key=""Software\RDP2MSI\$(var.ProductName)"" " & vbCrLf
|
|
wxsString += " Name=""installed"" Type=""integer"" Value=""1"" KeyPath=""yes""/>" & vbCrLf
|
|
wxsString += " </Component>" & vbCrLf
|
|
wxsString += " </Directory>" & vbCrLf
|
|
End If
|
|
wxsString += " </Directory>" & vbCrLf
|
|
|
|
wxsString += " <InstallExecuteSequence>" & vbCrLf
|
|
wxsString += " <RemoveExistingProducts After=""InstallValidate""/>" & vbCrLf
|
|
wxsString += " </InstallExecuteSequence>" & vbCrLf
|
|
wxsString += " "
|
|
wxsString += " <Feature Id=""DefaultFeature"" Level=""1"">" & vbCrLf
|
|
wxsString += " <ComponentRef Id=""ApplicationFiles""/>" & vbCrLf
|
|
If ShortcutInStart Then wxsString += " <ComponentRef Id=""ApplicationStartShortcuts""/>" & vbCrLf
|
|
If ShortcutOnDesktop Then wxsString += " <ComponentRef Id=""ApplicationDesktopShortcuts""/>" & vbCrLf
|
|
wxsString += " </Feature>" & vbCrLf
|
|
If hasIcon Then
|
|
wxsString += "<Icon Id=""rdpARPIcon.rdp"" SourceFile=""$(var.ProductBaseFileName).ico"" />" & vbCrLf
|
|
wxsString += "<Property Id=""ARPPRODUCTICON"" Value=""rdpARPIcon.rdp"" />" & vbCrLf
|
|
End If
|
|
wxsString += " </Product>" & vbCrLf
|
|
wxsString += "</Wix>" & 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 |