was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

28 Visitors Online


 
...die Liste der registrierten Win32 Module und deren Version(en) ermitteln?
Autor: Loïs Bégué
[ Tip ausdrucken ]  

Tip Bewertung (2):  
     


 { 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"
  müssen sich mit einer Versionsnummer in der registry eintragen.
  Zu einem bestimmten "Modul" können aber mehrere Versionen in der
  Registry eingetragen sein.
  Welche?

  Kernstück ist die rekursive Function "RecurseWin32", die ab einem
  bestimmten Pfad nach jedem Vorkommen des gesuchten Schlüssels 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 läßt sich übrigens an weiteren Bedürfnisse 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 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;


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


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners