Question

I have a function that counts registry items and added a new option to also retrieve the registry items names and values. Unfortunately I can’t seem to understand why only the first item for each registry key is retrieved and why the values all have the same name.

Anyone see any apparent problem with the code below?

function CountRegistryItems(Root: HKEY; SubKey: string; var KeysCount: Integer;
  var ValuesCount: Integer; GetValues: Boolean; const List: TStrings): Boolean;
type
  TRegKeyInfo = record
    NumSubKeys: Integer;
    MaxSubKeyLen: Integer;
    NumValues: Integer;
    MaxValueLen: Integer;
    MaxDataLen: Integer;
    FileTime: TFileTime;
  end;

var
  Info: TRegKeyInfo;
  i: integer;
  SL: TStringList;
  Status: Integer;
  Key: HKEY;
  Len: DWORD;
  S: string;

  PartialKeysCount: Integer;
  PartialValuesCount: Integer;

  KeyType, MaxValLen, MaxValNameLen, ValNameLen, ValLen: Cardinal;
  ValName, Val: PChar;

  Size: DWORD;
  ValueName: string;
begin
  KeysCount := 0;
  ValuesCount := 0;
  Result := False;

  if GetValues and (List <> nil) then
    List.BeginUpdate;

  SL := TStringList.Create;
  Try
    // open current key
    Status := RegOpenKeyEx(Root, PChar(SubKey), 0, KEY_READ or KEY_ENUMERATE_SUB_KEYS, Key);
    if Status = ERROR_SUCCESS then
    Try
      // get key info
      FillChar(Info, SizeOf(TRegKeyInfo), 0);
      Status := RegQueryInfoKey(Key, nil, nil, nil, @Info.NumSubKeys,
                @Info.MaxSubKeyLen, nil, @Info.NumValues, @Info.MaxValueLen,
                @Info.MaxDataLen, nil, @Info.FileTime);
      if Status  = ERROR_SUCCESS then
      begin
        Result := True;

        // NEW CODE
        if GetValues and (List <> nil) then
        begin
          MaxValNameLen := Info.MaxValueLen*2+3;
          MaxValLen := Info.MaxDataLen+1;
          // Get values
          GetMem(ValName, MaxValNameLen);
          GetMem(Val, MaxValLen);

          //if Info.NumValues <> 0 then
          for i := 0 to Info.NumValues-1 do
          begin
            // Clear buffers
            ValName^ := #0;
            ValNameLen := MaxValNameLen;
            if Val <> nil then
            begin
              Val^ := #0;
              ValLen := MaxValLen;
            end;

            // Get value information
            if RegEnumValue(Root, i, ValName, ValNameLen, nil, @KeyType,
              PByte(Val), @ValLen) = ERROR_SUCCESS then
            begin
              //if ((KeyType = REG_SZ) or (KeyType = REG_MULTI_SZ)
              //or (KeyType = REG_EXPAND_SZ)) then
              begin
                if ValName^ <> #0 then
                  List.Add(ValName + '=' + Val)
                else
                  List.Add('Default' + '=' + Val);
              end;
            end;
          end;
          // Free buffers
          //FreeMem(ValName);
          //if Val <> nil then FreeMem(Val);
        end;
        // END NEW CODE

        // enum subkeys
        SetString(S, nil, Info.MaxSubKeyLen + 1);
        for i := 0 to Info.NumSubKeys - 1 do
        begin
          Len := Info.MaxSubKeyLen + 1;
          Status := RegEnumKeyEx(Key, i, PChar(S), Len, nil, nil, nil, nil);
          if Status <> ERROR_SUCCESS then Continue;
          SL.Add(PChar(S));
        end;
      end;

      if Info.NumSubKeys > 0 then Inc(KeysCount, Info.NumSubKeys);
      if Info.NumValues > 0 then Inc(ValuesCount, Info.NumValues);

    Finally
      RegCloseKey(Key);
    End;

    // search subkeys
    if SL.Count > 0 then
    begin
      for i := 0 to SL.Count - 1 do
      begin
        Application.ProcessMessages;
        PartialKeysCount := 0;
        PartialValuesCount := 0;
        CountRegistryItems(Root, SubKey + '\' + SL[i], PartialKeysCount,
          PartialValuesCount, GetValues, List);
        KeysCount := KeysCount + PartialKeysCount;
        ValuesCount := ValuesCount + PartialValuesCount;
      end;
    end;

  Finally
    SL.Free;

    if GetValues and (List <> nil) then
      List.EndUpdate;
  End;
end;

Answer 1

You can use TRegistry:

uses Registry;

function CountRegistryItems(Root: HKEY;
                            SubKey: string;
                            var KeysCount: Integer;
                            var ValuesCount: Integer;
                            GetValues: Boolean;
                            const List: TStrings): Boolean;
var
  Reg : TRegistry;
  KeyInfo : TRegKeyInfo;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := Root;
    if Reg.OpenKey(SubKey,False) then
    begin
      Reg.GetKeyInfo(KeyInfo);
      ValuesCount := KeyInfo.NumValues;
      KeysCount := KeyInfo.NumSubKeys;
      if (GetValues) and (Assigned(List)) then
      begin
        List.Clear;
        Reg.GetValueNames(List);
      end;
    end;
    Result := True;
  finally
    Reg.Free;
  end;
end;