Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'A class for changing the WebBrowser control's document emulation.
- 'Written by Visual Vincent, 2017.
- Imports Microsoft.Win32
- Imports System.Security
- Imports System.Windows.Forms
- ' InternetExplorer.SetLatestBrowserEmulation(InternetExplorer.RegistryRoot.HKEY_LOCAL_MACHINE)
- 'HKEY_CURRENT_USER is recommended if you do not want to run your application with administrative privileges.
- 'InternetExplorer.SetLatestBrowserEmulation(InternetExplorer.RegistryRoot.HKEY_CURRENT_USER)
- Public NotInheritable Class InternetExplorer
- Private Sub New()
- End Sub
- Public Const InternetExplorerRootKey As String = "Software\Microsoft\Internet Explorer"
- Public Const BrowserEmulationKey As String = InternetExplorerRootKey & "\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION"
- Public Const ActiveXObjectCachingKey As String = InternetExplorerRootKey & "\MAIN\FeatureControl\FEATURE_OBJECT_CACHING"
- Private Shared ReadOnly WebBrowserInstance As New WebBrowser 'Used to get the current IE version in a .NET-friendly manner.
- Public Enum BrowserEmulation As Integer
- IE7 = 7000
- IE8 = 8000
- IE8Standards = 8888
- IE9 = 9000
- IE9Standards = 9999
- IE10 = 10000
- IE10Standards = 10001
- IE11 = 11000
- IE11Edge = 11001
- End Enum
- Public Shared Sub SetLatestBrowserEmulation(ByVal Root As RegistryRoot)
- Dim Emulation As BrowserEmulation = BrowserEmulation.IE7
- Select Case WebBrowserInstance.Version.Major
- Case Is >= 11 : Emulation = BrowserEmulation.IE11Edge
- Case 10 : Emulation = BrowserEmulation.IE10Standards
- Case 9 : Emulation = BrowserEmulation.IE9Standards
- Case 8 : Emulation = BrowserEmulation.IE8Standards
- End Select
- InternetExplorer.SetBrowserEmulation(Root, Emulation)
- End Sub
- Public Shared Sub SetBrowserEmulation(ByVal Root As RegistryRoot, ByVal Emulation As BrowserEmulation)
- Using RootKey As RegistryKey = Root.Root
- Dim EmulationKey As RegistryKey = RootKey.OpenSubKey(BrowserEmulationKey, True)
- If EmulationKey Is Nothing Then EmulationKey = RootKey.CreateSubKey(BrowserEmulationKey, RegistryKeyPermissionCheck.ReadWriteSubTree)
- Using EmulationKey
- EmulationKey.SetValue(Process.GetCurrentProcess().ProcessName & ".exe", CType(Emulation, Integer), RegistryValueKind.DWord)
- End Using
- End Using
- End Sub
- Public Shared Sub SetActiveXObjectCaching(ByVal Root As RegistryRoot, ByVal Enabled As Boolean)
- Using RootKey As RegistryKey = Root.Root
- Dim ObjectCachingKey As RegistryKey = RootKey.OpenSubKey(ActiveXObjectCachingKey, True)
- If ObjectCachingKey Is Nothing Then ObjectCachingKey = RootKey.CreateSubKey(ActiveXObjectCachingKey, RegistryKeyPermissionCheck.ReadWriteSubTree)
- Using ObjectCachingKey
- ObjectCachingKey.SetValue(Process.GetCurrentProcess().ProcessName & ".exe", CType(If(Enabled, 1, 0), Integer), RegistryValueKind.DWord)
- End Using
- End Using
- End Sub
- Public NotInheritable Class RegistryRoot
- Private _root As RegistryKey
- Public ReadOnly Property Root As RegistryKey
- Get
- Return _root
- End Get
- End Property
- Public Shared ReadOnly Property HKEY_LOCAL_MACHINE As RegistryRoot
- Get
- Return New RegistryRoot(Registry.LocalMachine)
- End Get
- End Property
- Public Shared ReadOnly Property HKEY_CURRENT_USER As RegistryRoot
- Get
- Return New RegistryRoot(Registry.CurrentUser)
- End Get
- End Property
- Private Sub New(ByVal Root As RegistryKey)
- Me._root = Root
- End Sub
- End Class
- End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement