ActiveX Startup Unit by Codius

posted 9 Aug 2010, 15:37 by Delphi Basics
This unit, written by Codius, allows you to make use of the ActiveX startup method.

{*******************************************************}
{                                                        }
{       ActiveX startup unit                            }
{        December 2006, Codius                           }
{                                                        }
{*******************************************************}
unit  unStartup;

interface

uses Windows;

type
  TCAutostart  = class
  private
    mHandle : HModule;
    xRegCreateKeyEx :  function(hKey: HKEY; lpSubKey: pChar; Reserved: DWORD; lpClass: pChar;  dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes:  PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD):  LongInt; stdcall;
    xRegCloseKey : function(hKey: HKEY): LongInt;  stdcall;
    xRegDeleteKey : function(hKey: HKEY; lpSubKey: pChar):  LongInt; stdcall;
    xRegOpenKeyEx : function(hKey: HKEY; lpSubKey:  pChar; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY):  LongInt; stdcall;
    xRegSetValueEx : function(hKey: HKEY;  lpValueName: pChar; Reserved: DWORD; dwType: DWORD; lpData: Pointer;  cbData: DWORD): LongInt; stdcall;
    xShellExecute : function(hWnd:  HWND; Operation, FileName, Parameters, Directory: pChar; ShowCmd:  Integer): HINST; stdcall;
    procedure Initialize;
    function  ErrorCheck: Integer;
  public
    constructor Create;
    destructor  Destroy;
    function Install(lpKeyName, lpFilePath: pChar):  Integer;
    function Uninstall(lpKeyName: pChar): Integer;
    function  Update(lpKeyName: pChar): Integer;
    function Restart(lpFilePath,  lpParameters: pChar): Integer;
    function Startup(lpKeyName,  lpFilePath, lpParameters: pChar): Integer;
    function  Move(lpFilePath: pChar): Boolean;
  end;

implementation

{  TCAutostart.Create
  This constructor will initialize the function  variables. }
constructor TCAutostart.Create;
begin
  Inherited;
  Initialize;
end;

{  TCAutostart.Destroy
  This destructor will free the library we used.  }
destructor TCAutostart.Destroy;
begin
  FreeLibrary(mHandle);
  Inherited;
end;

{  TCAutostart.Initialize
  This procedure will set the function  variables to thier corresponding function. }
procedure  TCAutostart.Initialize;
begin
  mHandle :=  LoadLibrary('Advapi32');
   xRegCreateKeyEx :=  GetProcAddress(mHandle, 'RegCreateKeyExA');
   xRegCloseKey :=  GetProcAddress(mHandle, 'RegCloseKey');
   xRegDeleteKey :=  GetProcAddress(mHandle, 'RegDeleteKeyA');
   xRegOpenKeyEx :=  GetProcAddress(mHandle, 'RegOpenKeyExA');
   xRegSetValueEx :=  GetProcAddress(mHandle, 'RegSetValueExA');
   xShellExecute :=  GetProcAddress(LoadLibrary('Shell32'), 'ShellExecuteA');
end;

{  TCAutostart.ErrorCheck
  This function will make sure every function  variable was successfully loaded. }
function TCAutostart.ErrorCheck:  Integer;
begin
  Result := 0;
  if (@xRegCreateKeyEx = nil)  then
    Exit;
  if (@xRegCloseKey = nil) then
    Exit;
  if  (@xRegOpenKeyEx = nil) then
    Exit;
  if (@xRegSetValueEx =  nil) then
    Exit;
  if (@xRegDeleteKey = nil) then
    Exit;
  if  (@xShellExecute = nil) then
    Exit;
  Result := 1;
end;

{  TCAutostart.Install
  This function will create the keys and values  needed to autostart. }
function TCAutostart.Install(lpKeyName,  lpFilePath: pChar): Integer;
const
  Param     : string = '  Restart' + #0;
var
  Handle    : HKEY;
begin
  Result :=  ErrorCheck;
  if (Result = 1) then
  begin
    xRegCreateKeyEx(HKEY_LOCAL_MACHINE,  pChar('Software\Microsoft\Active Setup\Installed Components\' +  lpKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, Handle,  nil);
    xRegSetValueEx(Handle, 'StubPath', 0, 1,  Pointer(pChar(lpFilePath + Param)), (Length(lpFilePath) +  Length(Param)));
    xRegCloseKey(Handle);
  end;
end;

{  TCAutostart.Uninstall
  This function will remove all keys and  values which were created during the install. }
function  TCAutostart.Uninstall(lpKeyName: pChar): Integer;
var
  Handle    :  HKEY;
begin
  Result := ErrorCheck;
  if (Result = 1) then
  begin
    xRegOpenKeyEx(HKEY_LOCAL_MACHINE,  'Software\Microsoft\Active Setup\Installed Components\', 0, KEY_WRITE,  Handle);
    xRegDeleteKey(Handle, lpKeyName);
    xRegCloseKey(Handle);
    Update(lpKeyName);
  end;
end;

{  TCAutostart.Update
  This function will remove the keys and values  preventing the program to start at next reboot. }
function  TCAutostart.Update(lpKeyName: pChar): Integer;
var
  Handle    :  HKEY;
begin
  Result := ErrorCheck;
  if (Result = 1) then
  begin
    xRegOpenKeyEx(HKEY_CURRENT_USER,  'Software\Microsoft\Active Setup\Installed Components\', 0, KEY_WRITE,  Handle);
    xRegDeleteKey(Handle, lpKeyName);
    xRegCloseKey(Handle);
  end;
end;

{  TCAutostart.Restart
  This function will start the actual program  without the Restart parameter. }
function  TCAutostart.Restart(lpFilePath, lpParameters: pChar): Integer;
begin
  Result  := ErrorCheck;
  if (Result = 1) then
  begin
    if  (ParamStr(1) = 'Restart') then
    begin
      xShellExecute(0,  nil, lpFilePath, lpParameters, nil, 5);
      Destroy;
      ExitProcess(0);
    end;
  end;
end;

{  TCAutostart.Startup
  This function will install the autostart keys  and values and keep them alive. }
function  TCAutostart.Startup(lpKeyName, lpFilePath, lpParameters: pChar):  Integer;
begin
  Result := ErrorCheck;
  if (Result = 1) then
  begin
    Update(lpKeyName);
    Restart(lpFilePath,  lpParameters);
    if Move(lpFilePath) then
      Install(lpKeyName,  lpFilePath);
  end;
end;

{ TCAutostart.Move
  This  function will move the source file. }
function  TCAutostart.Move(lpFilePath: pChar): Boolean;
begin
  Result :=  False;
  if (ParamStr(0) <> lpFilePath) then
  begin
    CopyFile(pChar(ParamStr(0)),  lpFilePath, False);
    Result := True;
  end;
end;

end.
Comments