Public Class RemoteAppCollection Inherits System.Collections.CollectionBase Public Sub Add(RemoteApp As RemoteApp) List.Add(RemoteApp) End Sub Public Sub Remove(RemoteApp As RemoteApp) List.Remove(RemoteApp) End Sub End Class Public Class RemoteApp Public Name As String Public FullName As String Public Path As String Public VPath As String Public IconPath As String Public IconIndex As Integer = 0 Public CommandLine As String = "" Public CommandLineOption As Integer = 1 Public TSWA As Boolean = False Public FileTypeAssociations As FileTypeAssociationCollection End Class Public Class FileTypeAssociation Public Extension As String Public IconPath As String Public IconIndex As String End Class Public Class FileTypeAssociationCollection Inherits System.Collections.CollectionBase Public Sub Add(FileTypeAssociation As FileTypeAssociation) List.Add(FileTypeAssociation) End Sub Public Sub Remove(FileTypeAssociation As FileTypeAssociation) List.Remove(FileTypeAssociation) End Sub Public Function GetFlatFileTypes() As String GetFlatFileTypes = "" If List.Count > 0 Then For Each listItem As FileTypeAssociation In List GetFlatFileTypes += ",." & listItem.Extension Next GetFlatFileTypes = GetFlatFileTypes.Substring(1) End If End Function End Class Public Class IconSelection Public IconPath As String Public IconIndex As String End Class Public Class SystemRemoteApps Private Legacy32bit As Boolean = False Private RegistryPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\TSAppAllowList\Applications" Private BaseKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(RegistryPath) Private BaseKeyWrite As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(RegistryPath, True) Public Sub Init() Dim RegistryPathCV As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\" Dim cvKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(RegistryPathCV, True) Dim tsKey As Microsoft.Win32.RegistryKey = cvKey.CreateSubKey("Terminal Server") Dim tsaaKey As Microsoft.Win32.RegistryKey = tsKey.CreateSubKey("TSAppAllowList") Dim appKey As Microsoft.Win32.RegistryKey = tsaaKey.CreateSubKey("Applications") End Sub Public Function GetAll() As RemoteAppCollection Dim SystemAppCollection As New RemoteAppCollection For Each App As String In BaseKey.GetSubKeyNames Dim RemoteApp As New RemoteApp RemoteApp = GetApp(App) SystemAppCollection.Add(RemoteApp) Next BaseKey.Close() Return SystemAppCollection End Function Function GetApp(Name As String) As RemoteApp Dim App As New RemoteApp Dim AppKey As Microsoft.Win32.RegistryKey = BaseKey.OpenSubKey(Name) If AppKey Is Nothing Then Return Nothing App.Name = Name App.FullName = AppKey.GetValue("Name", "") App.Path = AppKey.GetValue("Path", "") App.VPath = AppKey.GetValue("VPath", "") App.CommandLine = AppKey.GetValue("RequiredCommandLine", "") App.CommandLineOption = AppKey.GetValue("CommandLineSetting", "1") App.IconPath = AppKey.GetValue("IconPath", "") App.IconIndex = AppKey.GetValue("IconIndex", 0) App.TSWA = AppKey.GetValue("ShowInTSWA", 0) Dim FTAKey As Microsoft.Win32.RegistryKey = AppKey.OpenSubKey("Filetypes") If Not FTAKey Is Nothing Then Dim FTACol As New FileTypeAssociationCollection For Each FTAValueName As String In FTAKey.GetValueNames Dim FTA As New FileTypeAssociation Dim FTAValue = FTAKey.GetValue(FTAValueName).ToString.Split(",") FTA.Extension = FTAValueName FTA.IconPath = FTAValue(0) FTA.IconIndex = Val(FTAValue(1)) FTACol.Add(FTA) Next App.FileTypeAssociations = FTACol End If Return App End Function Public Sub SaveApp(RemoteApp As RemoteApp) BaseKeyWrite.CreateSubKey(RemoteApp.Name) Dim AppKey As Microsoft.Win32.RegistryKey = BaseKey.OpenSubKey(RemoteApp.Name, True) AppKey.SetValue("Name", RemoteApp.FullName, Microsoft.Win32.RegistryValueKind.String) AppKey.SetValue("Path", RemoteApp.Path, Microsoft.Win32.RegistryValueKind.String) AppKey.SetValue("VPath", RemoteApp.VPath, Microsoft.Win32.RegistryValueKind.String) AppKey.SetValue("RequiredCommandLine", RemoteApp.CommandLine, Microsoft.Win32.RegistryValueKind.String) AppKey.SetValue("CommandLineSetting", RemoteApp.CommandLineOption, Microsoft.Win32.RegistryValueKind.DWord) AppKey.SetValue("IconPath", RemoteApp.IconPath, Microsoft.Win32.RegistryValueKind.String) AppKey.SetValue("IconIndex", RemoteApp.IconIndex, Microsoft.Win32.RegistryValueKind.DWord) AppKey.SetValue("ShowInTSWA", RemoteApp.TSWA, Microsoft.Win32.RegistryValueKind.DWord) If Not RemoteApp.FileTypeAssociations Is Nothing Then If Not AppKey.OpenSubKey("Filetypes") Is Nothing Then AppKey.DeleteSubKeyTree("Filetypes") AppKey.CreateSubKey("Filetypes") Dim FTAKey = AppKey.OpenSubKey("Filetypes", True) For Each fta As FileTypeAssociation In RemoteApp.FileTypeAssociations FTAKey.SetValue(fta.Extension, fta.IconPath & "," & fta.IconIndex.ToString, Microsoft.Win32.RegistryValueKind.String) Next End If End Sub Public Sub DuplicateApp(Name As String) Dim NewApp = GetApp(Name) Dim NewName = NewApp.Name While GetApp(NewName) IsNot Nothing NewName = NewName & " copy" End While NewApp.Name = NewName SaveApp(NewApp) End Sub Public Sub RenameApp(RemoteAppOldName As String, RemoteAppNewName As String) Dim App As New RemoteApp Dim SystemApps As New SystemRemoteApps App = SystemApps.GetApp(RemoteAppOldName) DeleteApp(RemoteAppOldName) App.Name = RemoteAppNewName SaveApp(App) End Sub Public Sub DeleteApp(Name As String) BaseKeyWrite.DeleteSubKeyTree(Name) End Sub Public Property WoW6432Node As Boolean Get Return Legacy32bit End Get Set(value As Boolean) Legacy32bit = value Dim PathStart As String = "SOFTWARE" If Legacy32bit = True Then PathStart = "SOFTWARE\Wow6432Node" RegistryPath = PathStart & "\Microsoft\Windows NT\CurrentVersion\Terminal Server\TSAppAllowList\Applications" End Set End Property End Class