请问,如何用DELPHI搜索注册表的全部项、鍵???(100分)

K

knifepj

Unregistered / Unconfirmed
GUEST, unregistred user!
请问,如何用DELPHI搜索注册表的全部项、鍵???
 
T

tangfengyang

Unregistered / Unconfirmed
GUEST, unregistred user!
我也想知道 呵呵
 
K

knifepj

Unregistered / Unconfirmed
GUEST, unregistred user!
F

fuda

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, Registry, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
StringGrid1: TStringGrid;
btnStart: TButton;
btnRemove: TButton;
edKey: TEdit;
edTime: TEdit;
edValueName: TEdit;
edValue: TEdit;
btnStop: TButton;
procedure btnStartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnRemoveClick(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject;
Col, Row: Integer;
var CanSelect: Boolean);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
fRegistry: TRegistry;
fRowCount: Integer;
fCurrentKeyValue: String;
fStopFlag: Boolean;
fNoSelection: Boolean;
proceduredo
AnalyzeRegistry;
proceduredo
AnalyzeBranch;
proceduredo
AnalyzeKey(const Key: String);
function do
AnalyzeValue(const Key, Value: String): Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
const Root : Array[0..3] of Char = ('A', ':', '/', #0);
const
nKeyName = 0;
nFileTime = 1;
nValueName = 2;
nValueString = 3;
procedure NormalizeRegistryPath(var Path: String);
begin
if (Path = '') or (Path[1] <> '/') then
Path := '/' + Path;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
btnStop.Enabled := TRUE;
fRowCount := 1;
StringGrid1.RowCount := 2;
StringGrid1.Cells[nKeyName, 1] := '';
StringGrid1.Cells[nFileTime, 1] := '';
StringGrid1.Cells[nValueName, 1] := '';
StringGrid1.Cells[nValueString, 1] := '';
do
AnalyzeRegistry;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fRegistry := TRegistry.Create;
end;

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

procedure TForm1.DoAnalyzeRegistry;
begin
fStopFlag := FALSE;
fNoSelection := TRUE;
if not fStopFlag then
begin
fCurrentKeyValue := 'HKEY_CURRENT_USER';
fRegistry.RootKey := HKEY_CURRENT_USER;
fRegistry.OpenKey('/', FALSE);
do
AnalyzeBranch();
end;

if not fStopFlag then
begin
fCurrentKeyValue := 'HKEY_USERS';
fRegistry.RootKey := HKEY_USERS;
fRegistry.OpenKey('/', FALSE);
do
AnalyzeBranch();
end;

if not fStopFlag then
begin
fCurrentKeyValue := 'HKEY_LOCAL_MACHINE';
fRegistry.RootKey := HKEY_LOCAL_MACHINE;
fRegistry.OpenKey('/Software', FALSE);
do
AnalyzeBranch();
end;

StringGrid1.RowCount := fRowCount;
StatusBar1.SimpleText := 'Number of invalid references: '+IntToStr(fRowCount - 1);
btnStop.Enabled := FALSE;
if fRowCount = 1 then
begin
MessageDlg('No invalid references detected.',mtInformation,[mbOK],0);
btnRemove.Enabled := FALSE;
end
else
begin
btnRemove.Enabled := TRUE;
end;

end;

procedure TForm1.DoAnalyzeBranch;
var
I: Integer;
Keys: TStringList;
Path: String;
begin
Keys := TStringList.Create;
try
Path := fRegistry.CurrentPath;
fRegistry.GetKeyNames(Keys);
for I := 0 to Keys.Count - 1do
begin
if fRegistry.OpenKey(Keys, FALSE) then
begin
do
AnalyzeKey(Keys);
if fStopFlag then
Break;
if fRegistry.HasSubKeys then
do
AnalyzeBranch;
end;

if fStopFlag then
Break;
NormalizeRegistryPath(Path);
if not fRegistry.OpenKey(Path, FALSE) then
raise exception.Create('Can not open key '+Path);
end;
finally
Keys.Free;
end;
end;

procedure TForm1.DoAnalyzeKey(const Key: String);
var
I: Integer;
Values: TStringList;
DataType: TRegDataType;
StringValue: String;
RegKeyInfo: TRegKeyInfo;
SystemTime: TSystemTime;
StringDate: String;
begin
Values := TStringList.Create;
try
fRegistry.GetValueNames(Values);
for I := 0 to Values.Count - 1do
begin

DataType := fRegistry.GetDataType(Values);
if (DataType = rdString) or (DataType = rdExpandString) then
begin
StatusBar1.SimpleText := 'Analyzing: '+Key;
{ Let the applocation to process messages,
so the text would be on the status bar
while we are still in the loop }
Application.ProcessMessages;
if fStopFlag then
Break;
StringValue := fRegistry.ReadString(Values);
if (notdo
AnalyzeValue(Key, Values)) or
(notdo
AnalyzeValue(Key, StringValue)) then
begin
if StringGrid1.RowCount = fRowCount then
StringGrid1.RowCount := fRowCount + 10;
fRegistry.GetKeyInfo(RegKeyInfo);
FileTimeToSystemTime(RegKeyInfo.FileTime, SystemTime);
DateTimeToString(StringDate, 'mm/dd/yyyy hh:mmAM/PM', SystemTimeToDateTime(SystemTime));

StringGrid1.Cells[nKeyName, fRowCount] := fCurrentKeyValue + ': ' +fRegistry.CurrentPath;
StringGrid1.Cells[nFileTime, fRowCount]:= StringDate;
StringGrid1.Cells[nValueName, fRowCount] := Values;
StringGrid1.Cells[nValueString, fRowCount] := StringValue;
{ If there is no rows selected yet then
select the first one }
if fNoSelection then
begin
fNoSelection := FALSE;
StringGrid1.Selection := TGridRect(Rect(0, 1, 4, 1));
end;

Inc(fRowCount);
end;
end;
end;
finally
Values.Free;
end;
end;

function TForm1.DoAnalyzeValue(const Key, Value: String): Boolean;
var
DriveType: UINT;
Path: String;
FileName: String;
begin
Result := TRUE;
{ Verify if the string can be treated as path (and file name)}
if Length(Value) < 3 then
Exit;
if not (UpCase(Value[1]) in ['C'..'Z']) then
Exit;
if Pos(';', Value) > 0 then
Exit;
if Pos(',', Value) > 0 then
Exit;
if Pos(' ', Value) > 0 then
Exit;
if (Value[2] <> ':') or (Value[3] <> '/') then
Exit;

Root[0] := Value[1];
DriveType := GetDriveType(Root);
if (DriveType = DRIVE_FIXED) then
begin
if (ExtractFileExt(Value) = '') then
begin
{ No extension, try to treat the value as path }
Path := Value;
if (Path[Length(Path)] <> '/') then
Path := Value + '/';
if not SetCurrentDirectory(PChar(Path)) then
begin
Result := FALSE;
Exit;
end;
end
else
begin
Path := ExtractFilePath(Value);
if not SetCurrentDirectory(PChar(Path)) then
begin
Result := FALSE;
Exit;
end;
FileName := ExtractFileName(Value);
if (GetFileAttributes(PChar(Value)) = -1) then
begin
Result := FALSE;
Exit;
end;
end;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
StringGrid1.Cells[nKeyName, 0] := 'Registry Key';
StringGrid1.Cells[nFileTime, 0] := 'Last Modification';
StringGrid1.Cells[nValueName, 0] := 'String Value';
StringGrid1.Cells[nValueString, 0] := 'File/Path reference';
fRowCount := 1;
btnRemove.Enabled := FALSE;
btnStop.Enabled := FALSE;
fNoSelection := TRUE;
end;

procedure TForm1.btnRemoveClick(Sender: TObject);
var
I: Integer;
Msg: String;
Count: Integer;
Selection: TGridRect;
RootKey: Longint;
Path: String;
procedure ParseKeyValue(const S: String);
var
I: Integer;
Key: String;
begin
I := Pos(':', S);
Key := Copy(S, 1, I-1);
Path := Copy(S, I+2 , Length(S));
NormalizeRegistryPath(Path);
if Key = 'HKEY_CURRENT_USER' then
RootKey := HKEY_CURRENT_USER
else
if Key = 'HKEY_USERS' then
RootKey := HKEY_USERS
else
if Key = 'HKEY_LOCAL_MACHINE' then
RootKey := HKEY_LOCAL_MACHINE;
end;

begin
Selection := StringGrid1.Selection;
Count := Selection.Bottom - Selection.Top + 1;
if Count = 1 then
Msg := 'Are you sure you want to remove selected entry from the Registry?'
else
Msg := 'Are you sure you want to remove ' +
IntToStr(Selection.Bottom - Selection.Top + 1) +
' selected entries from the Registry?';
if MessageDlg(Msg, mtWarning, [mbYes,mbNo], 0) = mrYes then
begin
for I := Selection.Top to Selection.Bottomdo
begin
ParseKeyValue(StringGrid1.Cells[nKeyName, I]);
fRegistry.RootKey := RootKey;
if not fRegistry.OpenKey(Path, FALSE) then
raise Exception.Create('Error opening registry key '+Path);
fRegistry.DeleteValue(StringGrid1.Cells[nValueName, I]);
end;

{ Initiate re-scanning }
btnStartClick(self);
end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject;
Col, Row: Integer;
var CanSelect: Boolean);
begin
{ Display values in the edit controls
only when there is any data in the grid }
if not (fNoSelection) then
begin
edKey.Text := StringGrid1.Cells[nKeyName, Row];
edTime.Text := StringGrid1.Cells[nFileTime, Row];
edValueName.Text := StringGrid1.Cells[nValueName, Row];
edValue.Text := StringGrid1.Cells[nValueString, Row];
end;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
{ Set the stop flag, so the registry scanning process can stop }
fStopFlag := TRUE;
end;

end.

 
Z

zlwnet

Unregistered / Unconfirmed
GUEST, unregistred user!
F

fuda

Unregistered / Unconfirmed
GUEST, unregistred user!
这个更简单:
var
reg:TRegistry
procedure GetKeyNames(Strings: TStrings);
返回所有键名
procedure GetValueNames(Strings: TStrings);
返回所有的值
 
Z

zlwnet

Unregistered / Unconfirmed
GUEST, unregistred user!
怎么样在你给的这个程序中加上 TTimer 这个功能呢?
就是能响应时钟定时工作!
 
K

knifepj

Unregistered / Unconfirmed
GUEST, unregistred user!
多人接受答案了。
 

Similar threads

顶部