(******************************************************************************
 *                                                                            *
 *  MpuAutoRun                                                                *
 *  Auturun class                                                             *
 *  - HKLM - Run                                                              *
 *  - HKLM - RunOnce                                                          *
 *  - HKCU - Run                                                              *
 *  - HKCU - RunOnce                                                          *
 *                                                                            *
 *  Copyright (c) Michael Puff  http://www.michael-puff.de                    *
 *                                                                            *
 ******************************************************************************)

    (************************************************************************
     *                                                                      *
     *                        COPYRIGHT NOTICE                              *
     *                                                                      *
     * Copyright (c) 2001-2007, Michael Puff ["copyright holder(s)"]        *
     * All rights reserved.                                                 *
     *                                                                      *
     * Redistribution and use in source and binary forms, with or without   *
     * modification, are permitted provided that the following conditions   *
     * are met:                                                             *
     *                                                                      *
     * 1. Redistributions of source code must retain the above copyright    *
     *    notice, this list of conditions and the following disclaimer.     *
     * 2. Redistributions in binary form must reproduce the above copyright *
     *    notice, this list of conditions and the following disclaimer in   *
     *    the documentation and/or other materials provided with the        *
     *    distribution.                                                     *
     * 3. The name(s) of the copyright holder(s) may not be used to endorse *
     *    or promote products derived from this software without specific   *
     *    prior written permission.                                         *
     *                                                                      *
     * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS  *
     * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT    *
     * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS    *
     * FORA PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE        *
     * REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,          *
     * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, *
     * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;     *
     * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER     *
     * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   *
     * LIABILITY, OR TORT INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY *
     * WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE          *
     * POSSIBILITY OF SUCH DAMAGE.                                          *
     *                                                                      *
     ************************************************************************)

unit MpuAutoRun;

interface

uses
  Windows,
  SysUtils,
  Registry;

type
  TMpuAutorun = class(TObject)
  private
    FExeFilename: string;
    FRootKey: HKEY;
    FRunOnce: Boolean;
    function GetExeFilename: string;
    procedure SetExeFilename(const Value: string);
    function GetRootKey: HKEY;
    procedure SetRootKey(const Value: HKEY);
    procedure SetRunOnce(const Value: Boolean);
    function GetRunOnce: Boolean;
  public
    constructor Create;
    property ExeFilename: string read GetExeFilename write SetExeFilename;
    property RootKey: HKEY read GetRootKey write SetRootKey;
    property RunOnce: Boolean read GetRunOnce write SetRunOnce;
    procedure AutoRun(SetAutoRun: Boolean);
    function IsInAutoRun: Boolean;
  end;

const
  RUNKEY            = 'Software\Microsoft\Windows\CurrentVersion\Run';
  RUNONCEKEY        = 'Software\Microsoft\Windows\CurrentVersion\RunOnce';

resourcestring
  rsFileNotExists   = 'Datei %s existiert nicht.';
  rsDelFailed       = '%s konnte nicht aus %s gelöscht werden.';

implementation

{ TMpuAutorun }

procedure TMpuAutorun.AutoRun(SetAutoRun: Boolean);
var
  reg               : TRegistry;
  s                 : string;
begin
  // write autorun
  if SetAutoRun then
  begin
    reg := TRegistry.Create(KEY_WRITE);
    try
      try
        reg.RootKey := FRootKey;
        if FRunOnce then
          s := RUNONCEKEY
        else
          s := RUNKEY;
        if reg.OpenKey(s, False) then
        begin
          reg.WriteString(ExtractFilename(FExeFilename), FExeFilename);
        end;
      except
        on E: ERegistryException do
          raise E.Create(E.Message);
      end;
    finally
      FreeAndNil(reg);
    end;
  end
  else // delete autorun
  begin
    reg := TRegistry.Create(KEY_WRITE);
    try
      reg.RootKey := FRootKey;
      if FRunOnce then
        s := RUNONCEKEY
      else
        s := RUNKEY;
      if reg.OpenKey(s, False) then
      begin
        if not reg.DeleteValue(ExtractFilename(FExeFilename)) then
          raise Exception.CreateFmt(rsDelFailed, [ExtractFilename(FExeFilename), s]);
      end;
    finally
      FreeAndNil(reg);
    end;
  end;
end;

constructor TMpuAutorun.Create;
begin
  inherited;
  // set defaults
  FExeFilename := ParamStr(0);
  FRootKey := HKEY_CURRENT_USER;
  FRunOnce := False;
end;

function TMpuAutorun.GetExeFilename: string;
begin
  result := FExeFilename;
end;

function TMpuAutorun.GetRootKey: HKEY;
begin
  result := FRootKey;
end;

function TMpuAutorun.GetRunOnce: Boolean;
begin
  result := FRunOnce;
end;

function TMpuAutorun.IsInAutoRun: Boolean;
var
  reg               : TRegistry;
  s                 : string;
begin
  reg := TRegistry.Create(KEY_READ);
  try
    reg.RootKey := FRootKey;
    if FRunOnce then
      s := RUNONCEKEY
    else
      s := RUNKEY;
    result := reg.OpenKey(s, False);
    if result then
    begin
      result := reg.ValueExists(ExtractFilename(FExeFilename));
    end
  finally
    FreeAndNil(reg);
  end;
end;

procedure TMpuAutorun.SetExeFilename(const Value: string);
begin
  if FileExists(Value) then
    FExeFilename := Value
  else // file does not exists, no use in carrying on
    raise Exception.CreateFmt(rsFileNotExists, [Value]);
end;

procedure TMpuAutorun.SetRootKey(const Value: HKEY);
begin
  FRootKey := Value;
end;

procedure TMpuAutorun.SetRunOnce(const Value: Boolean);
begin
  FRunOnce := Value;
end;

end.