Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Проблема обхода реестра Windows (TRegistry). [D5, Win2k]


mmn ©   (2004-05-27 15:06:00) 

Обхожу реестр рекурсивной процедурой такого вида:
procedure TForm1.ReadAllKeys(RootNode: string; NewNodeLevel: Cardinal);
var LocalSL: TStringList;
   i: Integer;
begin
 if MaxNodeLevel > 100 then Exit; // Это чтобы программа не работала бесконечно.
 LocalSL := TStringList.Create;
 try
   if not Reg.OpenKeyReadOnly(RootNode) then Exit;
   Reg.GetKeyNames(LocalSL);
   for i := 0 to LocalSL.Count - 1 do
   begin
     WriteLn(F,NewNodeLevel,' ',LocalSL[i]);
     if MaxNodeLevel < NewNodeLevel then MaxNodeLevel := NewNodeLevel;
     ReadAllKeys(RootNode + '\' + LocalSL[i],NewNodeLevel + 1);
   end;
   Reg.CloseKey;
 finally
   LocalSL.Free;
 end;
end;

В результате, когда выполнение программы прерывается из-за поставленного мной ограничения на 100 уровней вложений, в созданном файле вижу такую картину перечня просмотренных ключей реестра:

HKEY_LOCAL_MACHINE\SYSTEM\...\PrivateProperties\MIDI\Ports
HKEY_LOCAL_MACHINE\SYSTEM\...\PrivateProperties\MIDI\Ports\
HKEY_LOCAL_MACHINE\SYSTEM\...\PrivateProperties\MIDI\Ports\\
HKEY_LOCAL_MACHINE\SYSTEM\...\PrivateProperties\MIDI\Ports\\\
HKEY_LOCAL_MACHINE\SYSTEM\...\PrivateProperties\MIDI\Ports\\\\
и т.д. до бесконечности :(
Хотя, если посмотреть через Regedt32, ключ Ports содержит только 7 вложенных ключей.

Такая ситуация возникает каждый раз именно в этой ветке реестра. Все остальные проходятся без таких глюков.

На другом компьютере происходит то же самое, но под другим ключём.
Может кто-нибудь сталкивался с подобным и объяснит в чём тут дело?

mmn   (2004-06-01 16:35:00) [1]

Т.е. получается, что метод GetKeyNames компонента TRegistry в некоторых случаях срабатывает неправильно. И похоже из-за того, что в методе GetKeyInfo неправильно определяется значение максимальной длины имени ключа (MaxSubKeyLen). А вот почему это происходит я не понял.

NAlexey   (2004-06-01 14:31:00) [2]

Попробуй так:

procedure ProcessChilds(ParentNode: TRegistry);

 procedure InternalGetKeyNames(Strings: TStrings);
 var
   Len: DWORD;
   I: Integer;
   Info: TRegKeyInfo;
   S: string;
 begin
   Strings.Clear;
   if ParentNode.GetKeyInfo(Info) then
   begin
     SetString(S, nil, 255 + 1);
     for I := 0 to Info.NumSubKeys - 1 do
     begin
       Len := 255 + 1;
       RegEnumKeyEx(ParentNode.CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
       Strings.Add(PChar(S));
     end;
   end;
 end;

var
 I: Integer;
 sList: TStringList;
 Reg: TRegistry;
 CurrPath: string;
begin
 sList := TStringList.Create;
 try
   InternalGetKeyNames(sList);
   Reg := TRegistry.Create;
   try
     Reg.RootKey := HKEY_LOCAL_MACHINE;
     CurrPath := '';
     for I := 0 to sList.Count - 1 do
     begin
       if sList[I] = '' then
       begin
         ParentNode.GetKeyNames(sList);
         Continue;
       end;
       if ParentNode.CurrentPath = '' then
         CurrPath := '\' + sList[I]
       else
         CurrPath := '\' + ParentNode.CurrentPath + '\' + sList[I];
       if not Reg.OpenKeyReadOnly(CurrPath) then
         Continue;
       Form1.Memo1.Lines.Add(CurrPath);
       if Reg.HasSubKeys then
         ProcessChilds(Reg);
     end;
     Reg.CloseKey;
   finally
     Reg.Free;
   end;
 finally
   sList.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
begin
 Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if not Reg.OpenKeyReadOnly('System') then
     Exit;
   ProcessChilds(Reg);
   Reg.CloseKey;
 finally
   Reg.Free;
 end;
end;

NAlexey   (2004-06-01 14:10:00) [3]

>mmn   (27.05.04 16:55) [2]
Блин, чтото торможу, извини. Тоже не уловил в чем дело.

NAlexey   (2004-06-01 14:08:00) [4]

>mmn   (01.06.04 13:24) [8]
Да, я тоже напаролся на это когда весь реестр пробежал, потом подправил как сказал VMcL ©   (27.05.04 16:11) [1] .
И все нормально. Попробуй:

procedure ProcessChilds(ParentNode: TRegistry);
var
I: Integer;
sList: TStringList;
Reg: TRegistry;
CurrPath: string;
begin
sList := TStringList.Create;
try
  ParentNode.GetKeyNames(sList);
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    CurrPath := '';
    for I := 0 to sList.Count - 1 do
    begin
      if sList[I] = '' then
        Continue;
      if ParentNode.CurrentPath = '' then
        CurrPath := '\' + sList[I]
      else
        CurrPath := '\' + ParentNode.CurrentPath + '\' + sList[I];
      if not Reg.OpenKeyReadOnly(CurrPath) then
        Continue;
      Memo1.Lines.Add(CurrPath);
      if Reg.HasSubKeys then
        ProcessChilds(Reg);
    end;
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
finally
  sList.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if not Reg.OpenKeyReadOnly('') then
    Exit;
  ProcessChilds(Reg);
  Reg.CloseKey;
finally
  Reg.Free;
end;
end;

mmn   (2004-06-01 13:24:00) [5]

>> NAlexey
Попробовал.
Та же самая фигня, что и раньше, в том же самом ключе. Причём, я опять попробовал и на другом компьютере - и там то же самое (но в другом ключе).

NAlexey   (2004-06-01 11:58:00) [6]

Да вроде нормально все работает:

var
 Log : TextFile;

procedure LogFile(FileName, Msg: string);
begin
 {$I-}
 AssignFile(Log, FileName);
 Reset(Log);
 {$I+}
 if IOResult <> 0 then
 begin
   Rewrite(Log);
   Writeln(Log , Msg);
   Writeln(Log , '');
 end else
 begin
   Append(Log);
   Writeln(Log , Msg);
   Writeln( Log , '');
 end;
 CloseFile(Log);
end;

procedure ProcessChilds(ParentNode: TRegistry);
var
 I: Integer;
 sList: TStringList;
 Reg: TRegistry;
 CurrPath: string;
begin
 sList := TStringList.Create;
 try
   ParentNode.GetKeyNames(sList);
   Reg := TRegistry.Create;
   try
     Reg.RootKey := HKEY_LOCAL_MACHINE;
     CurrPath := '';
     for I := 0 to sList.Count - 1 do
     begin
       if ParentNode.CurrentPath = '' then
         CurrPath := '\' + sList[I]
       else
         CurrPath := '\' + ParentNode.CurrentPath + '\' + sList[I];
       if not Reg.OpenKeyReadOnly(CurrPath) then
         Continue;
       LogFile('C:\Reg.txt', CurrPath);
       if Reg.HasSubKeys then
         ProcessChilds(Reg);
     end;
     Reg.CloseKey;
   finally
     Reg.Free;
   end;
 finally
   sList.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
begin
 Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if not Reg.OpenKeyReadOnly('') then
     Exit;
   ProcessChilds(Reg);
   Reg.CloseKey;
 finally
   Reg.Free;
 end;
end;

mmn   (2004-06-01 09:26:00) [7]

А просто через функции API без использования TRegistry таких глюков не возникло. Просто так сказал.

mmn   (2004-05-31 10:27:00) [8]

>> Cobalt
> Обяви Reg как локальную переменную процедуры.


Результат не изменился.

Cobalt   (2004-05-31 09:56:00) [9]

Обяви Regкак локальную переменную процедуры.
Ты же её в конце процедуры киляешь! вот и создавай в начале процедуры.
А так она у тебя получается общей на сотню уровней вложенности.

mmn   (2004-05-31 09:16:00) [10]

Или я чего-то не понимаю, или одно из двух.
Попробовал обход не через компонент TRegistry, а через функции API. Начинаю работу с реестром так:

i := RegOpenKeyEx(HKEY_LOCAL_MACHINE,'',0,KEY_ENUMERATE_SUB_KEYS,RootKey);
if i <> ERROR_SUCCESS then Exit;
i := 0;
while RegEnumKeyEx(RootKey,i,PChar(KName),KNSize,nil,nil,nil,nil) <> ERROR_NO_MORE_ITEMS do
begin
 SL.Add(KName);
 Inc(i);
end;

В компонент SL (который TStringList) заносятся пустые строчки, но их количество совпадает с числом существующих ключей. Кто-нибудь подскажет как это понимать?

mmn   (2004-05-27 16:55:00) [11]

>> VMcL
Пустые значения имён я таким образом отсекал.
В результате таких цепочек пустых ключей не выводилось, но и тех вложенных ключей, которые видны при просмотре через Regedt32, тоже не обнаруживалось.

VMcL   (2004-05-27 16:11:00) [12]

>> mmn  (27.05.04 15:06)

Попробуй так:

procedure TForm1.ReadAllKeys(RootNode: string; NewNodeLevel: Cardinal);
var LocalSL: TStringList;
 i: Integer;
begin
if MaxNodeLevel > 100 then Exit; // Это чтобы программа не работала бесконечно.
LocalSL := TStringList.Create;
try
 if not Reg.OpenKeyReadOnly(RootNode) then Exit;
 Reg.GetKeyNames(LocalSL);
 for i := 0 to LocalSL.Count - 1 do
 begin
  if LocalSL[i] = '' then Continue;

  WriteLn(F,NewNodeLevel,' ',LocalSL[i]);
  if MaxNodeLevel < NewNodeLevel then MaxNodeLevel := NewNodeLevel;
  ReadAllKeys(RootNode + '\' + LocalSL[i],NewNodeLevel + 1);
 end;
 Reg.CloseKey;
finally
 LocalSL.Free;
end;
end;

Наверх

Титульная страница Поиск, карта сайта Написать письмо