mirror of
https://github.com/kimmknight/remoteapptool.git
synced 2024-11-13 21:58:21 +00:00
132 lines
5.6 KiB
VB.net
132 lines
5.6 KiB
VB.net
Imports RemoteAppLib
|
|
|
|
Module LocalFtaModule
|
|
|
|
Public Sub RemoveUnusedFTAs()
|
|
Dim KeyNames = My.Computer.Registry.ClassesRoot().GetSubKeyNames
|
|
Dim RemoveCount As Integer = 0
|
|
|
|
For Each KeyName In KeyNames
|
|
Dim FTAkey As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot.OpenSubKey(KeyName)
|
|
Dim RAvalue As String = FTAkey.GetValue("RemoteApp", "")
|
|
If Not RAvalue = "" Then
|
|
For Each KeyName2 In KeyNames
|
|
Try
|
|
Dim FTkey As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot.OpenSubKey(KeyName2)
|
|
Dim FTvalue As String = FTkey.GetValue("", "")
|
|
If FTvalue = KeyName Then
|
|
Dim sra As New RemoteAppLib.SystemRemoteApps
|
|
Dim AppExists As Boolean = False
|
|
For Each app As RemoteAppLib.RemoteApp In sra.GetAll
|
|
If app.Name = GetAppForFTA(KeyName2) Then AppExists = True
|
|
Next
|
|
If Not AppExists Then
|
|
LocalFtaModule.DeleteFTA(KeyName2)
|
|
RemoveCount += 1
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Next
|
|
End If
|
|
Next
|
|
|
|
MessageBox.Show("Unused file type associations removed: " & RemoveCount, "File Type Association", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
|
End Sub
|
|
|
|
Public Function CreateFTACollection(ftaCol As FileTypeAssociationCollection, exeFile As String, RemoteAppName As String, Optional overwrite As Boolean = False) As String
|
|
CreateFTACollection = ""
|
|
For Each fta As FileTypeAssociation In ftaCol
|
|
If DoesFTAExist(fta.Extension) And CreateFTA(fta, exeFile, RemoteAppName, overwrite) = False Then
|
|
CreateFTACollection += "|" & fta.Extension
|
|
End If
|
|
Next
|
|
CreateFTACollection = CreateFTACollection.Trim("|")
|
|
End Function
|
|
|
|
Public Function CreateFTA(fta As FileTypeAssociation, exeFile As String, RemoteAppName As String, Optional overwrite As Boolean = False) As Boolean
|
|
If DoesFTAExist(fta.Extension) = False Or overwrite = True Then
|
|
DeleteFTA(fta.Extension)
|
|
|
|
Dim FileTypeReg = My.Computer.Registry.ClassesRoot.CreateSubKey("." & fta.Extension)
|
|
FileTypeReg.SetValue("", fta.Extension & "_file")
|
|
|
|
Dim FileTypeKey = My.Computer.Registry.ClassesRoot.CreateSubKey(fta.Extension & "_file")
|
|
FileTypeKey.SetValue("RemoteApp", RemoteAppName)
|
|
|
|
Dim FileTypeKeyShell = FileTypeKey.CreateSubKey("shell")
|
|
Dim FileTypeKeyShellOpen = FileTypeKeyShell.CreateSubKey("open")
|
|
Dim FileTypeKeyShellOpenCommand = FileTypeKeyShellOpen.CreateSubKey("command")
|
|
|
|
FileTypeKeyShellOpenCommand.SetValue("", """" & exeFile & """ ""%1""")
|
|
|
|
Dim FileTypeKeyDefIcon = FileTypeKey.CreateSubKey("DefaultIcon")
|
|
FileTypeKeyDefIcon.SetValue("", """" & fta.IconPath & """," & fta.IconIndex)
|
|
CreateFTA = True
|
|
Else
|
|
CreateFTA = False
|
|
End If
|
|
End Function
|
|
|
|
Public Function GetAppForFTA(fileExtension As String) As String
|
|
fileExtension = fileExtension.TrimStart(".")
|
|
GetAppForFTA = ""
|
|
|
|
If DoesFTAExist(fileExtension) And IsFTAMine(fileExtension) Then
|
|
Try
|
|
Dim HKCRext As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot().OpenSubKey("." & fileExtension)
|
|
Dim HKCRfta = HKCRext.GetValue("", "")
|
|
If Not HKCRfta = "" Then
|
|
Dim HKCRftaKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot().OpenSubKey(HKCRfta)
|
|
GetAppForFTA = HKCRftaKey.GetValue("RemoteApp", "")
|
|
End If
|
|
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
End If
|
|
End Function
|
|
|
|
Public Sub DeleteFTA(fileExtension As String)
|
|
fileExtension = fileExtension.TrimStart(".")
|
|
If Not My.Computer.Registry.ClassesRoot.OpenSubKey("." & fileExtension) Is Nothing Then _
|
|
My.Computer.Registry.ClassesRoot.DeleteSubKeyTree("." & fileExtension)
|
|
|
|
If Not My.Computer.Registry.ClassesRoot.OpenSubKey(fileExtension & "_file") Is Nothing Then _
|
|
My.Computer.Registry.ClassesRoot.DeleteSubKeyTree(fileExtension & "_file")
|
|
End Sub
|
|
|
|
Public Function DoesFTAExist(fileExtension As String) As Boolean
|
|
fileExtension = fileExtension.TrimStart(".")
|
|
Dim FTAexists As Boolean = False
|
|
Dim HKCRext As String = ""
|
|
Try
|
|
HKCRext = My.Computer.Registry.ClassesRoot().OpenSubKey("." & fileExtension).ToString
|
|
FTAexists = True
|
|
Catch ex As Exception
|
|
End Try
|
|
Return FTAexists
|
|
End Function
|
|
|
|
Public Function IsFTAMine(fileExtension As String) As Boolean
|
|
fileExtension = fileExtension.TrimStart(".")
|
|
IsFTAMine = False
|
|
Try
|
|
Dim HKCRext As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot().OpenSubKey("." & fileExtension)
|
|
Dim HKCRfta = HKCRext.GetValue("", "")
|
|
If Not HKCRfta = "" Then
|
|
Dim HKCRftaKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot().OpenSubKey(HKCRfta)
|
|
If Not HKCRftaKey.GetValue("RemoteApp", "") = "" Then IsFTAMine = True
|
|
End If
|
|
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
End Function
|
|
|
|
End Module
|