鱼C论坛

 找回密码
 立即注册
查看: 2903|回复: 3

[技术交流] delphi程序启动项管理

[复制链接]
发表于 2013-9-23 23:59:20 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能^_^

您需要 登录 才可以下载或查看,没有账号?立即注册

x
本帖最后由 丿Clover灬夢 于 2013-9-26 00:05 编辑

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, Registry, Menus;

type
  TForm1 = class(TForm)
    JStrGrid: TStringGrid;
    PopupMenu: TPopupMenu;
    cmdAdd: TMenuItem;
    cmddelete: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure cmdAddClick(Sender: TObject);
    procedure cmddeleteClick(Sender: TObject);
    procedure JStrGridMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    procedure readkey(root: string; IRowcount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  reg: Tregistry;
  canadd: Boolean;
  arow: Integer;
implementation
uses
  Unit2;
{$R *.dfm}

procedure TForm1.readkey(root: string; IRowcount: Integer);//读取启动项
var
  ttt: Tstringlist;
  i: integer;
  rrr, qqq: string;
begin
  qqq := '\Software\Microsoft\Windows\CurrentVersion\Run';
  ttt := Tstringlist.Create;
  reg := Tregistry.create;
  try
    if root = 'HKEY_Local_Machine' then
      reg.RootKey := HKEY_Local_Machine;
    if root = 'HKEY_Current_User' then
      reg.RootKey := HKEY_Current_User;
    if reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',false) then
    begin
      reg.GetValueNames(ttt); //获取当前键下所有的键值列表。
      JStrGrid.RowCount := ttt.Count + IRowcount;
      for i := 0 to ttt.Count - 1 do
      begin
        JStrGrid.Cells[1, i + IRowcount] := ttt;
        //ShowMessage(ttt);

        rrr := reg.ReadString(ttt);
        //ShowMessage(rrr);
        JStrGrid.Cells[2, i + IRowcount] := rrr;
        JStrGrid.Cells[3, i + IRowcount] := qqq;
        JStrGrid.Cells[4, i + IRowcount] := root;
      end;
    end;
  finally
      reg.CloseKey;
      reg.Free;
      ttt.Free;
  end;

end;

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  readkey('HKEY_Local_Machine', 1);
  readkey('HKEY_Current_User', JStrGrid.RowCount);

  for i := 1 to JStrGrid.RowCount - 1 do
  begin
    JStrGrid.Cells[0, i] := IntToStr(i);
  end;
end;

procedure TForm1.cmdAddClick(Sender: TObject);
begin
  with TForm2.Create(nil) do
  begin
    try
      ShowModal;
    finally
      Free;
    end;
  end;
  Form1.OnShow(nil);
  if canadd then
  MessageBox(Handle, '启动项添加成功', '提示', MB_OK or MB_ICONWARNING);
end;

procedure TForm1.cmddeleteClick(Sender: TObject);
var
  ireg: TRegistry;
  ValueName: string;
begin
  if Application.MessageBox('是否删除该启动项', '提示', MB_YESNO +
    MB_ICONQUESTION + MB_DEFBUTTON2) = IDNO then Exit;

   iReg := TRegistry.Create;
  try
    with iReg do
    begin
      if JStrGrid.Cells[4, arow] = 'HKEY_CURRENT_USER' then
        RootKey := HKEY_CURRENT_USER;
      if JStrGrid.Cells[4, arow] = 'HKEY_Local_Machine' then
        RootKey := HKEY_Local_Machine;
        if OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False) then
        begin
          ValueName :=  JStrGrid.Cells[1, arow];
          if ValueExists(ValueName) then
            DeleteValue(ValueName);

          ValueName := ValueName + '1';
          if ValueExists(ValueName) then
            DeleteValue(ValueName);
        end;
        CloseKey;
    end;
  finally
    iReg.Free;
  end;
  MessageBox(Handle, '启动项删除成功', '提示', MB_OK or MB_ICONWARNING);
  Form1.OnShow(nil);
end;

procedure TForm1.JStrGridMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  acol: Integer;
begin
  with JStrGrid do
  begin
    MouseToCell(x, y, acol, arow);
  end;
  //ShowMessage(IntToStr(arow));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.Title := '开机启动项';
  JStrGrid.Cells[0, 0] := '序号';
  JStrGrid.Cells[1, 0] := '启动项名称';
  JStrGrid.Cells[2, 0] := '启动程序';
  JStrGrid.Cells[3, 0] := '所在键';
  JStrGrid.Cells[4, 0] := '根键';
end;

end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Registry;

type
  TForm2 = class(TForm)
    pnlPanel: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    btnopenexe: TSpeedButton;
    edtName: TEdit;
    cmb: TComboBox;
    edtExe: TEdit;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    OpenDialog: TOpenDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOKClick(Sender: TObject);
    procedure btnopenexeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  Form2 := nil;
end;

procedure TForm2.btnOKClick(Sender: TObject);
var
  hKey: string;
  hReg: TRegIniFile;
begin
   hReg := TRegIniFile.Create('');
  //TregIniFile类的对象需要创建
  if cmb.ItemIndex = 0 then
  begin
    hReg.RootKey := HKEY_LOCAL_MACHINE;
  end;
  if cmb.ItemIndex  = 1 then
  begin
    hReg.RootKey := HKEY_LOCAL_MACHINE;
  end;
  //设置根键
  hReg.WriteString('Software\Microsoft\Windows\CurrentVersion\Run'
                  + hKey + #0,
                  edtName.Text,
                  //程序名称,可以为自定义值
                  edtExe.Text );
                  //命令行数据,必须为该程序的绝对路径+程序完整名称
  hReg.destroy;
  //释放创建的hReg
  unit1.canadd := True;
end;

procedure TForm2.btnopenexeClick(Sender: TObject);
begin
  if OpenDialog.Execute then
  edtExe.Text := OpenDialog.FileName;
end;

end.


游客,如果您要查看本帖隐藏内容请回复


想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

发表于 2013-10-31 17:53:43 | 显示全部楼层
楼主太强啦
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

发表于 2014-10-24 06:46:32 | 显示全部楼层
学习
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

发表于 2023-1-19 21:54:40 | 显示全部楼层
uses registry;  
  
var reg:tregistry;   
  
begin   
reg:=tregistry.create;   
reg.rootkey:=HKEY_LOCAL_MACHINE;   
reg.openkey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);   
reg.WriteString('ScanRegistry','mir47.EXE');   
reg.closekey;   
reg.free;   
end.  
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|鱼C工作室 ( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)

GMT+8, 2024-4-27 18:08

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表