procedure ListRegisteredBrowsers(List: TStrings); var reg: TRegistry; ki: TRegKeyInfo; i: Integer; keyname: string; len: DWORD; path: string; appName: string; begin reg := TRegistry.Create; try reg.RootKey := HKEY_LOCAL_MACHINE; if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit; if not Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then raise Exception.Create('ListRegisteredBrowsers: Could not open registry key.'); if not reg.GetKeyInfo(ki) then raise Exception.Create('ListRegisteredBrowsers: Could not obtain registry key information.'); List.Clear; SetLength(keyname, len); for i := 0 to ki.NumSubKeys - 1 do begin len := ki.MaxSubKeyLen + 1; if RegEnumKeyEx(reg.CurrentKey, i, PChar(keyname), len, nil, nil, nil, nil) <> ERROR_SUCCESS then RaiseLastOSError; if reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + keyname, false) then appName := reg.ReadString(''); path := '\SOFTWARE\Clients\StartMenuInternet\' + copy(keyname,1,len) + '\shell\open\command'; if reg.OpenKey(path, false) then appName := appName + ' ('+reg.ReadString('')+')'; if appName <> '' then list.add(appName); Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true); end; finally reg.Free; end; end; //and function GetDefaultBrowser: string; var reg: TRegistry; path: string; begin result := ''; reg := TRegistry.Create; try reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then begin result := reg.ReadString(''); path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command'; if reg.OpenKey(path, false) then result := result + ' ('+reg.ReadString('')+')'; end else begin reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then begin result := reg.ReadString(''); path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command'; if reg.OpenKey(path, false) then result := result + ' ('+reg.ReadString('')+')'; end; end; reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + result, false) then begin result := reg.ReadString(''); path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command'; if reg.OpenKey(path, false) then result := result + ' ('+reg.ReadString('')+')'; end; finally reg.Free; end; end; //Test it: procedure TForm1.Button1Click(Sender: TObject); var sl: TStringList; i: Integer; DefBrw: string; begin DefBrw := GetDefaultBrowser; sl := TStringList.Create; try ListRegisteredBrowsers(sl); Memo1.Lines.BeginUpdate; for i := 0 to sl.Count - 1 do if SameText(sl[i], DefBrw) then Memo1.Lines.Add(sl[i] + ' (Default)') else Memo1.Lines.Add(sl[i]); Memo1.Lines.EndUpdate; finally sl.Free; end; end;
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter