unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Registry, StdCtrls, Buttons, ImgList;
type
TForm1 = class(TForm)
ImageList1: TImageList;
SpeedButton1: TSpeedButton;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
function TestHKey(const AHKey: string): Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.TestHKey(const AHKey: string): Boolean;
var
Reg: TRegistry;
SourceKey: string;
function GetRootKey(var AHKey: string): Cardinal;
const
cntHKEY_LOCAL_MACHINE = 'HKEY_LOCAL_MACHINE';
cntHKEY_CLASSES_ROOT = 'HKEY_CLASSES_ROOT';
cntHKEY_CURRENT_USER = 'HKEY_CURRENT_USER';
cntHKEY_USERS = 'HKEY_USERS';
cntHKEY_CURRENT_CONFIG = 'HKEY_CURRENT_CONFIG';
var
sRootKey: string;
begin
Result := 0;
sRootKey := Copy(AHKey, 1, Pos('\', AHKey) -1);
AHKey := Copy(AHKey, Pos('\', AHKey) +1, MaxInt);
if sRootKey = cntHKEY_LOCAL_MACHINE then Result := HKEY_LOCAL_MACHINE;
if sRootKey = cntHKEY_CLASSES_ROOT then Result := HKEY_CLASSES_ROOT;
if sRootKey = cntHKEY_CURRENT_USER then Result := HKEY_CURRENT_USER;
if sRootKey = cntHKEY_USERS then Result := HKEY_USERS;
if sRootKey = cntHKEY_CURRENT_CONFIG then Result := HKEY_CURRENT_CONFIG;
end;
begin
if AHKey <> '' then
begin
SourceKey := AHKey;
Reg := TRegistry.Create;
try
Reg.RootKey := GetRootKey(SourceKey);
if Reg.RootKey = 0 then Application.MessageBox('Error Key', 'Warning', MB_OK);
if Reg.OpenKeyReadOnly(SourceKey) then
Application.MessageBox('路径有效', 'Warning', MB_OK)
else
Application.MessageBox('路径无效', 'Warning', MB_OK);
finally
Reg.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TestHKey(Edit1.Text);
end;
end.