Auto Run Edit Console

Unit MpuRegAutoRunsCls.pas

unit MpuRegAutoRunsCls;

interface

uses
  Windows, SysUtils, Classes, Registry;

const
  RUN = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
  RUNONCE = 'SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce';
  RUNONCEEX = 'SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnceEx';

type
  TAutoRunObj = class(TObject)
  public
    RootKey: HKEY;
    Key: AnsiString;
    Name: AnsiString;
    Path: AnsiString;
  end;

type
  TRegAutoRuns = class(TObject)
  private
    FAutoRuns: TList;
    FRootKey: HKEY;
    FKeyPath: AnsiString;
    procedure SetRootKey(Value: HKEY);
    function GetItem(Index: Integer): TAutoRunObj;
    procedure SetItem(index: Integer; Value: TAutoRunObj);
    function GetCount: Integer;
    function GetKeyFromPath: AnsiString;
  public
    Constructor Create;
    Destructor Destroy; override;
    property RootKey: HKEY read FRootKey write SetRootKey;
    property KeyPath: AnsiString read FKeyPath write FKeyPath;
    procedure GetAutoRuns;
    procedure DeleteKey(RootKey: HKEY; Key: AnsiString; Value: String);
    function HKEYToString(RootKey: HKEY): AnsiString;
    property Items[Index: Integer]: TAutoRunObj read GetItem write SetItem;
    property Count: Integer read GetCount;
    procedure Clear;
  end;

resourcestring
  rsErrorOpenKey = 'Schluessel konnte nicht geoeffnet werden';
  rsInvalidRootKey = 'Ungueltiger RootKey';
  rsErrorDeleteValue = 'Wet konnte nicht geloescht werden';

implementation

Constructor TRegAutoRuns.Create;
begin
  inherited Create;
  FAutoRuns := TList.Create;
end;

Destructor TRegAutoRuns.Destroy;
var
  i: Integer;
begin
  if FAutoRuns.Count > 0 then
  begin
    for i := FAutoRuns.Count-1 downto 0 do
    begin
      TObject(FAutoRuns.Items[i]).Free;
    end;
  end;
  FAutoRuns.Free;
  inherited;
end;

function TRegAutoRuns.GetCount: Integer;
begin
  Result := FAutoRuns.Count;
end;

function TRegAutoRuns.GetItem(Index: Integer): TAutoRunObj;
begin
  Result := FAutoRuns.Items[Index];
end;

procedure TRegAutoRuns.SetItem(index: Integer; Value: TAutoRunObj);
begin
  FAutoRuns.Items[Index] := Value;
end;

procedure TRegAutoRuns.Clear;
var
  i: Integer;
begin
  if FAutoRuns.Count > 0 then
  begin
    for i := FAutoRuns.Count-1 downto 0 do
    begin
      TObject(FAutoRuns.Items[i]).Free;
    end;
  end;
  FAutoRuns.Clear;
end;

procedure TRegautoRuns.SetRootKey(Value: HKEY);
begin
  if (Value = HKEY_LOCAL_MACHINE) or (Value = HKEY_CURRENT_USER) then
    FRootKey := Value
  else
    raise Exception.Create(rsInvalidRootKey);
end;

function TRegAutoRuns.HKEYToString(RootKey: HKEY): AnsiString;
begin
  case RootKey of
    HKEY_LOCAL_MACHINE: Result := 'HKEY_LOCAL_MACHINE';
    HKEY_CURRENT_USER: Result := 'HKEY_CURRENT_USER';
  end;
end;

function TRegAutoRuns.GetKeyFromPath: AnsiString;
begin
  Result := ExtractFilename(KeyPath);
end;

procedure TRegAutoRuns.GetAutoRuns;
var
  Reg: TRegistry;
  ValueNames: TStringList;
  i: Integer;
  AutoRun: TAutoRunObj;
begin
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := FRootKey;
    if Reg.OpenKey(KeyPath, False) then
    begin
      ValueNames := TStringList.Create;
      try
        try
          Reg.GetValueNames(ValueNames);
          for i := 0 to ValueNames.Count - 1 do
          begin
            AutoRun := TAutoRunObj.Create;
            AutoRun.RootKey := FRootKey;
            AutoRun.Key := GetKeyFromPath;
            AutoRun.Name := ValueNames[i];
            AutoRun.Path := Reg.ReadString(ValueNames[i]);
            FAutoRuns.Add(AutoRun);
          end;
        except
          if FAutoRuns.Count > 0 then
          begin
            for i := FAutoRuns.Count-1 downto 0 do
            begin
              TObject(FAutoRuns.Items[i]).Free;
            end;
          end;
          //FAutoRuns.Free;
          raise;
        end;
      finally
        Reg.CloseKey;
        ValueNames.Free;
      end;
    end
    //else
      //raise Exception.Create(rsErrorOpenKey);
  finally
    Reg.Free;
  end;
end;

procedure TRegAutoRuns.DeleteKey(RootKey: HKEY; Key: AnsiString; Value: String);
var
  Reg: TRegistry;
begin
  Key := 'SOFTWARE\Microsoft\Windows\CurrentVersion\' + Key;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, False) then
    begin
      if not Reg.DeleteValue(Value) then
        raise Exception.Create(rsErrorDeleteValue);
    end
    else
      raise Exception.Create(rsErrorOpenKey);
  finally
    Reg.Free;
  end;
end;

end.

Project AutoRuns

program AutoRuns;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  MpuRegAutoRunsCls in 'MpuRegAutoRunsCls.pas';

const
  TAB = '  ';

var
  AutoRun: TRegAutoRuns;

resourcestring
  rsAbout = 'AUTORUNS 1.0';
  rsInvalidInput = 'Ungueltige Eingabe';
  rsItemToDelete = 'Zu loeschender Eintrag';
  rsExit = 'Eingabe von 0 zum Beenden';


procedure GetKeys;
begin
  AutoRun.Clear;
  AutoRun.RootKey := HKEY_LOCAL_MACHINE;
  AutoRun.KeyPath := RUN;
  AutoRun.GetAutoRuns;
  AutoRun.KeyPath := RUNONCE;
  AutoRun.GetAutoRuns;
  AutoRun.KeyPath := RUNONCEEX;
  AutoRun.GetAutoRuns;

  AutoRun.RootKey := HKEY_CURRENT_USER;
  AutoRun.KeyPath := RUN;
  AutoRun.GetAutoRuns;
  AutoRun.KeyPath := RUNONCE;
  AutoRun.GetAutoRuns;
  AutoRun.KeyPath := RUNONCEEX;
  AutoRun.GetAutoRuns;
end;

procedure DisplayKeys;
var
  i: Integer;
  s: string;
begin
  for i := 0 to AutoRun.Count - 1 do
  begin
    s := Format('%d. %s %s %s %s', [i + 1, AutoRun.HKEYToString(AutoRun.Items[i].RootKey), AutoRun.Items[i].Key, AutoRun.Items[i].Name, AutoRun.Items[i].Path]);
    Writeln(s);
  end;
end;

procedure DisplayMenu;
var
  asw: Integer;
begin
  Writeln(rsAbout);
  Writeln('');
  try
    GetKeys;
    DisplayKeys;
  except
    on E: Exception do
    begin
      Writeln(E.Message);
    end;
  end;

  Writeln('');
  Write(rsItemToDelete + ' (' + rsExit + '): ');
  Readln(asw);

  if asw = 0 then
  begin
    Exit;
  end
  else if asw - 1 > AutoRun.Count - 1 then
  begin
    Writeln(rsInvalidInput);
    DisplayMenu;
  end
  else
  begin
    try
      AutoRun.DeleteKey(AutoRun.Items[asw - 1].RootKey, AutoRun.Items[asw - 1].Key, AutoRun.Items[asw - 1].Name);
      DisplayMenu;
    except
      on E: Exception do
      begin
        Writeln(E.Message);
        DisplayMenu;
      end;
    end;
  end;
end;

begin
  AutoRun := TRegAutoRuns.Create;
  try
    try
      DisplayMenu;
    except
      on E: Exception do
      begin
        Writeln(E.Message);
        Readln;
      end;
    end;
  finally
    AutoRun.Free;
  end;
end.