The following function fills a TString object with Name/Value pairs of protocol/description values.
If False passes as the CurrentUser parameter, only protocols registered for the current user will be listed. Otherwise, globally registered protocols will be retrieved. Therefore, to have all the protocols available to the user, you should call the function twice with different values for the CurrentUser parameter.
To make things easier, the function does not clear the list.
- Code: Select all
uses
Registry;
procedure FindUrlProtocols(List: TStrings; CurrentUser: Boolean);
var
R: TRegistry;
Keys: TStringList;
MainKey, SubKey: String;
I: Integer;
begin
List.BeginUpdate;
R := TRegistry.Create(KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS);
try
if CurrentUser then
begin
R.RootKey := HKEY_CURRENT_USER;
MainKey := '\Software\Classes';
end
else
begin
R.RootKey := HKEY_CLASSES_ROOT;
MainKey := '\';
end;
Keys := TStringList.Create;
try
if R.OpenKeyReadOnly(MainKey) then
begin
R.GetKeyNames(Keys);
R.CloseKey;
end;
for I := 0 to Keys.Count - 1 do
begin
SubKey := Keys[I];
if (PChar(SubKey)^ <> '.') and R.OpenKeyReadOnly(MainKey + '\' + SubKey) then
begin
if R.ValueExists('URL Protocol') then
List.Values[SubKey] := R.ReadString('');
R.CloseKey;
end;
end;
finally
Keys.Free;
end;
finally
R.Free;
end;
List.EndUpdate;
end;
Example of usage:
- Code: Select all
ListBox1.Items.Clear;
// Retrieve globally registered protocols
FindUrlProtocols(ListBox1.Items, False);
// Retrieve user protocols (user protocols have more precedence, so we overwrite the global ones)
FindUrlProtocols(ListBox1.Items, True);