2019-09-29 14:45:23 +02:00
Imports VB = Microsoft . VisualBasic
Public Class RemoteAppCreateClientConnection
Private RemoteApp As New RemoteAppLib . RemoteApp
Public Sub CreateClientConnection ( SelectedRemoteApp As RemoteAppLib . RemoteApp )
RemoteApp = SelectedRemoteApp
2019-10-31 22:24:29 +01:00
Dim rdpSign As New RDPSign . RDPSign
2019-09-29 14:45:23 +02:00
Dim RemoteAppShortName = RemoteApp . Name
Me . Text = " Create Client Connection for " & RemoteAppShortName
2019-11-10 12:51:14 +01:00
CertificateComboBox . Items . AddRange ( rdpSign . GetCertificateFriendlyName )
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
If Not My . Computer . FileSystem . FileExists ( GetSysDir ( ) & " \rdpsign.exe " ) Then
GroupBoxSignRDP . Enabled = False
GroupBoxSignRDP . Text += " (requires rdpsign.exe) "
GroupBoxSignRDP . Tag = " noexe "
End If
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
My . Settings . SavedSignRDP = False
My . Settings . SavedSignedAndUnsigned = False
My . Settings . SavedCertSelected = 0
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
My . Settings . SavedSignRDP = CheckBoxSignRDPEnabled . Checked
My . Settings . SavedSignedAndUnsigned = CheckBoxCreateSignedAndUnsigned . Checked
My . Settings . SavedCertSelected = CertificateComboBox . SelectedIndex
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
CheckBoxSignRDPEnabled . Checked = My . Settings . SavedSignRDP
CertificateComboBox . Enabled = My . Settings . SavedSignRDP
CheckBoxCreateSignedAndUnsigned . Checked = My . Settings . SavedSignedAndUnsigned
If CertificateComboBox . Items . Count >= ( My . Settings . SavedCertSelected + 1 ) Then
CertificateComboBox . SelectedIndex ( ) = My . Settings . SavedCertSelected
ElseIf CertificateComboBox . Items . Count > 0 Then
CertificateComboBox . SelectedIndex ( ) = 0
ElseIf Not GroupBoxSignRDP . Tag = " noexe " Then
GroupBoxSignRDP . Text += " (No certificates found) "
GroupBoxSignRDP . Enabled = False
End If
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
CheckBoxCreateSignedAndUnsigned . Enabled = True
2019-09-29 14:45:23 +02:00
Else
CreateButton . ImageIndex = 1
2019-11-10 12:51:14 +01:00
CheckBoxCreateSignedAndUnsigned . Enabled = False
CheckBoxCreateSignedAndUnsigned . Checked = False
2019-09-29 14:45:23 +02:00
End If
End Sub
Private Sub CreateButton_Click ( sender As Object , e As EventArgs ) Handles CreateButton . Click
Dim RDPPath = " "
Dim MSIPath = " "
Dim TempMSIPath = " "
2019-11-10 12:51:14 +01:00
If CheckBoxSignRDPEnabled . Checked And C ertificateComboBox . SelectedItem = " " Then
MessageBox . Show ( " You must select a certificate to sign the RDP file. " , " Error " , MessageBoxButtons . OK , MessageBoxIcon . Error )
Return
End If
2019-09-29 14:45:23 +02:00
If DisabledFTACheckBox . Checked And Not RemoteApp . FileTypeAssociations Is Nothing Then RemoteApp . FileTypeAssociations . Clear ( )
If RDPRadioButton . Checked Then
FileSaveRDP . FileName = RemoteApp . Name
2019-11-10 12:51:14 +01:00
If Not FileSaveRDP . ShowDialog ( ) = Windows . Forms . DialogResult . OK Then Return
2019-09-29 14:45:23 +02:00
RDPPath = FileSaveRDP . FileName
Else
FileSaveMSI . FileName = RemoteApp . Name
2019-11-10 12:51:14 +01:00
If Not FileSaveMSI . ShowDialog ( ) = Windows . Forms . DialogResult . OK Then Return
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
Me . Close ( )
2019-09-29 14:45:23 +02:00
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 )
2019-11-10 12:51:14 +01:00
Me . Close ( )
2019-09-29 14:45:23 +02:00
End If
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 )
2019-11-10 12:51:14 +01:00
If CheckBoxSignRDPEnabled . Checked Then
2019-10-31 22:24:29 +01:00
Dim rdpSign As New RDPSign . RDPSign
Dim Thumbprint As String = rdpSign . GetThumbprint ( CertificateComboBox . Text )
rdpSign . SignRDP ( Thumbprint , RDPPath , CheckBoxCreateSignedAndUnsigned . Checked )
End If
2019-09-29 14:45:23 +02:00
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
2019-11-10 12:51:14 +01:00
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 &
2019-09-29 14:45:23 +02:00
" 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
2019-11-10 12:51:14 +01:00
Private Sub CheckBoxSignRDPEnabled_CheckedChanged ( sender As Object , e As EventArgs ) Handles CheckBoxSignRDPEnabled . CheckedChanged
CertificateComboBox . Enabled = CheckBoxSignRDPEnabled . Checked
If ( EditAfterSave . Checked And CheckBoxSignRDPEnabled . Checked ) Then
If MessageBox . Show ( " You have selected "" Sign RDP file "" and "" Manually edit RDP file "" . " & vbCrLf & vbCrLf & " If you save any changes to a signed RDP file it will stop working. " & vbCrLf & vbCrLf & " Are you sure you want the RDP file to be signed? " , " Warning " , MessageBoxButtons . YesNo , MessageBoxIcon . Warning ) = DialogResult . Yes Then
CheckBoxSignRDPEnabled . Checked = True
2019-10-31 22:24:29 +01:00
Else
2019-11-10 12:51:14 +01:00
CheckBoxSignRDPEnabled . Checked = False
2019-10-31 22:24:29 +01:00
End If
End If
End Sub
Private Sub EditAfterSave_CheckedChanged ( sender As Object , e As EventArgs ) Handles EditAfterSave . CheckedChanged
2019-11-10 12:51:14 +01:00
If ( EditAfterSave . Checked And CheckBoxSignRDPEnabled . Checked ) Then
If MessageBox . Show ( " You have selected "" Sign RDP file "" and "" Manually edit RDP file "" . " & vbCrLf & vbCrLf & " If you save any changes to a signed RDP file it will stop working. " & vbCrLf & vbCrLf & " Are you sure you want to edit after saving? " , " Warning " , MessageBoxButtons . YesNo , MessageBoxIcon . Warning ) = DialogResult . Yes Then
EditAfterSave . Checked = True
2019-10-31 22:24:29 +01:00
Else
EditAfterSave . Checked = False
End If
End If
End Sub
2019-11-10 12:51:14 +01:00
Private Sub CheckBoxCreateSignedAndUnsigned_CheckedChanged ( sender As Object , e As EventArgs ) Handles CheckBoxCreateSignedAndUnsigned . CheckedChanged
If CheckBoxCreateSignedAndUnsigned . Checked = True Then
CheckBoxSignRDPEnabled . Checked = True
End If
End Sub
2019-09-29 14:45:23 +02:00
End Class