VB 5/6-Tipp 0779: Standard-Browser ermitteln
von Fieber
Beschreibung
Standard-Browser ermitteln für alle Windows-Versionen (Inklusive Windows 10)
Schwierigkeitsgrad: | Verwendete API-Aufrufe: RegCloseKey, RegOpenKeyA (RegOpenKey), RegOpenKeyExA (RegOpenKeyEx), RegQueryValueExA (RegQueryValueEx), ShellExecuteA (ShellExecute) | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Beschriftungsfeld "Label3" ' Steuerelement: Beschriftungsfeld "Label2" ' Steuerelement: Beschriftungsfeld "Label1" Option Explicit Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long '-- Standard Browser ermitteln Private Sub Command1_Click() Dim sBrowserName As String, sPathName As String, sHTTPName As String If GetDefaultBrowser(sBrowserName, sPathName, sHTTPName) Then Label1.Caption = "Name -> " & sBrowserName Label2.Caption = "Path -> " & sPathName Label3.Caption = "HTTP-Type -> " & sHTTPName Else Label1.Caption = "Kein Standard-Browser gefunden" End If End Sub '-- Standard Browser zur Überprüfung starten Private Sub Command2_Click() Dim pth$ pth = "http://www.google.de" Call ShellExecute(Me.hWnd, "Open", pth, "", App.Path, 0) End Sub Private Sub Form_Load() Me.Caption = " Standard Browser ermitteln" Command1.Caption = "Ermitteln" Command2.Caption = "Prüfen" Command1.ToolTipText = "Standard Browser ermitteln" Command2.ToolTipText = "Standard Browser zur Überprüfung starten" End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '--- Anfang Modul "ModStBrowser" alias ModStandardBrowser.bas --- ' Vielen Dank auch an OlimilO und BAGZZlash von http://www.activevb.de ' Ohne Sie wäre dieser Code nicht möglich gewesen!!! Option Explicit Private Declare Function RegOpenKey Lib "advapi32.dll" _ Alias "RegOpenKeyA" ( _ ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _ Alias "RegOpenKeyExA" ( _ ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" ( _ ByVal hKey As Long, ByVal lpValueName As String, _ ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Const HKEY_CURRENT_USER = &H80000001 Private Const HKEY_CLASSES_ROOT As Long = &H80000000 Private Const REG_SZ = 1 Private Const KEY_QUERY_VALUE As Long = &H1 Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 Private Const KEY_NOTIFY As Long = &H10 Private Const KEY_READ As Long = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Private Const ERROR_SUCCESS = 0& Public Function GetDefaultBrowser(sBrowserName As String, sBrowserPath As String, sHTTPType As String) As Boolean Dim sHTTP As String sHTTP = GetHTTPType() '-- Fehlerbehandlung für WinXP und früher... If Len(sHTTP) = 0 Then sHTTP = "HTTP" sHTTPType = sHTTP sBrowserPath = GetBrowserPath(sHTTP) sBrowserName = sHTTP '-- Hier könnte man Tipp 0199 oder so zur weiteren Fehlerbehandlung anschließen. ' If Len(sBrowserPath) = 0 Then ' sHTTPType = "File" ' sBrowserPath = GetDefaultBrowserFormFile(sHTTP) ' sBrowserName = sHTTP ' End If If Len(sBrowserPath) > 0 Then GetDefaultBrowser = True End Function Private Function GetBrowserPath(Browser As String) As String Dim Result As Long Dim hKey As Long Dim dwType As Long Dim l As Long Dim Buffer As String On Error Goto BrowserErr 'Wert aus dem Feld der Registry auslesen Result = RegOpenKeyEx(HKEY_CLASSES_ROOT, Browser & "\shell\open\command", 0, KEY_READ, hKey) If Result = ERROR_SUCCESS Then Result = RegQueryValueEx(hKey, "", 0&, dwType, ByVal 0&, l) If Result = ERROR_SUCCESS Then If dwType = REG_SZ Then ' Wert auslesen Buffer = Space$(l + 1) Result = RegQueryValueEx(hKey, "", 0&, dwType, ByVal Buffer, l) Buffer = Trim(Buffer) ' Anführungszeichen entfernen Buffer = Replace(Buffer, """", "") ' Parameter entfernen... Buffer = (Left(Buffer, (InStr(1, Buffer, ".exe", vbTextCompare) + 4))) Buffer = Trim(Left$(Buffer, l - 1)) 'BrowserName festlegen (Unten) Browser = GetBrowserName(Buffer) Else Goto BrowserErr End If Else Goto BrowserErr End If Else Goto BrowserErr End If RegCloseKey hKey GetBrowserPath = Buffer Exit Function BrowserErr: On Error Goto 0 RegCloseKey hKey GetBrowserPath = "" End Function Private Function GetHTTPType() As String Dim Result As Long Dim hKey As Long Dim dwType As Long Dim l As Long Dim Buffer As String 'Wert aus dem Feld der Registry auslesen Result = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice", 0, KEY_READ, hKey) If Result = ERROR_SUCCESS Then Result = RegQueryValueEx(hKey, "Progid", 0&, dwType, ByVal 0&, l) If Result = ERROR_SUCCESS Then If dwType = REG_SZ Then Buffer = Space$(l + 1) Result = RegQueryValueEx(hKey, "Progid", 0&, dwType, ByVal Buffer, l) Buffer = Trim(Buffer) Buffer = Left(Buffer, Len(Buffer) - 1) End If Else Buffer = "" End If Else Buffer = "" End If RegCloseKey hKey GetHTTPType = Buffer End Function Private Function GetBrowserName(Buffer As String) As String If Buffer <> "" Then If InStr(LCase$(Buffer), "iexplore") > 0 Then GetBrowserName = "Microsoft Internet Explorer" ElseIf InStr(LCase$(Buffer), "netscape") > 0 Then GetBrowserName = "Netscape Communicator" ElseIf InStr(LCase$(Buffer), "firefox") > 0 Then GetBrowserName = "Mozilla Firefox" ElseIf InStr(LCase$(Buffer), "opera") > 0 Then GetBrowserName = "Opera Browser" ElseIf InStr(LCase$(Buffer), "chrome") > 0 Then GetBrowserName = "Google Chrome" ElseIf InStr(LCase$(Buffer), "launchwinapp") > 0 Then GetBrowserName = "Microsoft Edge" Else GetBrowserName = "Unbekannter Browser" End If End If End Function '--- Ende Modul "ModStBrowser" alias ModStandardBrowser.bas --- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.