Recull Components Delphi

WinStartUp

Si posem aquest component en un formulari de l'aplicació podem fer que a l'arrancar Windows s'executi la nostra aplicació.

unit WinStartUp;

interface

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

type
  TWinStartUp = class(tcomponent)
  private
    { Private declarations }
    FStartWithWin: boolean;
    FEnabled : boolean;
    procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
      RegDataType: TRegDataType; Data: variant); protected
    function GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
    function ExistRegistryData(RootKey: HKEY; Key, Value: string): boolean;
    procedure DelRegistryData(RootKey: HKEY; Key, Value: string);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure StartWithWindows(yes: boolean);
    function IsInStart: boolean;
  published
    { Published declarations }
    property Enabled: boolean read FEnabled write FEnabled;
    property StartWithWin: boolean read FStartWithWin write FStartWithWin;
  end;

procedure Register;

implementation

constructor TWinStartUp.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FStartWithWin := False;
  FEnabled := False;
end;

procedure TWinStartUp.StartWithWindows(yes: boolean);
begin
  if yes then
  begin
    if not ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title) then
    begin
      SetRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title, rdString, Application.ExeName);
    end;
  end
  else
  begin
    if ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title) then
    begin
      DelRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title);
    end;
  end;
end;

function TWinStartUp.IsInStart: boolean;
begin
  Result := ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title);
end;

procedure TWinStartUp.Loaded;
begin
  inherited Loaded;
  if FEnabled then
  begin
    if FStartWithWin then
    begin
      if not ExistRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title) then
      begin
        SetRegistryData(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run',
          Application.Title, rdString, Application.ExeName);
      end;
    end
    else
    begin
      if ExistRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title) then
      begin
        DelRegistryData(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run',
          Application.Title);
      end;
    end;
  end;
end;

destructor TWinStartUp.Destroy;
begin
  inherited Destroy;
end;

function TWinStartUp.ExistRegistryData(RootKey: HKEY; Key, Value: string): boolean;
var
  Reg: TRegistry;
  s: string;
  res: boolean;
begin
  res := False;
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, False) then
    begin
      try
        if Reg.ValueExists(Value) then
        begin
          res := True;
        end
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
  Result := res;
end;

procedure TWinStartUp.DelRegistryData(RootKey: HKEY; Key, Value: string);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_WRITE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then
    begin
      try
        Reg.DeleteValue(Value);
      except
         Reg.CloseKey;
         raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure TWinStartUp.SetRegistryData(RootKey: HKEY; Key, Value: string;
    RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_WRITE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then
    begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then
        begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end
        else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
         Reg.CloseKey;
         raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

function TWinStartUp.GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
var
  Reg: TRegistry;
  RegDataType: TRegDataType;
  DataSize, Len: integer;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKeyReadOnly(Key) then begin
      try
        RegDataType := Reg.GetDataType(Value);
        if (RegDataType = rdString) or
           (RegDataType = rdExpandString) then
          Result := Reg.ReadString(Value)
        else if RegDataType = rdInteger then
          Result := Reg.ReadInteger(Value)
        else if RegDataType = rdBinary then
        begin
          DataSize := Reg.GetDataSize(Value);
          if DataSize = -1 then
          begin
            raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
          end
          else
          begin
            SetLength(s, DataSize);
            Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize);
            if Len <> DataSize then
              raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
            else
              Result := s;
          end
        end
        else
          raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
      except
        s := '';
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure Register;
begin
  RegisterComponents('Components Delphi', [TWinStartUp]);
end;

end.

Per a que el component actui, la propietat Enabled ha d'estar a True. Una vegada activat el component, si la propietat StartWithWin val True i executem la nostra aplicació, la pròxima vegada que arranquem Windows, arrancarà l'aplicació. Si la propietat està a False, al tornar a arrancar el sistema operatiu, l'aplicació no arrancarà.