home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
StartRight
/
source.zip
/
UnitStartupRunner.pas
< prev
next >
Wrap
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.