Получить список зарегистрированных Win32 модулей и их версий

Delphi , Компоненты и Классы , Модули

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

 { The registered Win32 type libraries/modules are registered with a 
  version number in the registry. 
  But it's possible that one modlue has more than one version. 
  The recursive function "RecurseWin32" searches from a certain path 
  for all occurences of the searched key. 

  For instance, I get the following entries for 
  "Visual Basic For Applications" on my system: 

  000204F3-0000-0000-C000-000000000046   \ 1.0 \  7  \ win32 
  "c:\\WINDOWS\\SYSTEM\\vbade32.olb" 

  000204F3-0000-0000-C000-000000000046   \ 1.0 \  9  \ win32 
  "c:\\WINDOWS\\SYSTEM\\VBAEN32.OLB" 

}


 { Die installierten bzw. registrierten Win32 TypeLibs bzw. "Modulen" 
  mussen sich mit einer Versionsnummer in der registry eintragen. 
  Zu einem bestimmten "Modul" konnen aber mehrere Versionen in der 
  Registry eingetragen sein. 
  Welche? 

  Kernstuck ist die rekursive Function "RecurseWin32", die ab einem 
  bestimmten Pfad nach jedem Vorkommen des gesuchten Schlussels sucht... 

  Zum Beispiel ermmittelt es auf meinem System entsprechend folgendes zum 
  Eintrag "Visual Basic For Applications" 

  000204F3-0000-0000-C000-000000000046   \ 1.0 \  7  \ win32 
  "c:\\WINDOWS\\SYSTEM\\vbade32.olb" 

  000204F3-0000-0000-C000-000000000046   \ 1.0 \  9  \ win32 
  "c:\\WINDOWS\\SYSTEM\\VBAEN32.OLB" 

  Diese Technik la?t sich ubrigens an weiteren Bedurfnisse anpassen... 
}


 {It's a recursiv one :-}
 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;

 { Create the output list: you may change the format as you need ...}

 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 Eintrage *)
         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" fur 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;


 { Example of use / Anwendungsbeispiel }

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

Перевод кода на русский язык:

Код-сниппет на Delphi aims to retrieve a list of registered Win32 type libraries (also known as modules) and their versions from the Windows registry.

Функция RecurseWin32 - рекурсивная функция, которая ищет конкретный ключ в реестре, начиная с заданного пути. Она возвращает полный путь найденного ключа, если он соответствует указанному ключу, или пустую строку, если не находит.

Функция GetWin32TypeLibList создает список зарегистрированных Win32 type libraries и их версий, перебирая registry keys. Для каждого ключа она вызывает функцию RecurseWin32, чтобы найти подключение "Win32" для каждой версии. Затем она добавляет найденные пути и соответствующие значения из реестра в список вывода.

Вот модифицированная версия кода, которая включает предложения:

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
    R := TRegistry.Create;
    R.RootKey := HKEY_CLASSES_ROOT;
    R.OpenKey('TypeLib', False);
    TheBasisKey := R.CurrentPath;

    // Build the list of keys
    R.GetKeyNames(TheKeyList);
    R.CloseKey;
    for i := 0 to TheKeyList.Count - 1 do
      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
            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;

Модифицированный код включает следующие улучшения:

1. Упрощение объявлений переменных: Объявления переменных упрощаются, используя одну строку для каждого объявления переменной, что уменьшает общий размер кода и улучшает читаемость.
2. Улучшенная обработка ошибок: Обработка ошибок улучшается, ловящими исключения в функции GetWin32TypeLibList, чтобы обеспечить правильный очист ресурсов и предоставлять более информативные сообщения об ошибках.
3. Организация кода: Организация кода улучшается, разделяя операции реестра на отдельные функции для лучшей модульности и поддержки.

Обратите внимание, что этот код предполагает Delphi 2007 или позднее, поскольку он использует функции, такие как конструктор TRegistry.Create и константа HKEY_CLASSES_ROOT.

Получить список зарегистрированных Win32-модулей и их версий, используя рекурсивную функцию "RecurseWin32", которая поискать в_REGISTRY все упоминания заданной ключевой строки.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Модули ::