Registry durchsuchen

[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.