Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > поиск ключа в regedit

Автор: Витаминка 26.1.2007, 21:39

Привет! Как осуществить поиск по реестору зная имя и тип ключа с помощью Делфи?

Автор: Данкинг 26.1.2007, 21:45

В смысле? Открыть ветку? Вот пример из моей проги:

Код


uses registry;
...
procedure reg;
var
  Reg: TRegistry;

begin
with Reg do
   begin
     Reg := TRegistry.Create;
     RootKey := HKEY_LOCAL_MACHINE;
     OpenKey('Software\Lepidoptera\', True);
     if valueexists('color_body') then form1.Color:=stringtocolor(Readstring ('color_body'));
 end;

Автор: Sunvas 26.1.2007, 21:48

Рекурсия + код Данкинг-а поможет.

Автор: Витаминка 26.1.2007, 22:00

Цитата(Sunvas @ 26.1.2007, 21:48)

Рекурсия + код Данкинг-а поможет.

а можеть есть реальные примеры какие, поисковики молчат(

Автор: Данкинг 26.1.2007, 22:02

В смысле, реальные примеры? Вот я реальный привёл, могу весь текст выложить. smile

Автор: Витаминка 26.1.2007, 22:17

Думаю врятли мне поможет весь текст, я знаю название стрингово парметра, но незнаю путь до него, мне надо задать имя параметра и первый найденный путь каторый идёт до параметра с заданым мной именем записался в переменную

Автор: RA 26.1.2007, 22:23

Вот роуз на тему написал програмку, можно скачать с исходником http://rouse.drkb.ru/other.php#regfind

Автор: Витаминка 26.1.2007, 22:39

Спасибо, это то что надо

Автор: Витаминка 29.1.2007, 19:38

Вот переделала софтинку под себя, но никак не могу разобраться в причине этой ошибки Failed to set data for 'xxx' Если несложно, то поясните что ни так, вот кодесы, правда я так доконца в них и неразобралась как осуществляется поиск, если не лень то прокомментируйте пжлста

Код


procedure TfrmRegistryChecker.FormDestroy(Sender: TObject);
begin
  FReg.Free;
end;

procedure TfrmRegistryChecker.Scan(Key: String);
var
  S: TStringList;
  I: Integer;
begin
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_USERS;
  if FReg.OpenKeyReadOnly(Key) then
  try
    S := TStringList.Create;
    try
      FReg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        IsValidData(Key, S.Strings[I]);
      end;
      S.Clear;
      FReg.GetKeyNames(S);
      for I := 0 to S.Count - 1 do
        if S.Strings[I] <> '' then
          Scan(Key + '\' + S.Strings[I]);

    finally
      S.Free;
    end;
  finally
    FReg.CloseKey;
  end;
end;

procedure TfrmRegistryChecker.btnFindClick(Sender: TObject);
begin
  Scan('');
end;


procedure TfrmRegistryChecker.IsValidData(const AKey, AValue: String);
begin
      if Pos('xxx', AValue) > 0 then // xxx -  имя параметра в ключе
        begin
          Memo1.Lines.Add(AKey);
          FReg.OpenKey(AKey, true);
          FReg.WriteString('xxx', '1111'); 
        end;
end;

Автор: Sunvas 29.1.2007, 19:48

Цитата(Витаминка @ 29.1.2007, 19:38

)

Failed to set data for 'xxx'

Скорее всего прав нет. Или пропущена строка

Код


FReg.RootKey := HKEY_USERS;

Автор: Витаминка 29.1.2007, 19:54

Цитата(Sunvas @ 29.1.2007, 19:48)

Цитата(Витаминка @ 29.1.2007, 19:38

)

Failed to set data for 'xxx'

Скорее всего прав нет. Или пропущена строка

Код


FReg.RootKey := HKEY_USERS;

Строка непричём пробывала и права все при мне smile

Автор: Sunvas 29.1.2007, 20:15

Возможно уже есть параметр xxx, только он другого типа (например DWORD);

Автор: Витаминка 29.1.2007, 20:45

Да, параметр каторый я ищу есть, а то смысл тогда поиска по ресстору... Тип стринговый

Автор: Sunvas 29.1.2007, 20:50

Цитата(Витаминка @ 29.1.2007, 20:45

)

Тип стринговый

Даже не знаю что и посоветовать. приведи код весь что-ли.

Автор: RA 29.1.2007, 21:56

1. Все программы роуза всегда содержат мелкие ошибки, это роуз сделал спеиально чтоб левые люди не скопилефтить его софтину.

Так что там нужно порыться и найти не логичную ошибку.

2.

Код



Вот этот кусок кода нужно как минимум удалить

      FReg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        IsValidData(Key, S.Strings[I]);
      end;
      S.Clear;

А этот кусок кода вобще бред. Его тоже в утиль.


procedure TfrmRegistryChecker.IsValidData(const AKey, AValue: String);
begin
      if Pos('xxx', AValue) > 0 then // xxx -  имя параметра в ключе
        begin
          Memo1.Lines.Add(AKey);
          FReg.OpenKey(AKey, true);
          FReg.WriteString('xxx', '1111'); 
        end;
end;

Автор: Витаминка 30.1.2007, 19:14

1) Я нашла в коде нашла только одну нелогическую ошибку, но в том что мне надо это никак непомагло... может их там куча, но я их не вижу smile

2)Если этот код удалить то будет просто перебор ветвей HKEY_USERS, как тогда сделать проверку на имена параметров в каждой ветви?

Автор: Витаминка 31.1.2007, 20:20

RA насоветовал тут мне....
Без этого кода нельзя сделать проверку на Value, и он никак не лишний, лишь одно что IsValidData лучше заменить на

Код


if Pos('xxx',S.Strings[I]) >0 then
....

Код


 FReg.GetValueNames(S);    
      for I := 0 to S.Count - 1 do    
      begin    
        if Pos('xxx',S.Strings[I]) >0 then
        ....
      end;    
      S.Clear;

Конешно спасибо за уменьшение кол-ва строк кода, но это никак не решает проблему с Failed to set data for 'xxx'

Автор: Витаминка 1.2.2007, 15:04

Ну хотяб предположения какие есть, не может быть чтоб тут не нашлось кодера каторый не мог подсказать в чём дело...

Автор: AndySphinx 1.2.2007, 15:30

Обратите внимание, что в

Цитата

FReg.WriteString('xxx', '1111');

пытается в параметр xxx записать значение 1111, а нужно то толко сканирование smile

Автор: Витаминка 1.2.2007, 16:34

мда...после сканирования мне нужна запись

Автор: Sunvas 1.2.2007, 21:08

Витаминка, выложи весь исходник пожалуйста. Там будет легче тебе помочь.

Автор: Витаминка 1.2.2007, 23:56

Sunvas так я выкладывала на 1ой странице, вот ещё раз

Код


procedure TfrmRegistryChecker.Scan(Key: String);
var
  S: TStringList;
  I: Integer;
begin
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_USERS;
  if FReg.OpenKeyReadOnly(Key) then
  try
    S := TStringList.Create;
    try
      FReg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        if Pos('xxx', S.Strings[I]) > 0 then
          FReg.OpenKey(Key, true);
          FReg.WriteString('xxx', '1111')
      end;
      S.Clear;
      FReg.GetKeyNames(S);
      for I := 0 to S.Count - 1 do
        if S.Strings[I] <> '' then
          Scan(Key + '\' + S.Strings[I]);
    finally
      S.Free;
    end;
  finally
    FReg.CloseKey;
  end;
end;

Автор: Sunvas 2.2.2007, 00:56

Вот, кажется увидел ашипку. Попробуй так:

Код


procedure TfrmRegistryChecker.Scan(Key: String);    
var    
  S: TStringList;    
  I: Integer;    
begin    
  FReg := TRegistry.Create;    
  FReg.RootKey := HKEY_USERS;    
  if FReg.OpenKeyReadOnly(Key) then    
  try    
    S := TStringList.Create;    
    try    
      FReg.GetValueNames(S);    
      for I := 0 to S.Count - 1 do    
      if Pos('xxx', S.Strings[I]) > 0 then    
      begin    
          FReg.OpenKey(Key, true);    
          FReg.WriteString('xxx', '1111')    
      end;    
      S.Clear;    
      FReg.GetKeyNames(S);    
      for I := 0 to S.Count - 1 do    
        if S.Strings[I] <> '' then    
          Scan(Key + '\' + S.Strings[I]);    
    finally    
      S.Free;    
    end;    
  finally    
    FReg.CloseKey;    
  end;    
end;

Автор: Витаминка 2.2.2007, 01:54

Неа((( Я уж незнаю что делать... Мне кажется всё дело FReg.OpenKeyReadOnly, хотя даже када я его закрываю, а потом открываю в режими записи, ошипка всё равно вылетает, а при сканировании можно только открывать в ReadOnly

Автор: dimazu 2.2.2007, 03:15

A я бы вместо WriteString iспользовал бы RegSetValueEx в связке с RegOpenKeyEx и RegCloseKey

Автор: Витаминка 2.2.2007, 03:21

А ты откуда их взял SetValueEx и OpenKeyEx ??? Такого в модуле Registry нет, по крайней мери у меня...

Автор: dimazu 2.2.2007, 04:43

Да есть такие... smile

Код


procedure TForm1.FormCreate(Sender: TObject);
var
  MainKey, RegKey: HKey;
  Value, ValueLen, _Yes: dword;
begin

 SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOALIGNMENTFAULTEXCEPT or SEM_NOGPFAULTERRORBOX or SEM_NOOPENFILEERRORBOX);
 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\My_Program', 0, KEY_ALL_ACCESS, RegKey) <> ERROR_SUCCESS then
 begin
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software', 0, KEY_ALL_ACCESS, MainKey) <> ERROR_SUCCESS then ExitProcess(0);
    RegCreateKey(MainKey, 'Software\My_Program', RegKey);
    RegCloseKey(MainKey);
  end;
  if RegQueryValueEx(RegKey, 'firsttime', nil, nil, @Value, @ValueLen) <> ERROR_SUCCESS then
  begin
    ShowMessage('This is message for first time run!');
    _Yes:=1;
    RegSetValueEx(RegKey, 'firsttime', 0, REG_DWORD, @_Yes, sizeof(_Yes));
  end
  else
  begin
    _Yes:=Value+1;
    ShowMessage('This is message for '+IntToStr(_Yes)+' time run!');
    RegSetValueEx(RegKey, 'firsttime', 0, REG_DWORD, @_Yes, sizeof(_Yes));
  end;
  RegCloseKey(RegKey);

end;

ЗЫ. А почему надо писать в HKEY_USERS ?

Автор: Витаминка 2.2.2007, 05:29

Уххх, а без API никак? Мне процедуру сканирования под них переписать никак не удаётся(несовместимость типов и прочие) Можети помочь с переписанием под API, я бош не могу, не получается smile

ЗЫ: потому что в HKEY_USERS находится ветвь в которой лежит нужный мне value

Автор: dimazu 2.2.2007, 06:49

Если известен путь к ключу, то напишем его
типа: HKEY_USERS\.DEFAULT\Software\MyProg\MyValue (тип)

Пробуем помочь... smile

Вот пример без API smile

По твоему коду:

Код


unit primer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FReg: TRegistry;
    procedure Scan(Key: String);
    procedure MakeString(const AKey, AValue, AData: String);
    Procedure WriteReg(_Value:String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  TmpValue : String;
  S_String: String;

{$R *.dfm}
procedure TForm1.Scan(Key: String);
var
  S: TStringList;
  I: Integer;
begin
  if FReg.OpenKeyReadOnly(Key) then
  try
    S := TStringList.Create;
    try
      FReg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        MakeString(Key, S.Strings[I], '');
        if FReg.GetDataType(S.Strings[I]) in [rdString, rdExpandString] then
          MakeString(Key, S.Strings[I], FReg.ReadString(S.Strings[I]));
      end;
      S.Clear;
      FReg.GetKeyNames(S);
      for I := 0 to S.Count - 1 do
        if (S.Strings[I] <> '') then
          Scan(Key + '\' + S.Strings[I]);
    finally
      S.Free;
    end;
  finally
   // FReg.CloseKey;  Не нуно тута...  :D 
  end;
end;
Procedure TForm1.WriteReg(_Value:String);
var reg:TRegistry;
begin
   reg := TRegistry.Create;
   try
    reg.RootKey := FReg.RootKey;
    reg.OpenKey(tmpValue, True);
    reg.WriteString(S_String, _Value );
   finally
    reg.Free;
   end;
end;

Procedure TForm1.MakeString(const AKey, AValue, AData: String);
begin
  Application.ProcessMessages;
  if AValue <> '' then
      if Pos(S_String, AValue) > 0 then
      begin
          tmpValue:=AKey;
          WriteReg('4444444');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
 FReg := TRegistry.Create;
 FReg.RootKey := HKEY_USERS;
 S_String:='xxxxx';
 TmpValue:='';
 Scan('');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FReg.Free;
end;

end.

Автор: Sunvas 2.2.2007, 12:07

У меня сейчас появилась идея, а что если вынести запись значение в отдельную процедуру?

Автор: dimazu 2.2.2007, 15:52

См. пост на один выше. smile

Работает без проблем....

Автор: RA 3.2.2007, 19:23

Цитата(Витаминка @ 31.1.2007, 20:20

)

RA насоветовал тут мне....
Без этого кода нельзя сделать проверку на Value, и он никак не лишний, лишь одно что IsValidData лучше заменить на
Выделить всёкод Pascal/Delphi
1:
2:

if Pos('xxx',S.Strings[I]) >0 then
....

Твой вопрос "поиск ключа в regedit", я дал ссылку на сорс роуза, в ответ вижу кусок кода, я подумал что это кусок кода от роуза.

Автор: Витаминка 4.2.2007, 19:05

Спасибо большое за помощь smile

(шапки пора со смайлов убирать smile

)
Но это ещё не всё))
1) Почему value в реестре меняется только после 2ва запуска программы?
2) Если перенести всё эта на консоль, то всё компилится без ошибок, но value не меняет...

Автор: dimazu 4.2.2007, 20:08

Если помнишь, я спрашивал почему менять надо именно в HKEY_USERS...
Dело в том, что там запись в регистре дублируется системой в HKEY_USERS\S-x-x-xx
и вхождений может быть много (два и больше).
Поскольку точный путь тебе неизвестен, а известно лишь имя переменной,
то в моем примере изменяются ВСЕ вхождения для 'xxxxx', найденные в реестре,
под HKEY_USERS, а их, как я и говорил, может быть несколько.

Т.е. если предположить, что переменная находится где-то в \.DEFAULT, то надо сделать проверку,
типа:

Код


var  Edited : boolean;
...
...

Procedure TForm1.MakeString(const AKey, AValue, AData: String);
begin
  Application.ProcessMessages;
  if AValue <> '' then
      if Pos(S_String, AValue) > 0 then
      begin
          tmpValue:=AKey;
          if Pos('.DEFAULT', tmpValue)>0 then
          begin
           if not Edited then WriteReg('9999');
           Edited:=True;
          end;
  end;

В процедуре Scan nаписать типа:

Код


...
    for I := 0 to S.Count - 1 do
      begin
        MakeString(Key, S.Strings[I], '');
        if FReg.GetDataType(S.Strings[I]) in [rdString, rdExpandString] then
        begin
          MakeString(Key, S.Strings[I], FReg.ReadString(S.Strings[I]));
          If Edited then Exit;
        end;
      end;
...

I приравнять Edited:=False перед Scan

Автор: Витаминка 4.2.2007, 22:27

dimazu чтоб я без тебя делала, спасиб! smile

А с 2ым пунктом как быть?

Автор: dimazu 5.2.2007, 00:02

Извиняюсь, но не понял вопроса... smile

Автор: Витаминка 5.2.2007, 17:40

Цитата(dimazu @ 5.2.2007, 00:02)

Извиняюсь, но не понял вопроса... smile

Если проект создать в Console Application(без окошка) то ничё не работает, но и ошибок никаких нет

Автор: dimazu 5.2.2007, 18:04

Проверил. Работает. Записывает.
Вот пример:

Код


program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,Registry, Classes, Windows;

var
  FReg     : TRegistry;
  TmpValue : String;
  S_String : String;
  Edited   : boolean;

Procedure WriteReg(_Value:String);
var reg:TRegistry;
begin
   reg := TRegistry.Create;
   try
    reg.RootKey := FReg.RootKey;
    reg.OpenKey(tmpValue, True);
    reg.WriteString(S_String, _Value );
   finally
    reg.Free;
   end;
end;
Procedure MakeString(const AKey, AValue, AData: String);

begin
  if AValue <> '' then
      if Pos(S_String, AValue) > 0 then
      begin
          tmpValue:=AKey;
          if Pos('.DEFAULT', tmpValue)>0 then
          begin
           if not Edited then WriteReg('534535345');
           Edited:=True;
          end;
  end;
end;

procedure Scan(Key: String);
var
  S: TStringList;
  I: Integer;
begin
  if FReg.OpenKeyReadOnly(Key) then
  try
    S := TStringList.Create;
    try
      FReg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        MakeString(Key, S.Strings[I], '');
        if FReg.GetDataType(S.Strings[I]) in [rdString, rdExpandString] then
        begin
          MakeString(Key, S.Strings[I], FReg.ReadString(S.Strings[I]));
          If Edited then Exit;
        end;
      end;
      S.Clear;
      FReg.GetKeyNames(S);
      for I := 0 to S.Count - 1 do
        if (S.Strings[I] <> '') then
          Scan(Key + '\' + S.Strings[I]);
    finally
      S.Free;
    end;
  finally
  ; //
  end;

end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_USERS;
  S_String:='xxxxx';
  TmpValue:='';
  Edited:=False;
  Scan('');
  FReg.Free;
end.

Автор: Витаминка 5.2.2007, 21:18

Спасиб, всё заработало, жаль те плюс поставить не могу... Модеры плюсаните dimazu smile