Softwarová Záchrana 3/Softwarova-zachrana-3.bin/StartRight/source.zip/UnitStartupRunner.pas

Pascal/Delphi Source File | 2004-10-08 | 18KB | 601 lines

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

        Called by FrmDummyRunner
    Updates:

        Use Registry.OpenKeyReadOnly for new PowerUser functionality,
        since StartRight's key requires Admin permission by default.
    --------
        New Pause/Abort/Status functionality
}
interface


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

type TStartupType = (STARTUP_RUNKEY, STARTUP_FOLDER, STARTUP_PRERUN);

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

        MyRunkeyList : TObjectList;
        MyStartupFolderList : TObjectList;

        StartupDelayMilli,
        RunkeyDelayMilli,
        PrerunDelayMilli : integer;

        paused : boolean;
        aborted : boolean;

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

        procedure GatherMyRunkeyItems;
        procedure GatherMyStartupItems;
        procedure GetOptions;

        function  GetTunedCustomDelay(valuename : string; st : TStartupType) : integer;
        procedure UpdatePostDelayStat(valuename : string);
        procedure UpdatePreRunStat(valuename : string; var CPU : integer);
    public
        constructor Create(Handle : THandle);
        destructor Destroy(); override;

        procedure ExecutePrerunDelay;
        procedure ExecuteRunkeyPrograms;
        procedure ExecuteStartupFolderPrograms;

        function GetMyRunkeyItemsCount : cardinal;
        function GetMyRunkeyItem(index : cardinal) : TRunkeyItem;
        function GetMyStartupFolderItemsCount : cardinal;
        function GetMyStartupFolderItem(index : cardinal) : TStartupFolderItem;
        function GetPrerunDelaySeconds : integer;
        procedure RefreshItems;

        procedure SetPaused(value : boolean);
        procedure Abort;
end;

implementation

uses UnitFrmAbout, UnitFrmDummyRunner, UnitUtils, UnitCPUUsage,
  UnitFrmOptions;

{}
CONST
    METHOD_COMMANDLINE_ALTERED = 'CMDALTERED';
    METHOD_COMMANDLINE = 'CMDORIGNAL';
    METHOD_PROGRAM = 'PROGRAM';
    METHOD_SHORTCUT = 'SHORTCUT';
    METHOD_APPPATH = 'APPPATH';
    METHOD_SYSTEMROOT = 'SYSTEMROOT';

    PRERUN_CUSTOMEDELAY_NAME = 'SR_InitialPause';


const PRE_STRING = '_PRE';
      POST_STRING = '_POST';

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

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

    self.GetOptions;
    self.GatherMyRunkeyItems;
    self.GatherMyStartupItems;
end;

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


procedure TStartupRunner.GetOptions;
    function GetInteger(r : TMyRegistry; value : string; default : integer) : integer;
    begin
        if not r.ValueExists(value) then begin
            r.WriteInteger(value, default);
        end;
        result := r.ReadInteger(value);
    end;
const STARTUP_DELAY_MILLI = 'StartupDelayMilli';
      RUNKEY_DELAY_MILLI = 'RunkeyDelayMilli';
      PRERUN_DELAY = 'InitialPauseMilli';

begin
    self.StartupDelayMilli := 2000;
    r.ValueExistsInteger(SR_HOME_KEY, STARTUP_DELAY_MILLI ,self.StartupDelayMilli);
    r.SetDataInteger(SR_HOME_KEY, STARTUP_DELAY_MILLI, self.StartupDelayMilli);

    self.RunkeyDelayMilli := 1000;
    r.ValueExistsInteger(SR_HOME_KEY, RUNKEY_DELAY_MILLI, self.RunkeyDelayMilli);
    r.SetDataInteger(SR_HOME_KEY, RUNKEY_DELAY_MILLI, self.RunkeyDelayMilli);

    self.PrerunDelayMilli := 5000;
    r.ValueExistsInteger(SR_HOME_KEY, PRERUN_DELAY, self.PrerunDelayMilli);
    r.SetDataInteger(SR_HOME_KEY, PRERUN_DELAY, self.PrerunDelayMilli);

    self.PrerunDelayMilli := self.GetTunedCustomDelay(
        PRERUN_CUSTOMEDELAY_NAME,
        STARTUP_PRERUN
    );
end;

procedure TStartupRunner.GatherMyRunkeyItems;
var ri : TRunkeyItem;
    i : integer;
    s : string;
begin

    for i := 0 to (UnitMyKeys.GetRunSortCount - 1) do begin
        s := UnitMyKeys.GetRunSortData(i);
        if (s <> '') then begin
            ri := TRunkeyItem.Create();
            ri.RunKey := UnitMyKeys.GetRunSortValue(i);
            ri.RunValue := s;

            MyRunkeyList.Add(ri);
        end;
    end;
end;

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

    if r.ValueExistsInteger(SR_STARTUPSORT_KEY,SR_SORTINDEX_VALUE, sortindex) then begin
        for i := 0 to (sortIndex - 1) do begin
            sfi := TStartupFolderItem.Create();
            sfi.FullName := r.GetDataString(SR_STARTUPSORT_KEY, IntToStr(i));
            MyStartupFolderList.Add( sfi );
        end;
    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
//------------------------------------------------------------



function TStartupRunner.GetTunedCustomDelay(valuename: string;
  st: TStartupType): integer;
var precpu,
    postcpu,
    high : integer;
    postdelta, predelta, alterdelta : double;
    newresult : integer;
begin
    //
    // let a user defined value override a tunned
    result := UnitMyKeys.GetCustomDelay(valuename);
    if result <> 0 then EXIT;

    // set defaults if no delay is currently defined
    result := UnitMyKeys.GetTunnedCustomDelay(valuename);
    if (result = 0) then begin
        case ST of
        STARTUP_RUNKEY : result := self.RunkeyDelayMilli;
        STARTUP_FOLDER : result := self.StartupDelayMilli;
        STARTUP_PRERUN : result := self.PrerunDelayMilli;
        end;
    end;

    if (not frmOptions.cbDisableAutoTune.Checked) then begin
        // gather current / saved statistics
        precpu := UnitMyKeys.ReadStat(valuename + PRE_STRING);
        postcpu := UnitMyKeys.ReadStat(valuename + POST_STRING);
        high := UnitMyKeys.GetHighCPUStat;

        if not (0 in [precpu, postcpu, high]) then begin
            // - for every 10% CPU usage, add 1 extra second of delay
            // - add up to 25% more delay [comparing post delay to highest]
            predelta := (precpu - postcpu);
            postdelta := (predelta) * 100;
            alterdelta := (postcpu / high) / 4;

            newresult := result + trunc(
                postdelta  + (postdelta * alterdelta)
            );

            // 50/50 exponential average
            result := trunc((newresult * 0.5) + (result * 0.5));
            // Delay's Cap / Limit
            if result > 10000 then result := 10000;
            if result < 1000 then result := 1000;
        end;

        UnitMyKeys.SetTunnedCustomDelay(valuename, result);

    end;
end;

procedure TStartupRunner.UpdatePreRunStat(valuename : string; var CPU : integer);
begin
    if (not frmOptions.cbDisableAutoTune.Checked) then begin
        valuename := valuename + PRE_STRING;
        //
        // save the previous value, update the current value
        //
        UnitMyKeys.UpdatePreviousStat(valuename, UnitMyKeys.ReadStat(valuename));
        CPU := trunc(UnitCPUUsage.GetCPUUsage);
        UnitMyKeys.UpdateStat(valuename, CPU);
    end;
end;

procedure TStartupRunner.UpdatePostDelayStat(valuename: string);
begin

    if (not frmOptions.cbDisableAutoTune.Checked) then begin
        valuename := valuename + POST_STRING;
        //
        // save the previous value, update the current value
        //
        UnitMyKeys.UpdatePreviousStat(valuename, UnitMyKeys.ReadStat(valuename));
        UnitMyKeys.UpdateStat(valuename, trunc(UnitCPUUsage.GetCPUUsage));
    end;
end;



procedure TStartupRunner.ExecuteRunkeyPrograms;
var i,j, delay : integer;
    ri : TRunkeyItem;
    s, cpu : string;
begin
    //
    // Run all managed runkey items
    //

    for i := 0 to MyRunkeyList.Count - 1 do begin
        if (self.aborted) then BREAK;

        while (self.paused) do begin
            Application.ProcessMessages;
        end;

        ri := TRunkeyItem( MyRunkeyList.Items[i] );
        self.UpdatePreRunStat(ri.runkey, j);
        cpu := IntToStr(j);
        s := 'Run key ('+ IntToStr(i+1)+ '/' + IntToSTr(MyRunkeyList.Count) + ')'#13#10 +
            ri.RunKey +': '
             + ri.Runvalue
            + #13#10'CPU% ' + cpu;


        frmDummyRunner.Callback_ShowMessage(s);

        // DEBUG
        //ErrorLog.Add(s);

        self.ExecuteRunKeyValue(ri.RunKey, ri.RunValue );

        // Use a custom sleep time, or the default.
        // Tally statistics for the Auto-Tune process

        delay := self.GetTunedCustomDelay(ri.RunKey, STARTUP_RUNKEY);

        if (delay = 0) then begin
            delay := self.RunkeyDelayMilli;
        end;
        frmDummyRunner.Callback_ShowMessage(
            s + #13#10'(sleeping ' + IntToStr(delay) + ' milliseconds)'
            );
        UnitUtils.MySleep(delay);
        self.UpdatePostDelayStat(ri.RunKey);




        while (self.paused) do begin
            Application.ProcessMessages;
            sleep(10);
        end;

    end;
end;

procedure TStartupRunner.ExecuteStartupFolderPrograms;
var i,j, delay : integer;
    sfi : TStartupFolderItem;
    s, cpu : string;
    err : cardinal;
begin
    for i := 0 to MyStartupFolderList.Count - 1 do begin
        if (self.aborted) then BREAK;
        while (self.paused) do begin
            Application.ProcessMessages;
        end;


        sfi := TStartupFolderItem( MyStartupFolderList.Items[ i ] );
        self.UpdatePreRunStat(sfi.FullName, j);
        cpu := IntToStr(j);
        s :=  'Startup Folder ('+ IntToStr(i+1)+ '/' + IntToSTr(MyStartupFolderList.Count) + '): '#13#10 +
            ExtractFileName(sfi.FullName) +
            #13#10'CPU% ' + cpu;


        frmDummyRunner.Callback_ShowMessage(s);
        if (not self.RunShortcut( sfi.FullName, err )) then begin
            ShowMessage('Error execution shortcut: ' + #13#10 +
                sfi.fullname + #13#10 +
                SysErrorMessage(err));
        end else begin

            delay := self.GetTunedCustomDelay(sfi.Fullname, STARTUP_FOLDER);


            frmDummyRunner.Callback_ShowMessage(
                s + #13#10'(sleeping ' + IntToStr(delay) + ' seconds)'
                );
            UnitUtils.mySleep(delay);
        end;
        Self.UpdatePostDelayStat(sfi.FullName);

        while (self.paused) do begin
            Application.ProcessMessages;
            sleep(10);
        end;

    end;
end;






procedure TStartupRunner.ExecuteRunKeyValue(valuename, value : string);
    procedure RecordMethod(vname, method : string);
    begin
        r.SetDataString(SR_EXECMETHOD_KEY, vname, method);
    end;


    function RunCmdAltered(value : string) : boolean;
    var name, params : string;
    begin
        // turn full names into short names and break apart the
        // program and it's parameters

        if (LeftStr(value,1) = '"') then begin
            value := StringReplace(value, '"', '', []);
            value := StringReplace(value, '"', '', []);
        end;

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

        result := (self.RunCommandLine('"' +  name + '" ' + Trim(params)))
    end;

    function RunAppPath(value : string) : boolean;
    var s : string;
    begin
        result := false;

        try
        s := r.GetDataString(WINDOWS_APPSPATH_KEY + '\' + value, '');
        finally
        end;

        if (s <> '') then begin
            result := self.RunCommandLine(s);
        end;
    end;
    function RunSystemRoot(value : string) : boolean;
    begin
        result := self.RunCommandLine('%SystemRoot%\System32\' + value);
    end;
    function RunByMethod(value : string) : boolean;
    var s : string;
    begin
        result := false;

        s := r.GetDataString(SR_EXECMETHOD_KEY, valuename);
        if (s = METHOD_COMMANDLINE) then begin
            result := self.RunCommandLine(value);
        end else if (s = METHOD_COMMANDLINE_ALTERED) then begin
            result := RunCmdAltered(value);
        end else if (s = METHOD_APPPATH) then begin
            result := RunAppPath(value);
        end else if (s = METHOD_SYSTEMROOT) then begin
            result := RunSystemRoot(value);
        end;
    end;

begin
    // try using previous working method
    if (RunByMethod(value)) then begin
        EXIT;
    end;

    // try as-is if the full path isn't found
    if (pos(':', value) <> 0) then begin
        if (RunCmdAltered(value)) then begin
            RecordMethod(valuename, METHOD_COMMANDLINE_ALTERED);
            EXIT;
        end;
    end else begin
        if (self.RunCommandLine(value)) then begin
            RecordMethod(valuename, METHOD_COMMANDLINE);
            EXIT;
        end;
    end;

    // Look for an AppPath program
    if (RunAppPath(value)) then begin
        RecordMethod(valuename, METHOD_APPPATH);
        EXIT;
    end;

    // try SystemRoot if all else fails
    if (RunSystemRoot(value)) then begin
        RecordMethod(valuename, METHOD_SYSTEMROOT);
        EXIT;
    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);
    StartInfo.wShowWindow := SW_NORMAL;

    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);
    StartInfo.wShowWindow := SW_normal;
    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; var errorcode : cardinal) : longbool;
begin
    command := ExtractShortPathName(command);
    //c := ShellAPI.ShellExecute(h, nil, PChar( ExtractShortPathName(command) ), nil, nil, SW_SHOWNORMAL);
    errorcode := ShellAPI.ShellExecute(h, nil, PChar( ExtractShortPathName(command) ), nil, nil, SW_NORMAL);
    result := (errorcode > 32);
    if (result) then begin
       // Sleep(self.StartupDelayMilli);
    end else begin
        ErrorLog.Add(errorcode, command);
        ErrorLog.Add(Windows.GetLastError(), command);
    end;
end;







procedure TStartupRunner.ExecutePrerunDelay;
var CPU : integer;
begin
    if (FrmOptions.cbDisableAutoTune.Checked = false) then begin
        UpdatePreRunStat(PRERUN_CUSTOMEDELAY_NAME, CPU);
    end;
    UnitUtils.MySleep(self.PrerunDelayMilli);
    if (FrmOptions.cbDisableAutoTune.Checked = false) then begin
        UpdatePostDelayStat(PRERUN_CUSTOMEDELAY_NAME);
    end;
end;

function TStartupRunner.GetPrerunDelaySeconds: integer;
begin
    result := trunc(self.PrerunDelayMilli / 1000);
end;

procedure TStartupRunner.SetPaused(value: boolean);
begin
    self.paused := value;
end;

procedure TStartupRunner.Abort;
begin
    self.aborted := true;
end;





end.