Get List & Version from Registry Modules

uses Registry

//

function RecurseWin32(const R: TRegistry; const ThePath: string;
  const TheKey: string): string;
var
  TheList: TStringList;
  i: Integer;
  LP: string;
  OnceUponATime: string;
begin
  Result  := '-';
  TheList := TStringList.Create;
  try
    R.OpenKey(ThePath, False);
    R.GetKeyNames(TheList);
    R.CloseKey;
    if TheList.Count = 0 then Exit;
    for i := 0 to TheList.Count - 1 do with TheList do
      begin
        LP := ThePath + '\' + TheList[i];
        if CompareText(Strings[i], TheKey) = 0 then
        begin
          Result := LP;
          Break;
        end;
        OnceUponATime := RecurseWin32(R, LP, TheKey);
        if OnceUponATime <> '-' then
        begin
          Result := OnceUponATime;
          Break;
        end;
      end;
  finally
    TheList.Clear;
    TheList.Free;
  end;
end;

function GetWin32TypeLibList(var Lines: TStringList): Boolean;
var 
  R: TRegistry;
  W32: string;
  i, j, TheIntValue, TheSizeOfTheIntValue: Integer;
  TheSearchedValue, TheSearchedValueString: string;
  TheVersionList, TheKeyList: TStringList;
  TheBasisKey: string;
begin
  Result := True;
  try
    try
      R          := TRegistry.Create;
      TheVersionList := TStringList.Create;
      TheKeyList := TStringList.Create;

      R.RootKey := HKEY_CLASSES_ROOT;
      R.OpenKey('TypeLib', False);
      TheBasisKey := R.CurrentPath;

      (* Basis Informations *)
      case R.GetDataType('') of
        rdUnknown: ShowMessage('Nothing ???');
        rdExpandString, rdString: TheSearchedValueString := R.ReadString('');
        rdInteger: TheIntValue         := R.ReadInteger('');
        rdBinary: TheSizeOfTheIntValue := R.GetDataSize('');
      end;
      (* Build the List of Keys *)
      R.GetKeyNames(TheKeyList);
      R.CloseKey;
      ShowMessage(TheKeyList.Strings[1]);
      for i := 0 to TheKeyList.Count - 1 do
         (* Loop around the typelib entries)
         (* Schleife um die TypeLib Einträge *)
        with TheKeyList do
          if Length(Strings[i]) > 0 then 
          begin
            R.OpenKey(TheBasisKey + '\' + Strings[i], False);
            TheVersionList.Clear;
            R.GetKeyNames(TheVersionList);
            R.CloseKey;
            (* Find "Win32" for each version *)
            (* Finde der "win32" für jede VersionVersion:*)
            for j := 0 to TheVersionList.Count - 1 do
              if Length(TheVersionList.Strings[j]) > 0 then 
              begin
                W32 := RecurseWin32(R, TheBasisKey + '\' +
                  Strings[i] + '\' +
                  TheVersionList.Strings[j],
                  'Win32');
                if W32 <> '-' then 
                begin
                  Lines.Add(W32);
                  R.OpenKey(W32, False);
                  case R.GetDataType('') of
                    rdExpandString,
                    rdString: TheSearchedValue := R.ReadString('');
                    else
                      TheSearchedValue := 'Nothing !!!';
                  end;
                  R.CloseKey;
                  Lines.Add('-----> ' + TheSearchedValue);
                end;
              end;
          end;
    finally
      TheVersionList.Free;
      TheKeyList.Free;
    end;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  L: TStringList;
begin
  L := TStringList.Create;
  GetWin32TypeLibList(L);
  Memo1.Lines.Assign(L);
  L.Free;
end;