Get a list of the registered Win32 Modules and their version (s)?
Author: Lo?s Bégué Author: Lois Bégué
[ Print tip ] [ Print tip ]

Tip Rating (1): Tip Rating (1):

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

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

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

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

} }



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