Delphi/Windows: List all available web browsers on system

PHOTO EMBED

Mon Aug 29 2022 20:58:40 GMT+0000 (UTC)

Saved by @marcopinero #delphi

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;
content_copyCOPY