AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Registry durchsuchen

Ein Thema von cherry · begonnen am 21. Okt 2010 · letzter Beitrag vom 2. Nov 2010
 
Benutzerbild von p80286
p80286

Registriert seit: 28. Apr 2008
Ort: Stolberg (Rhl)
6.659 Beiträge
 
FreePascal / Lazarus
 
#3

AW: Registry durchsuchen

  Alt 22. Okt 2010, 11:13
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)) = 'DELETEKEYthen
        DELETEKEY := true
      else if UPPERCASE(ParamStr(3)) = 'DELETEVALUEthen
        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_ROOTthen
      begin
        writeln('ROOTKEY SET TO: HKEY_CLASSES_ROOT');
        find(ParamStr(2), HKEY_CLASSES_ROOT)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIGthen
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_CONFIG');
        find(ParamStr(2), HKEY_CURRENT_CONFIG)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_USERthen
      begin
        writeln('ROOTKEY SET TO: HKEY_CURRENT_USER');
        find(ParamStr(2), HKEY_CURRENT_USER)
      end
      else if ParamStr(1) = 'HKEY_LOCAL_MACHINEthen
      begin
        writeln('ROOTKEY SET TO: HKEY_LOCAL_MACHINE');
        find(ParamStr(2), HKEY_LOCAL_MACHINE)
      end
      else if ParamStr(1) = 'HKEY_USERSthen
      begin
        writeln('ROOTKEY SET TO: HKEY_USERS');
        find(ParamStr(2), HKEY_USERS)
      end
      else if ParamStr(1) = 'HKEY_CURRENT_CONFIGthen
      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.
Programme gehorchen nicht Deinen Absichten sondern Deinen Anweisungen
R.E.D retired error detector

Geändert von p80286 (22. Okt 2010 um 13:21 Uhr)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:47 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz