PC Administrator/spravce.iso/StartRight/source/UnitStartupRunner.pas

Pascal/Delphi Source File | 2002-10-26 | 9.4 KB | 357 lines

unit UnitStartupRunner;
{
    Purpose:
        To execute all of StartRight's runkey and startup folder
        programs.

        Called by FrmDummyRunner
}
interface


uses Windows, Registry, SysUtils, StrUtils, TLHelp32,
    INIFiles, Contnrs, ShlObj, ShellAPI,
    Forms {for Application object},
    Classes {for StringList & other TStrings objects},
    Dialogs,
    UnitMyKeys, UnitStartupMover, UnitErrorLog;

type TStartupRunner = class(TObject)
    private
        r : TRegistry;
        h : THandle;

        MyRunkeyList : TObjectList;
        MyStartupFolderList : TObjectList;

        procedure ExecuteRunKeyValue(value : string);
        function RunCommandLine(command : string) : longbool;
        function RunShortcut(command : string) : longbool;
        function RunProgram(name, params : string) : longbool;

        procedure GatherMyRunkeyItems;
        procedure GatherMyStartupItems;
    public
        constructor Create(Handle : THandle);
        destructor Destroy(); override;

        procedure ExecuteRunkeyPrograms;
        procedure ExecuteStartupFolderPrograms;

        function GetMyRunkeyItemsCount : cardinal;
        function GetMyRunkeyItem(index : cardinal) : TRunkeyItem;
        function GetMyStartupFolderItemsCount : cardinal;
        function GetMyStartupFolderItem(index : cardinal) : TStartupFolderItem;

        procedure RefreshItems;
end;

implementation



constructor TStartupRunner.Create(Handle : THandle);
begin
    r := TRegistry.Create();
    h := Handle;

    MyRunkeyList := TObjectList.Create();
    MyStartupFolderList := TObjectList.Create();

    self.GatherMyRunkeyItems;
    self.GatherMyStartupItems;
end;

destructor TStartupRunner.Destroy();
begin
    MyStartupFolderList.Clear;
    MyRunkeyList.Clear;
    MyStartupFolderList.Free;
    MyRunkeyList.Free;
    r.free;
    inherited destroy;
end;


procedure TStartupRunner.GatherMyRunkeyItems;
var ri : TRunkeyItem;
    sorted : array of string;
    sortIndex : integer;
    i : integer;
    s : string;
begin
    //
    // Get the names of My RunKey names, in order of execution
    // each key value is named 0 to X, where X is one
    // less than SR_SORTINDEX_VALUE
    // The data is the name of the Run value in SR_RUN_KEY
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    sortIndex := 0;
    if (r.OpenKey(SR_RUNSORT_KEY, false)) then begin
        sortIndex := r.ReadInteger(SR_SORTINDEX_VALUE);
        SetLength(sorted, sortIndex);

        for i := 0 to (sortIndex - 1) do begin
            sorted[i] := r.ReadString(IntToStr(i));
        end;
        r.CloseKey;
    end;

    //
    // get all command line's to run
    // using sorted to fetch the data in order
    //
    MyRunkeyList.Clear;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUN_KEY, false)) then begin
        for i := 0 to (sortIndex - 1) do begin
            try
               s := r.ReadString(sorted[i]);
               if (s <> '') then begin
                    ri := TRunkeyItem.Create();

                    ri.RunKey := sorted[i];
                    ri.RunValue := s;

                    MyRunkeyList.Add(ri);
               end;
            finally
            end;
        end;
        r.CloseKey;
    end;

end;

procedure TStartupRunner.GatherMyStartupItems;
var sfi : TStartupFolderItem;
    i, sortindex : integer;
    sl : THashedStringList;
begin
    MyStartupFolderList.Clear;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPSORT_KEY, false)) then begin
        sl := THashedStringList.Create();
        r.GetValueNames(sl);

        sortIndex := sl.IndexOf(SR_SORTINDEX_VALUE);
        if (sortIndex = -1) then begin
            sortIndex := 0;
        end else begin
            sortIndex := r.ReadInteger(SR_SORTINDEX_VALUE);
        end;

        for i := 0 to (sortIndex - 1) do begin
            sfi := TStartupFolderItem.Create();
            sfi.FullName := r.ReadString(IntToStr(i));
            MyStartupFolderList.Add( sfi );
        end;
        sl.Free;
        r.CloseKey;
    end;

end;





function TStartupRunner.GetMyRunkeyItemsCount : cardinal;
begin
    result := MyRunkeyList.Count;
end;
function TStartupRunner.GetMyRunkeyItem(index : cardinal) : TRunkeyItem;
begin
    result := TRunkeyItem( MyRunkeyList.items[index] );
end;

function TStartupRunner.GetMyStartupFolderItemsCount : cardinal;
begin
    result := MyStartupFolderList.Count;
end;
function TStartupRunner.GetMyStartupFolderItem(index : cardinal) : TStartupFolderItem;
begin
    result := TStartupFolderItem( MyStartupFolderList.items[index] );
end;





procedure TStartupRunner.RefreshItems;
begin
    self.GatherMyRunkeyItems;
    self.GatherMyStartupItems;
end;






//------------------------------------------------------------
// Run all startup programs shadowed by this program
//------------------------------------------------------------

procedure TStartupRunner.ExecuteRunkeyPrograms;
var i : integer;
    ri : TRunkeyItem;
begin
    //
    // Run all managed runkey items
    //

    for i := 0 to MyRunkeyList.Count - 1 do begin
        ri := TRunkeyItem( MyRunkeyList.Items[i] );

        self.ExecuteRunKeyValue( ri.RunValue );
    end;
end;

procedure TStartupRunner.ExecuteStartupFolderPrograms;
var i : integer;
    sfi : TStartupFolderItem;
begin
    for i := 0 to MyStartupFolderList.Count - 1 do begin
        sfi := TStartupFolderItem( MyStartupFolderList.Items[ i ] );

        if (not self.RunShortcut( sfi.FullName )) then begin
            ShowMessage(SysErrorMessage(GetLastError));
        end;
    end;
end;






procedure TStartupRunner.ExecuteRunKeyValue(value : string);
var s, name, params : string;
begin
    //
    // remove quotes around program names
    //
    {if (LeftStr(value,1) = '"') then begin
        value := StringReplace(value, '"', '', []);
        value := StringReplace(value, '"', '', []);
    end;
    }
    //
    // turn full names into short names and break apart the
    // program and it's parameters
    // Otherwise, treat it as a command line to be run
    // (like mobsync.exe & point32.exe
    //
    if (pos(':', value) <> 0) then begin
         if (LeftStr(value,1) = '"') then begin
            value := StringReplace(value, '"', '', []);
            value := StringReplace(value, '"', '', []);
        end;

        name := UnitMyKeys.GetEXEPathFromRunValue(value);
        params := StringReplace(value, name, '',[rfIgnoreCase]);

        if (self.RunCommandLine('"' +  name + '" ' + Trim(params))) then begin
            EXIT;
        end;
    end else begin
        if (self.RunCommandLine(value)) then begin
            EXIT;
        end;
    end;


    //
    // If it's not a full path, and not is the system path
    // the program's path may be located in "App Paths";
    //
    {cannot find path}

    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(WINDOWS_APPSPATH_KEY + '\' + value, false) then begin
        try
            s := r.ReadString('');
        finally
        end;
        r.CloseKey;

        if (s <> '') then begin
            if (not self.RunCommandLine(s)) then begin
                // I am most unhappy if this part is reached
                ShowMessage('damn you');
            end;
        end;
    end;

end;

function TStartupRunner.RunCommandLine(command : string) : longbool;
var  StartInfo  : _StartupInfoA;
     ProcInfo   : _PROCESS_INFORMATION;
begin
    // nil for the program name treats the program name
    // as a command line to execute
    FillChar(StartInfo, SizeOf(StartInfo), #0);
    FillChar(ProcInfo, SizeOf(ProcInfo), #0);
    StartInfo.cb := SizeOf(TStartupInfo);

    result := CreateProcess(nil, PChar(command),
                nil, nil, False,
                CREATE_NEW_PROCESS_GROUP + NORMAL_PRIORITY_CLASS,
                nil, nil, StartInfo, ProcInfo);

    if (result) then begin
        WaitForInputIdle(ProcInfo.hProcess, 5000);
    end else begin
        ErrorLog.Add(Windows.GetLastError(), command);
    end;
end;

function TStartupRunner.RunProgram(name, params : string) : longbool;
var  StartInfo  : _StartupInfoA;
     ProcInfo   : _PROCESS_INFORMATION;
begin
    // nil for the program name treats the program name
    // as a command line to execute
    FillChar(StartInfo, SizeOf(StartInfo), #0);
    FillChar(ProcInfo, SizeOf(ProcInfo), #0);
    StartInfo.cb := SizeOf(TStartupInfo);

    result := CreateProcess(pchar(name), PChar(params),
                nil, nil, False,
                CREATE_NEW_PROCESS_GROUP + NORMAL_PRIORITY_CLASS,
                nil, nil, StartInfo, ProcInfo);

    if (result) then begin
        WaitForInputIdle(ProcInfo.hProcess, 5000);
    end else begin
        ErrorLog.Add(Windows.GetLastError(), name + ' ' + params);
    end;
end;


function TStartupRunner.RunShortcut(command : string) : longbool;
var c : cardinal;
    {StartInfo  : _StartupInfoA;
    ProcInfo   : _PROCESS_INFORMATION;}
begin
    command := ExtractShortPathName(command);
    c := ShellAPI.ShellExecute(h, nil, PChar( ExtractShortPathName(command) ), nil, nil, SW_SHOWNORMAL);

    result := (c > 32);
    if (result) then begin
        Sleep(2000);
    end else begin
        ErrorLog.Add(Windows.GetLastError(), command);
    end;
end;





end.