remoteapptool/remoteapp-tool/RemoteAppCreateClientConnection.vb

Imports VB = Microsoft.VisualBasic

Public Class RemoteAppCreateClientConnection

    Private RemoteApp As New RemoteAppLib.RemoteApp

    Public Sub CreateClientConnection(SelectedRemoteApp As RemoteAppLib.RemoteApp)

        RemoteApp = SelectedRemoteApp

        Dim RemoteAppShortName = RemoteApp.Name
        Me.Text = "Create Client Connection for " & RemoteAppShortName

        SetCCWindowSettings()

        If Me.ServerAddress.Text = "" Then Me.ServerAddress.Text = System.Net.Dns.GetHostName
        If Me.AltServerAddress.Text = "" Then Me.AltServerAddress.Text = Me.ServerAddress.Text
        If Me.ServerPort.Text = "0" Then Me.ServerPort.Text = "3389"

        If Not My.Computer.FileSystem.FileExists(RemoteApp.IconPath) Then
            CreateRAWebIcon.Checked = False
            CreateRAWebIcon.Enabled = False
        Else
            CreateRAWebIcon.Enabled = RDPRadioButton.Checked
        End If

        Dim wx As New RDP2MSIlib.RDP
        If Not wx.WixInstalled Then
            RDPRadioButton.Checked = True
            MSIRadioButton.Enabled = False
            MSIRadioButton.Text = "MSI installer (requires WiX Toolset)"
        End If

        If Not RemoteApp.FileTypeAssociations Is Nothing Then _
        FTACountLabel.Text = "Count: " & RemoteApp.FileTypeAssociations.Count

        Me.RDPRadioButton.Focus()
        HelpSystem.SetupTips(Me)
        Me.ShowDialog()
        RemoteAppMainWindow.ReloadApps()
        Me.Dispose()
    End Sub

    Sub ResetCCWindowSettings()
        My.Settings.SavedConnectionModeMSI = False
        My.Settings.SavedOpenWithNotepad = False
        My.Settings.SavedServerAddress = System.Net.Dns.GetHostName
        My.Settings.SavedServerPort = 3389
        My.Settings.SavedAltServerAddress = My.Settings.SavedServerAddress
        My.Settings.SavedUseRDGateway = False
        My.Settings.SavedRDGatewayAddress = ""
        My.Settings.SavedAttemptDirectRDGateway = False
        My.Settings.SavedMSIShortcutDesktop = True
        My.Settings.SavedMSIShortcutStart = True
        My.Settings.SavedMSIShortcutStartTopLevel = False
        My.Settings.SavedUseShortcutTag = True
        My.Settings.SavedShortcutTag = "remote"
        My.Settings.SavedClientConnectionOptions = False
        My.Settings.SavedCreateRAWebIcon = False
        My.Settings.SavedMSIPerUser = False
        My.Settings.SavedDisableFTA = False
    End Sub

    Sub SaveCCWindowSettings()
        My.Settings.SavedConnectionModeMSI = MSIRadioButton.Checked
        My.Settings.SavedOpenWithNotepad = EditAfterSave.Checked
        My.Settings.SavedServerAddress = ServerAddress.Text
        My.Settings.SavedServerPort = Val(ServerPort.Text)
        My.Settings.SavedAltServerAddress = AltServerAddress.Text
        My.Settings.SavedUseRDGateway = UseRDGatewayCheckBox.Checked
        My.Settings.SavedRDGatewayAddress = GatewayAddress.Text
        My.Settings.SavedAttemptDirectRDGateway = AttemptDirectCheckBox.Checked
        My.Settings.SavedMSIShortcutDesktop = ShortcutDesktopCheckBox.Checked
        My.Settings.SavedMSIShortcutStart = ShortcutStartCheckBox.Checked
        My.Settings.SavedMSIShortcutStartTopLevel = TopLevelRadioButton.Checked
        My.Settings.SavedUseShortcutTag = ShortcutTagCheckBox.Checked
        My.Settings.SavedShortcutTag = ShortcutTagTextBox.Text
        My.Settings.SavedCreateRAWebIcon = CreateRAWebIcon.Checked
        My.Settings.SavedMSIPerUser = PerUserRadioButton.Checked
        My.Settings.SavedDisableFTA = DisabledFTACheckBox.Checked
    End Sub

    Sub SetCCWindowSettings()
        If My.Settings.SavedConnectionModeMSI = True Then
            RDPRadioButton.Checked = False
            MSIRadioButton.Checked = True
        Else
            RDPRadioButton.Checked = True
            MSIRadioButton.Checked = False
        End If
        EditAfterSave.Checked = My.Settings.SavedOpenWithNotepad
        ServerAddress.Text = My.Settings.SavedServerAddress
        ServerPort.Text = My.Settings.SavedServerPort
        AltServerAddress.Text = My.Settings.SavedAltServerAddress
        UseRDGatewayCheckBox.Checked = My.Settings.SavedUseRDGateway
        GatewayAddress.Text = My.Settings.SavedRDGatewayAddress
        AttemptDirectCheckBox.Checked = My.Settings.SavedAttemptDirectRDGateway
        ShortcutDesktopCheckBox.Checked = My.Settings.SavedMSIShortcutDesktop
        ShortcutStartCheckBox.Checked = My.Settings.SavedMSIShortcutStart
        If My.Settings.SavedMSIShortcutStartTopLevel = True Then
            SubfolderRadioButton.Checked = False
            TopLevelRadioButton.Checked = True
        Else
            SubfolderRadioButton.Checked = True
            TopLevelRadioButton.Checked = False
        End If
        ShortcutTagCheckBox.Checked = My.Settings.SavedUseShortcutTag
        ShortcutTagTextBox.Text = My.Settings.SavedShortcutTag
        MSIGroupBox.Enabled = MSIRadioButton.Checked
        CreateRAWebIcon.Checked = My.Settings.SavedCreateRAWebIcon
        DisabledFTACheckBox.Checked = My.Settings.SavedDisableFTA
        If My.Settings.SavedMSIPerUser = False Then
            PerMachineRadioButton.Checked = True
            PerUserRadioButton.Checked = False
        Else
            PerMachineRadioButton.Checked = False
            PerUserRadioButton.Checked = True
        End If
    End Sub

    Private Sub UseRDGatewayCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles UseRDGatewayCheckBox.CheckedChanged
        If UseRDGatewayCheckBox.Checked Then
            Me.GatewayAddress.Enabled = True
            Me.RDGWLabel.Enabled = True
            Me.AttemptDirectCheckBox.Enabled = True
        Else
            Me.GatewayAddress.Enabled = False
            Me.RDGWLabel.Enabled = False
            Me.AttemptDirectCheckBox.Enabled = False
        End If
    End Sub

    Private Sub RDPRadioButton_CheckedChanged(sender As Object, e As EventArgs) Handles RDPRadioButton.CheckedChanged
        MSIGroupBox.Enabled = MSIRadioButton.Checked
        EditAfterSave.Enabled = RDPRadioButton.Checked
        CreateRAWebIcon.Enabled = RDPRadioButton.Checked

        If RDPRadioButton.Checked Then
            CreateButton.ImageIndex = 6
        Else
            CreateButton.ImageIndex = 1
        End If
    End Sub

    Private Sub CreateButton_Click(sender As Object, e As EventArgs) Handles CreateButton.Click
        Dim RDPPath = ""
        Dim MSIPath = ""
        Dim TempMSIPath = ""

        If DisabledFTACheckBox.Checked And Not RemoteApp.FileTypeAssociations Is Nothing Then RemoteApp.FileTypeAssociations.Clear()

        If RDPRadioButton.Checked Then
            FileSaveRDP.FileName = RemoteApp.Name
            If Not FileSaveRDP.ShowDialog() = Windows.Forms.DialogResult.OK Then Exit Sub
            RDPPath = FileSaveRDP.FileName
        Else
            FileSaveMSI.FileName = RemoteApp.Name
            If Not FileSaveMSI.ShowDialog() = Windows.Forms.DialogResult.OK Then Exit Sub
            MSIPath = FileSaveMSI.FileName
            RDPPath = Environment.GetEnvironmentVariable("TEMP") & "\" & RemoteApp.Name & ".rdp"
            TempMSIPath = Environment.GetEnvironmentVariable("TEMP") & "\" & RemoteApp.Name & ".msi"
        End If

        Dim gwaddress As String = ""
        Dim trydirect As Boolean = False
        If UseRDGatewayCheckBox.Checked Then
            gwaddress = GatewayAddress.Text
            trydirect = AttemptDirectCheckBox.Checked
        End If


        If RDPRadioButton.Checked Then
            CreateRDPFile(RDPPath, RemoteApp)
            '!!!!!!! If it's an RDP file
            If EditAfterSave.Checked Then
                Dim CmdLine = GetSysDir() & "\notepad.exe"
                System.Diagnostics.Process.Start(CmdLine, FileSaveRDP.FileName)
            End If
            If CreateRAWebIcon.Checked Then
                Dim IconFilePath = Microsoft.VisualBasic.Left(RDPPath, RDPPath.Length - 4) & ".ico"
                If ExtractToIco(RemoteApp.IconPath, RemoteApp.IconIndex, IconFilePath) = False Then
                    MessageBox.Show("Icon could not be created the RemoteApp. RDP file will still be created.", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                End If
                For Each FTA As RemoteAppLib.FileTypeAssociation In RemoteApp.FileTypeAssociations
                    Dim ProductFileName = VB.Left(RDPPath, RDPPath.Length - 4)
                    ExtractFTIcon(ProductFileName, FTA)
                Next
            End If
        Else
            '!!!!!!!  If it's an MSI
            Dim RDP As New RDP2MSIlib.RDP
            CreateRDPFile(RDPPath, RemoteApp)

            RDP.rdpPath = RDPPath
            RDP.ShortcutOnDesktop = ShortcutDesktopCheckBox.Checked
            RDP.ShortcutInStart = ShortcutStartCheckBox.Checked
            RDP.ShortcutSubfolderInStart = SubfolderRadioButton.Checked
            RDP.ProductRemoteTag = ShortcutTagTextBox.Text
            RDP.PerUser = PerUserRadioButton.Checked

            Dim FilesToDelete As New ArrayList
            Dim ProductFileName = VB.Left(RDPPath, RDPPath.Length - 4)
            Dim IconFilePath = ProductFileName & ".ico"

            FilesToDelete.Add(RDPPath)

            If ExtractToIco(RemoteApp.IconPath, RemoteApp.IconIndex, IconFilePath) = False Then
                MessageBox.Show("There was an error loading icon:" & vbCrLf & RemoteApp.IconPath & "," & RemoteApp.IconIndex & vbCrLf & "The MSI will still be created but the main icon will be missing.", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Else
                FilesToDelete.Add(IconFilePath)
            End If

            If Not RemoteApp.FileTypeAssociations Is Nothing Then
                For Each FTA As RemoteAppLib.FileTypeAssociation In RemoteApp.FileTypeAssociations
                    ExtractFTIcon(ProductFileName, FTA)
                    FilesToDelete.Add(ProductFileName & "." & FTA.Extension & ".ico")
                Next
                RDP.FlatFileTypes = RemoteApp.FileTypeAssociations.GetFlatFileTypes
            End If


            RDP.CreateMSI(MSIPath)

            DeleteFiles(FilesToDelete)

        End If
        Me.Close()
    End Sub

    Private Sub ExtractFTIcon(ProductFileName As String, FTA As RemoteAppLib.FileTypeAssociation)
        'Extract icon for filetype
        If ExtractToIco(FTA.IconPath, FTA.IconIndex, ProductFileName & "." & FTA.Extension & ".ico") = False Then
            'If filetype icon fails to extract, then grab the default document icon from Shell32.dll
            ExtractToIco(GetSysDir() & "\shell32.dll", 0, ProductFileName & "." & FTA.Extension & ".ico")
            'Possibly show an error here??
        End If
    End Sub

    Private Sub CreateRDPFile(RDPPath As String, RemoteApp As RemoteAppLib.RemoteApp)

        Dim App As New RemoteAppLib.RemoteApp
        App = RemoteApp
        Dim FileTypeAssociations As RemoteAppLib.FileTypeAssociationCollection
        FileTypeAssociations = App.FileTypeAssociations

        Dim ServerAddress = Me.ServerAddress.Text
        Dim AltServerAddress = Me.AltServerAddress.Text
        Dim ServerPort = Me.ServerPort.Text

        Dim FlatFileTypes = ""
        If Not FileTypeAssociations Is Nothing Then FlatFileTypes = FileTypeAssociations.GetFlatFileTypes

        Dim RDPfile As New RDPFileLib.RDPFile
        RDPfile.full_address = ServerAddress
        RDPfile.alternate_full_address = AltServerAddress
        RDPfile.server_port = Val(ServerPort)

        RDPfile.remoteapplicationname = App.FullName
        RDPfile.remoteapplicationprogram = "||" & App.Name
        RDPfile.remoteapplicationmode = 1
        RDPfile.disableremoteappcapscheck = 1

        RDPfile.alternate_shell = "rdpinit.exe"

        If UseRDGatewayCheckBox.Checked Then
            RDPfile.gatewayhostname = Me.GatewayAddress.Text
            If Me.AttemptDirectCheckBox.CheckAlign Then RDPfile.gatewayusagemethod = 2 Else RDPfile.gatewayusagemethod = 1
            RDPfile.gatewayprofileusagemethod = 1
        End If

        RDPfile.prompt_for_credentials_on_client = 1
        RDPfile.promptcredentialonce = 0

        RDPfile.devicestoredirect = "*"
        RDPfile.drivestoredirect = "*"
        RDPfile.redirectcomports = 1
        RDPfile.redirectdrives = 1

        RDPfile.allow_desktop_composition = 1
        RDPfile.allow_font_smoothing = 1
        RDPfile.span_monitors = 1
        RDPfile.use_multimon = 1

        RDPfile.remoteapplicationfileextensions = FlatFileTypes

        RDPfile.SaveRDPfile(RDPPath)

    End Sub

    Private Function GetFlatFileTypesList(AppName As String, Optional Delim As String = ",") As String
        Dim BaseKeyName As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\TSAppAllowList\Applications\" & AppName & "\Filetypes"
        Dim FlatFTList = ""

        Try
            Dim BaseKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey(BaseKeyName)

            For Each FT As String In BaseKey.GetSubKeyNames
                FlatFTList &= "." & FT & Delim
            Next
            FlatFTList = FlatFTList.TrimEnd(Delim)

        Catch Ex As Exception

        End Try
        Return FlatFTList
    End Function

    Private Sub FTAButton_Click(sender As Object, e As EventArgs) Handles FTAButton.Click
        MessageBox.Show(Me, "Changes made here to File Type Associations are for this client connection only and will not be saved for next time." & vbCrLf & vbCrLf & _
               "To make permanent changes to the File Type Associations for this RemoteApp, edit the RemoteApp.", "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
        RemoteApp = RemoteAppFileTypeAssociation.EditFileTypes(RemoteApp)
        If Not RemoteApp.FileTypeAssociations Is Nothing Then _
        FTACountLabel.Text = "Count: " & RemoteApp.FileTypeAssociations.Count

    End Sub

    Private Sub ShortcutStartCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles ShortcutStartCheckBox.CheckedChanged
        SubfolderRadioButton.Enabled = ShortcutStartCheckBox.Checked
        TopLevelRadioButton.Enabled = ShortcutStartCheckBox.Checked
    End Sub

    Private Sub ShortcutTagCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles ShortcutTagCheckBox.CheckedChanged
        ShortcutTagTextBox.Enabled = ShortcutTagCheckBox.Checked
    End Sub

    Private Sub ServerAddress_TextChanged(sender As Object, e As EventArgs) Handles ServerAddress.TextChanged
        ValidateDNSname(ServerAddress)
    End Sub

    Private Sub AltServerAddress_TextChanged(sender As Object, e As EventArgs) Handles AltServerAddress.TextChanged
        ValidateDNSname(AltServerAddress)
    End Sub

    Private Sub ServerPort_TextChanged(sender As Object, e As EventArgs) Handles ServerPort.TextChanged
        ValidatePort(ServerPort)
    End Sub

    Private Sub ResetButton_Click(sender As Object, e As EventArgs) Handles ResetButton.Click
        ResetCCWindowSettings()
        SetCCWindowSettings()
    End Sub

    Private Sub SaveButton_Click(sender As Object, e As EventArgs) Handles SaveButton.Click
        SaveCCWindowSettings()
    End Sub

    Private Sub DisabledFTACheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles DisabledFTACheckBox.CheckedChanged
        If Me.DisabledFTACheckBox.Checked Then
            Me.FTAButton.Enabled = False
            Me.FTACountLabel.Enabled = False
        Else
            Me.FTAButton.Enabled = True
            Me.FTACountLabel.Enabled = True
        End If
    End Sub

End Class