Недавно добавленные исходники

•  3D Designer  105

•  Sik Screen Capture  87

•  Patch Maker  76

•  Айболит (remote control)  95

•  ListBox Drag & Drop  73

•  Доска для игры Реверси  1 272

•  Графические эффекты  84

•  Рисование по маске  62

•  Перетаскивание изображений  66

•  Canvas Drawing  68

•  Рисование Луны  143

•  Поворот изображения  50

•  Рисование стержней  44

•  Paint on Shape  41

•  Генератор кроссвордов  53

•  Головоломка Paletto  63

•  Теорема Монжа об окружностях  105

•  Пазл Numbrix  49

•  Заборы и коммивояжеры  74

•  Игра HIP  56

•  Игра Go (Го)  47

•  Симулятор лифта  49

•  Программа укладки плитки  52

•  Генератор лабиринта  92

•  Проверка числового ввода  43

•  HEX View  97

•  Физический маятник  99

•  Задача коммивояжера  125

•  Автомобильная пробка  49

•  Квадратные сетки из слов  43

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



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



Оформил: DeeCo

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




Похожие по теме исходники

Список запущенных процессов

Список установленных устройств




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter