Registry durchsuchen

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