remoteapptool/remoteapp-tool/LocalFtaModule.vb
2019-09-29 22:45:23 +10:00

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