Registry durchsuchen

[cherry]

hallo...
irgendwie scheint mein code verhext zu sein. Was ich suchen will finde ich. aber wenn ich je nach dem einen Suchbegriff eingebe den es garnicht gibt, gibts manchmal trotzdem ne ausgabe, und zwar immer an derselben stelle... dabei spielt der Suchbegriff nur insofern eine Rolle, dass es plus minus 8 Zeichen sein müssen. Es gibt mir dann diese Ausgabe:

\SYSTEM\ControlSet003\Control\Terminal Server\Wds\rdpwd\SUCHBEGRIFF

vielleich könnte jmd einen kurzen Blick auf meinen code (ich weiss is nicht so schön, war auch nur ein test und ich bin im stress) werfen.
danke schon mal...

Delphi-Quellcode:

program reg;

{$APPTYPE CONSOLE}

uses
  windows, SysUtils, Registry, StrUtils, classes;

var
  RG: TRegistry;

// init
procedure init;
begin
  RG := TRegistry.Create;
end;

// find vals
procedure findvals(txt:string);
var
  valuenames: TStringList;
  I:Integer;
  info: TRegDataInfo;
  data: String;
begin
  valuenames := TStringList.Create;
  RG.GetValueNames(valuenames);
  for I := 0 to valuenames.Count - 1 do
  begin
    if Pos(UPPERCASE(txt),UPPERCASE(valuenames.Strings[i])) > 0 then // VALUENAME FOUND
    begin
      Writeln('[KEY]'+RG.CurrentPath);
      Writeln('    [Valuename]'+valuenames.Strings[i]);
    end;
    if RG.GetDataInfo(valuenames.Strings[i], info) then
    begin
      if (info.RegData = rdString) or (info.RegData = rdExpandString)  then
      begin
        data := RG.ReadString(valuenames.Strings[i]);
        if Pos(UPPERCASE(txt),UPPERCASE(data)) > 0 then // VALUE FOUND
        begin
          Writeln('[KEY]'+RG.CurrentPath);
          Writeln('    [Valuename]'+valuenames.Strings[i]);
          Writeln('              [VALUE]'+data);
        end;
      end;
    end;
//    else
//      WriteLn('ERROR getting data info for: "'+RG.CurrentPath+'\'+key+'"');
  end;
  valuenames.Free;
end;

// find
procedure find(txt: string; RootKey: HKEY);
var
  keynames: TStringList;
  I: Integer;
  toplevelpath: string;

procedure findkeys(key: string);
var
  knames: TStringList;
  I: Integer;
begin

  if Pos(UPPERCASE(txt),UPPERCASE(key)) > 0 then // KEY FOUND
    Writeln(key);

  if RG.OpenKeyReadOnly(key) then
  begin
    knames := TStringList.Create;
    RG.GetKeyNames(knames);
    for I := 0 to knames.Count - 1 do
    begin
      findvals(txt);
      findkeys(key+'\'+knames.Strings[I]);
    end;
    knames.Free;
    //RG.CloseKey;
  end;
//  else
//    WriteLn('ERROR while opening key: "'+key+'"');

end;

begin
  keynames := TStringList.Create;
  RG.RootKey := RootKey;
  if RG.OpenKeyReadOnly(RG.CurrentPath) then
  begin
    RG.GetKeyNames(keynames);
    toplevelpath := RG.CurrentPath;
    for I := 0 to keynames.Count - 1 do
      findkeys(toplevelpath+'\'+keynames.Strings[I]);
    keynames.Free;
    //RG.CloseKey;
  end;
//  else
//    WriteLn('ERROR while opening key: "'+RG.CurrentPath+'"');
end;

begin

  try

    init;

    if ParamStr(1) = '' then
    begin

      writeln('-----------------------------------');
      writeln('- registry tool 2010 by enemyleft -');
      writeln('-----------------------------------');

    end
    else
    begin

      if UPPERCASE(ParamStr(3)) = 'DELETEKEY' then
        DELETEKEY := true
      else if UPPERCASE(ParamStr(3)) = 'DELETEVALUE' then
        DELETEVALUE := true;

      writeln('looking for "'+ParamStr(2)+'" in registry ...');
      if ParamStr(1) = '*' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER);
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE);
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CLASSES_ROOT' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_USER' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER)
      end
      else if ParamStr(1) = 'HKEY_LOCAL_MACHINE' then
      begin
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE)
      end
      else if ParamStr(1) = 'HKEY_USERS' then
      begin
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end;

    end;

  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

[DeddyH]

Du solltest zumindest ParamCount prüfen, bevor Du blauäugig auf Parameter Nr. 3 usw. zugreifst. Ansonsten hilft wohl nur Debuggen (und ein Blick auf die wirklich übergebenen Parameter).

[p80286]

Also abgesehen davon, daß das Prog so nicht laufen kann (DELETEKEY),
bekomme ich irgendwann eine "access violation".
Und zwar irgendwo in
HKEY_LOCAL_MACHINE\SYSTEM\ControlSet002\Control\De viceClasses\{6994AD04-93EF-11D0-A3CC-00A0C9223196}\##?#HDAUDIO#FUNC_01&VEN_11D4&DEV_188 2&SUBSYS_17AA3048&REV_1003#4&19870EF5&0&0201#{6994 ad04-93ef-11d0-a3cc-00a0c9223196}

Gruß
K-H

Ich hab ein paar kleine Modifikationen vorgenommen:

Delphi-Quellcode:

program reg_tl;

{$APPTYPE CONSOLE}

uses
  windows, SysUtils, Registry, StrUtils, classes;

var
  RG: TRegistry;
  deletekey,
  deletevalue :boolean;
  outfile: textfile;

// init
procedure init;
begin
  RG := TRegistry.Create;
end;

// find vals
procedure findvals(txt:string);
var
  valuenames: TStringList;
  I:Integer;
  info: TRegDataInfo;
  data: String;
begin
  valuenames := TStringList.Create;
  RG.GetValueNames(valuenames);
  for I := 0 to valuenames.Count - 1 do
  begin
    if Pos(UPPERCASE(txt),UPPERCASE(valuenames.Strings[i])) > 0 then // VALUENAME FOUND
    begin
      Writeln('[KEY]'+RG.CurrentPath);
      Writeln(' [Valuename]'+valuenames.Strings[i]);
    end;
    if RG.GetDataInfo(valuenames.Strings[i], info) then
    begin
      if (info.RegData = rdString) or (info.RegData = rdExpandString) then
      begin
        data := RG.ReadString(valuenames.Strings[i]);
        if Pos(UPPERCASE(txt),UPPERCASE(data)) > 0 then // VALUE FOUND
        begin
          Writeln('[KEY]'+RG.CurrentPath);
          Writeln(' [Valuename]'+valuenames.Strings[i]);
          Writeln(' [VALUE]'+data);
        end;
      end;
    end;
// else
// WriteLn('ERROR getting data info for: "'+RG.CurrentPath+'\'+key+'"');
  end;
  valuenames.Free;
end;

// find
procedure find(txt: string; RootKey: HKEY);
var
  keynames: TStringList;
  I: Integer;
  toplevelpath: string;

procedure findkeys(key: string);
var
  knames: TStringList;
  I: Integer;
begin

  if Pos(UPPERCASE(txt),UPPERCASE(key)) > 0 then // KEY FOUND
    Writeln(key);

  if RG.OpenKeyReadOnly(key) then
  begin
    knames := TStringList.Create;
    RG.GetKeyNames(knames);
    for I := 0 to knames.Count - 1 do
    begin
      if length(knames[i])>0 then begin
        writeln(outfile,'key:',key,' KN:',inttostr(i),'  ',knames[i]);
        findvals(txt);
        findkeys(key+'\'+knames.Strings[I]);
      end;
    end;
    knames.Free;
   //RG.CloseKey;
  end;
// else
// WriteLn('ERROR while opening key: "'+key+'"');

end;

begin
  keynames := TStringList.Create;
  RG.RootKey := RootKey;
  if RG.OpenKeyReadOnly(RG.CurrentPath) then
  begin
    RG.GetKeyNames(keynames);
    toplevelpath := RG.CurrentPath;
    for I := 0 to keynames.Count - 1 do begin
      writeln(toplevelpath+'\'+keynames.Strings[I]);
      findkeys(toplevelpath+'\'+keynames.Strings[I]);
    end;
    keynames.Free;
    //RG.CloseKey;
  end;
// else
// WriteLn('ERROR while opening key: "'+RG.CurrentPath+'"');
end;

begin
  deletekey := false;
  deletevalue := false;


  try

    init;

    assignfile(outfile,'c:\temp\protokoll.txt');
    rewrite(outfile);

    if ParamStr(1) = '' then
    begin

      writeln('-----------------------------------');
      writeln('- registry tool 2010 by enemyleft -');
      writeln('-----------------------------------');

    end
    else
    begin

      if UPPERCASE(ParamStr(3)) = 'DELETEKEY' then
        DELETEKEY := true
      else if UPPERCASE(ParamStr(3)) = 'DELETEVALUE' then
        DELETEVALUE := true;

      writeln('looking for "'+ParamStr(2)+'" in registry ...');
      if ParamStr(1) = '*' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER);
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE);
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CLASSES_ROOT' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_USER' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER)
      end
      else if ParamStr(1) = 'HKEY_LOCAL_MACHINE' then
      begin
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE)
      end
      else if ParamStr(1) = 'HKEY_USERS' then
      begin
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end;

    end;

  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  closefile(outfile);
  writeln(' *** the End ***');
  readln;
end.

[cherry]

Zitat von DeddyH:

Du solltest zumindest ParamCount prüfen, bevor Du blauäugig auf Parameter Nr. 3 usw. zugreifst. Ansonsten hilft wohl nur Debuggen (und ein Blick auf die wirklich übergebenen Parameter).

Also das ist ja wirklich nicht das Problem. Wie gesagt, ist mir bewusst, dass ich noch ein bissl mehr kontrollstrukturen reinbringen muss. Aber das war ja nur ein Test und ich ging davon aus, das man richtige Parameter übergibt. z.B. "reg.exe HKEY_LOCAL_MACHINE findemich"

Das Problem liegt an der Suche selbst...

@p80286

Hmm, weiss nicht was deine Änderungen genau bewirkten sollten?! auf jeden fall findet es immer noch einen Schlüssel den es nicht! gibt. In der Textdatei:
"key:\SYSTEM\ControlSet003\Control\Terminal Server\Wds\rdpwd KN:0 FINDEMICH"
Der Schlüssel FINDEMICH, den gibts nicht! wenn ich nach BLABLABLA suche steht dort
"key:\SYSTEM\ControlSet003\Control\Terminal Server\Wds\rdpwd KN:0 BLABLABLA"

Es kommt dabei nicht drauf an was ich als Suchwort eingebe, sondern vielmehr wieviele Buchstaben ich dabei verwende. +/- 8 Buchstaben dann zeigts mir dort einen Schlüssel an den es nicht gibt...

Deine Änderungen beinhalten ja lediglich die Erstellung einer Textdatei die micht nichts bringt.

Naja, danke trotzdem für die Antworten.

[p80286]

Da hast Du eine kleine Änderung übersehen:
if length(knames[i])>0 then begin Die von mir angelegte Datei protokolliert den Fortgang des Suchvorgangs, ist nätürlich nicht notwendig, erleichtert aber meiner Meinung nach die Fehlersuche.

Gruß
K-H

[cherry]

hab jetzt nochmals alles umgeschrieben, jetzt passiert nochmals was ganz lustiges...
Zwar findet es jetzt keine Werte mehr die es nicht gibt dafür verhaltet sich das Programm ganz anders wenn der Markierte Teil Ein/Auskommentiert ist.
Wir der Teil mit kompiliert gibt es irgendwo ein Fehler beim Öffnen eines Schlüssels (siehe in der log datei nach dem Ausführen) kommentiere ich diesen Teil aus, funktioniert das Programm soweit ich getestet habe einwandfrei, ausser das halt die Werte nicht durchsucht werden.

Es reicht schon wenn man die Zeile RG.ReadString(valuenames[I]); mitkompiliert und das ganze Programm wird irgenwie korrupt.

Ich kann diesen code bald nicht mehr sehen, hätte mich heut schon fast selber eingeliefert. Bitte findet den Fehler!

Delphi-Quellcode:

program reg;

{$APPTYPE CONSOLE}

uses
  windows, SysUtils, Registry, StrUtils, classes;

var
  RG: TRegistry;
  DELETEKEY,
  DElETEVALUE: Boolean;
  outfile: textfile;

// init
procedure init;
begin
  RG := TRegistry.Create;
  assignfile(outfile,ExtractFilePath(ParamStr(0))+'regfind.log');
  rewrite(outfile);
end;

// find vals
procedure findvals(txt:string);
var
  valuenames: TStrings;
  I:Integer;
  DataType: TRegDataType;
  data: String;
  path: String;
begin
  valuenames := TStringList.Create;
  try
    RG.GetValueNames(valuenames);
    for I := 0 to valuenames.Count - 1 do
    begin
      if valuenames[i] <> '' then
      begin
        if Pos(UPPERCASE(txt),UPPERCASE(valuenames[i])) > 0 then // VALUENAME FOUND
        begin
          Writeln('[KEY]'+RG.CurrentPath);
          Writeln('    [Valuename]'+valuenames[i]);
        end;
        DataType := RG.GetDataType(valuenames[I]);
        if (DataType= rdString) or (DataType = rdExpandString)  then
        begin

          RG.ReadString(valuenames[I]);

          (*// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL// <-- MARKIERTER TEIL*)
//          data := '';
//          data := RG.ReadString(valuenames[I]);
//          if (data <> '') then
//          begin
//          if Pos(UPPERCASE(txt),UPPERCASE(data)) > 0 then // VALUE FOUND          
//          begin
//            Writeln('[KEY]'+RG.CurrentPath);
//            Writeln('    [Valuename]'+valuenames[i]);
//            Writeln('              [VALUE]'+data);
//          end;
//          end;
          (**)

        end;
      end;
    end;
  finally
    valuenames.Free;
  end;
end;

// find
procedure find(txt: string; RootKey: HKEY);
var
  path: string;
  rootkeys: TStrings;
  I: Integer;

procedure findkeys();
var
  I: Integer;
  subkeys: TStrings;
  path: string;
begin
  subkeys := TStringList.Create;
  try
    path := RG.CurrentPath;
    RG.GetKeyNames(subkeys);
    for I := 0 to subkeys.Count - 1 do
    begin
      if RG.OpenKey(subkeys[I], false) then
      begin

        //writeln(outfile, RG.CurrentPath,' >>> key: ', i, ' name: ', subkeys[I]);

        if Pos(UPPERCASE(txt),UPPERCASE(subkeys[I])) > 0 then // KEY FOUND
          Writeln(RG.CurrentPath);

        findvals(txt);

        if RG.HasSubKeys then
          findkeys;

        if (Path = '') or (Path[1] <> '\') then
          Path := '\' + Path;

        if RG.OpenKey(Path, false) then
          writeln(outfile, 'successfully opened: ', Path, ' <--> ', RG.CurrentPath)
        else
          writeln(outfile, 'ERROR WHILE OPENING: ', Path, ' <--> ', RG.CurrentPath);

      end;
    end;
  finally
    subkeys.Free;
  end;
end;

begin
  writeln('looking for "'+txt+'"');
  RG.RootKey := RootKey;

  if RG.OpenKey('\', false) then
  begin
    findkeys;
    RG.CloseKey;
  end
  else
    WriteLn('ERROR while opening key: "'+RG.CurrentPath+'"');

end;

begin

  try

    init;

    if ParamStr(1) = '' then
    begin

      writeln('-----------------------------------');
      writeln('- registry tool 2010 by enemyleft -');
      writeln('-----------------------------------');

    end
    else
    begin

      if UPPERCASE(ParamStr(3)) = 'DELETEKEY' then
        DELETEKEY := true
      else if UPPERCASE(ParamStr(3)) = 'DELETEVALUE' then
        DELETEVALUE := true;

      writeln('looking for "'+ParamStr(2)+'" in registry ...');
      if ParamStr(1) = '*' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER);
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE);
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS);
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CLASSES_ROOT' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_USER' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER)
      end
      else if ParamStr(1) = 'HKEY_LOCAL_MACHINE' then
      begin
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE)
      end
      else if ParamStr(1) = 'HKEY_USERS' then
      begin
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIG' then
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end;

    end;

    CloseFile(outfile);

  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.