Delphi定位注册表指定键位

2022-09-30 09:11:55 作者:admin

本文整理自网络,侵删。

 

本代码源自delphibox

unit Unit1;
interface
uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, shellapi, StdCtrls, Registry, StrUtils;
type
    TForm1 = class(TForm)
        Edit1: TEdit;
        Button1: TButton;
        Button2: TButton;
        ComboBox1: TComboBox;
        procedure Button1Click(Sender: TObject);
        procedure JumpToKey(Key: string);
        procedure Button2Click(Sender: TObject);
        procedure ComboBox1Select(Sender: TObject);
        procedure Edit1KeyPress(Sender: TObject; var Key: char);
    private
    { Private declarations }
    public
    { Public declarations }
    end;
var
    Form1: TForm1;
implementation
{$R *.dfm}

procedure TForm1.JumpToKey(Key: string);
var
    i, n: Integer;
    hWin: HWND;
    ExecInfo: ShellExecuteInfoA;
begin
    hWin := FindWindowA(PChar('RegEdit_RegEdit'), nil);
    if hWin = 0 then
    {if Regedit doesn’t run then we launch it}
    begin
        FillChar(ExecInfo, 60, #0);
        with ExecInfo do
        begin
            cbSize := 60;
            fMask := SEE_MASK_NOCLOSEPROCESS;
            lpVerb := PChar('open');
            lpFile := PChar('regedit.exe');
            nShow := 1;
        end;
        ShellExecuteExA(@ExecInfo);
        WaitForInputIdle(ExecInfo.hProcess, 200);
        hWin := FindWindowA(PChar('RegEdit_RegEdit'), nil);
    end;
    ShowWindow(hWin, SW_SHOWNORMAL);
    hWin := FindWindowExA(hWin, 0, PChar('SysTreeView32'), nil);
    SetForegroundWindow(hWin);
    i := 30;
    repeat
        SendMessageA(hWin, WM_KEYDOWN, VK_LEFT, 0);
        Dec(i);
    until i = 0;
    SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0);
    i := 1;
    n := Length(Key);
    repeat
        if Key[i] = '\' then
        begin
            SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0);
        end
        else
            SendMessageA(hWin, WM_CHAR, Integer(Key[i]), 0);
        i := i + 1;
    until i = n;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i: Integer;
    qqs1: string;
    qqb1: BOOL;
    Reg: TRegistry;
    qqs2, qqs3: string;
    hk: hkey;
    q1: Integer;
begin
    qqs1 := trim(Edit1.Text);
    if qqs1 = '' then
    begin
        Application.MessageBox('数据不能为空,请重新输入!', '出错', MB_OK);
        exit;
    end;
    if Length(qqs1) < 10 then
    begin
        Application.MessageBox('非法数据,请重新输入!', '出错', MB_OK);
        exit;
    end;

  //检验数据路径是否存在
    q1 := pos('\', qqs1);
    if q1 = 0 then
    begin
        Application.MessageBox('非法数据,请重新输入!', '出错', MB_OK);
        exit;
    end;

    qqs2 := leftstr(qqs1, q1 - 1); //根键
    qqs3 := rightstr(qqs1, Length(qqs1) - q1); //后键

    Reg := TRegistry.Create;
  //reg.RootKey:=HKEY(qqs2);
    Reg.RootKey := hk;
    if lowercase(qqs2) = lowercase('HKEY_CLASSES_ROOT') then
        Reg.RootKey := HKEY_CLASSES_ROOT
    else if lowercase(qqs2) = lowercase('HKEY_CURRENT_USER') then
        Reg.RootKey := HKEY_CURRENT_USER
    else if lowercase(qqs2) = lowercase('HKEY_LOCAL_MACHINE') then
        Reg.RootKey := HKEY_LOCAL_MACHINE

    else if lowercase(qqs2) = lowercase('HKEY_USERS') then
        Reg.RootKey := HKEY_USERS
    else if lowercase(qqs2) = lowercase('HKEY_PERFORMANCE_DATA') then
        Reg.RootKey := HKEY_PERFORMANCE_DATA
    else if lowercase(qqs2) = lowercase('HKEY_CURRENT_CONFIG') then
        Reg.RootKey := HKEY_CURRENT_CONFIG
    else if lowercase(qqs2) = lowercase('HKEY_DYN_DATA') then
        Reg.RootKey := HKEY_DYN_DATA;

    if Reg.KeyExists(qqs3) = false then
    begin
        Application.MessageBox('该注册表项路径不存在!', '出错', MB_OK);
        Reg.Free;
        exit;
    end;
    Reg.Free;
    JumpToKey(qqs1); //’HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer’);
end;

procedure TForm1.Button2Click(Sender: TObject); //清除
begin
    Edit1.Text := '';
    Edit1.SetFocus;
    ComboBox1.Text := '请选择';
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
    Edit1.Text := ComboBox1.Text;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
begin
    ComboBox1.Text := '请选择';
end;

end.


在线咨询 拨打电话