home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
StartRight
/
source.zip
/
UnitStartupMover.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2004-10-03
|
19KB
|
689 lines
unit UnitStartupMover;
{
Purpose:
Move all unexluded items into StartRight
or
Restore all items back to the system
This object is responsible for the Windows Run key
Updates:
Startup shortcut items sometimes not recognized as previously existing
-----------------
New method to test for first time moving...
Using the new ItemManager for all Exclude/Include/Disable
operations
Notes:
Moving runkeys installs StartRight in the system's Run key
Restoring runkeys removes StartRight from the system's Run key
}
interface
uses Windows, UnitMyRegistry, SysUtils, StrUtils, TLHelp32,
INIFiles, Contnrs, ShlObj, ShellAPI,
Forms {for Application object},
Classes {For TString objects},
dialogs, {showmessage debuggin}
UnitMyKeys;
//
//
//
type TRunkeyItem = Class(TObject)
RunKey : string;
RunValue : string;
RunEXE : string;
RunUser : string;
RunHKEY : HKEY;
RunProcID : cardinal;
public
function ToString() : string;
end;
type TStartupFolderItem = Class(Tobject)
FullName : String;
Location : string;
end;
type TStartupMover = class(TObject)
private
h : THandle;
r : TMyRegistry;
RunkeyList : TObjectList;
StartupFolderList : TObjectList;
procedure GetRunkeyData;
procedure GenerateStartupFolderList;
public
constructor Create(handle : THandle);
destructor Destroy(); override;
procedure SetupSelfToRun(IncludeRunOnce : boolean = true);
procedure SetupSelfToRunOnce;
procedure RemoveSelfFromRun(IncludeRunOnce : boolean = true);
function UserHasPermission(var failedkey : string) : boolean;
function GetRunkeyItemsCount : cardinal;
function GetRunkeyItem(index : cardinal) : TRunkeyItem;
function GetStartupFolderItemsCount : cardinal;
function GetStartupFolderItem(index : cardinal) : TStartupFolderItem;
procedure MoveRunKeyItems(AutoDisable : boolean = false);
procedure MoveStartupFolderItems(AutoDisable : boolean = false);
procedure RestoreRunKeyItems;
procedure RestoreStartupFolderItems;
procedure DestroyHomekey;
function GetIsSetupToRun : boolean;
function GetHasNewItemsAndClear : boolean;
function IsFirstMove : boolean;
end;
{////////////////////}
{//}implementation{//}
{////////////////////}
uses UnitSpecialPaths, UnitItemManager, UnitFrmOptions, UnitUtils;
function TRunkeyItem.ToString() : string;
begin
result := self.RunKey + '|' + self.RunValue + '|' + self.RunEXE + '|' + IntToStr(self.RunProcID);
end;
////////////////////////////////
// Public Interface
////////////////////////////////
function TStartupMover.GetHasNewItemsAndClear : boolean;
var s : string;
begin
result := r.ValueExistsString(SR_HOME_KEY, SR_NEWRUNITEMS_VALUE, s);
result := result or r.ValueExistsString(SR_HOME_KEY, SR_NEWRUNITEMS_VALUE, s);
r.DeleteDataString(SR_HOME_KEY, SR_NEWSTARTUPITEMS_VALUE);
r.DeleteDataString(SR_HOME_KEY, SR_NEWRUNITEMS_VALUE);
end;
constructor TStartupMover.Create(handle : THandle);
begin
h := handle;
r := TMyRegistry.Create();
RunkeyList := TObjectList.Create();
StartupFolderList := TObjectList.Create();
//
// Purpose: Gather everything needed to create the RunkeyList
// and the StartupFolderList
//
self.GetRunkeyData;
self.GenerateStartupFolderList;
end;
destructor TStartupMover.Destroy();
begin
r.Free;
//tsKeys.Free;
//tsVals.Free;
//tsEXEs.Free;
//tsProc.Free;
//tsProcID.Free;
RunkeyList.Clear;
RunkeyList.Free;
StartupFolderList.Clear;
StartupFolderList.Free;
inherited destroy;
end;
//--------------------------------------------------------------
// Enumerate items in the RunkeyList/StartupFolderList
//--------------------------------------------------------------
function TStartupMover.GetRunkeyItemsCount : cardinal;
begin
result := RunkeyList.Count;
end;
function TStartupMover.GetRunkeyItem(index : cardinal) : TRunkeyItem;
begin
result := TRunkeyItem( RunkeyList.items[index] );
end;
function TStartupMover.GetStartupFolderItemsCount : cardinal;
begin
result := StartupFolderList.Count;
end;
function TStartupMover.GetStartupFolderItem(index : cardinal) : TStartupFolderItem;
begin
result := TStartupFolderItem( StartupFolderList.items[index] );
end;
function TStartupMover.UserHasPermission(var failedkey : string) : boolean;
function TestForValueCreation(key : string) : boolean;
const TEST_VALUE = 'StartRightTest';
begin
try
r.SetDataString(Key, TEST_VALUE, TEST_VALUE);
r.DeleteDataString(Key, TEST_VALUE);
result := true;
except
on E: Exception do
begin
result := false;
end;
end;
end;
begin
failedkey := SR_HOME_KEY;
result := TestForValueCreation(failedkey);
failedkey := 'HKEY_LOCAL_MACHINE' + failedkey;
if (result) then begin
failedkey := WINDOWS_RUN_KEY;
result := result and TestForValueCreation(failedkey);
failedkey := 'HKEY_LOCAL_MACHINE' + failedkey;
end;
if (result) then begin
failedkey := WINDOWS_RUNONCE_KEY;
result := result and TestForValueCreation(failedkey);
failedkey := 'HKEY_LOCAL_MACHINE' + failedkey;
end;
end;
//--------------------------------------------------------------
// Move(RunKey/StartupFolder)Items
//
// RunKey
// - Move un-exluded keys to StartRight's runkey
// - create a sort index for new items
// - update locale RunKey info (since this changes it)
//--------------------------------------------------------------
procedure TStartupMover.MoveRunKeyItems(AutoDisable : boolean = false);
procedure DeleteOtherRunData(HKEYVal : HKEY);
var i : integer;
status : SR_STATUS;
rki : TRunkeyItem;
begin
for i := 0 to (RunkeyList.count - 1) do begin
rki := TRunkeyItem(RunkeyList.Items[i]);
status := UnitMyKeys.GetRunkeyStatus(rki.RunKey);
case status of
SR_STATUS_NORMAL, SR_STATUS_INCLUDED:
begin
r.DeleteDataString(HKEYVal, WINDOWS_RUN_KEY, rki.RunKey);
end;
SR_STATUS_DISABLED :
begin
ItemManager.DisableRunkeyItem(rki.RunKey);
end;
SR_STATUS_EXCLUDED :
begin
ItemManager.ExcludeRunkeyItem(rki.RunKey);
end;
end;
end;
end;
var i : integer;
sti : TRunkeyItem;
newdata : THashedStringList;
newvalues : THashedStringList;
status : SR_STATUS;
begin
//UnitMyKeys.SetCurrentUsername(UnitUtils.GetUsername);
newdata := THashedStringList.Create();
newvalues := THashedStringList.Create();
//
// Enumerate all existing windows run keys determin which keys
// are new values.
//
for i := 0 to (RunkeyList.Count - 1) do begin
sti := TRunkeyItem( RunkeyList.Items[i] );
status := UnitMyKeys.GetRunkeyStatus(sti.runkey);
case status of
SR_STATUS_NORMAL :
begin
//
// Try both current user and local machine
// Include fails if item is not found
//
ItemManager.IncludeRunkeyItem(sti.Runkey, false);
ItemManager.IncludeRunkeyItem(sti.Runkey, true);
if (frmoptions.cbAutoDisable.checked) then begin
ItemManager.DisableRunkeyItem(sti.runkey);
end;
newvalues.Add(sti.RunKey);
newdata.Add(sti.RunValue);
UnitMyKeys.SetRunLocation(sti.RunKey, sti.RunUser);
UnitMyKeys.SetRunLocationRootkey(sti.RunKey, sti.RunHKEY);
end;
end;
end;
//
// Record new items - flag when new items exist
//
r.EraseKey(SR_HOME_KEY, SR_SUB_RUNNEWITEMS);
for i := 0 to (newvalues.Count - 1) do begin
r.SetDataString(SR_RUNNEWITEMS_KEY, newvalues.Strings[i], newdata.strings[i]);
end;
if (newvalues.Count > 0) then begin
r.SetDataString(SR_HOME_KEY, SR_NEWRUNITEMS_VALUE, SR_NEWRUNITEMS_VALUE);
end;
//
// delete the other run data
//
DeleteOtherRunData(HKEY_LOCAL_MACHINE);
DeleteOtherRunData(HKEY_CURRENT_USER);
self.GetRunkeyData;
newdata.Free;
newvalues.free;
end;
procedure TStartupMover.MoveStartupFolderItems(AutoDisable : boolean = false);
var si : TStartupFolderItem;
i : integer;
dest, s, newfilename : string;
newvalues : THashedStringList;
status : SR_STATUS;
begin
//
// build my startup path
//
newvalues := THashedStringList.Create();
dest := SpecialPaths.GetStartRightStartup ;
if not DirectoryExists(dest) then begin
MkDir(dest);
end;
//
// move everything excepts what's excluded
// don't add an entry to the startupsort key
// record new items
for i := 0 to StartupFolderList.Count - 1 do begin
si := TStartupFolderItem( StartupFolderList.items[i] );
s := ExtractFilename(si.FullName);
UnitMyKeys.SetStartupLocation(
dest + ExtractFilename(si.FullName),
si.Location
);
status := UnitMyKeys.GetStartupStatus(s);
case status of
SR_STATUS_NORMAL :
begin
newfilename := ItemManager.IncludeStartupItem(si.FullName);
if (FrmOptions.cbAutoDisable.Checked) then begin
ItemManager.DisableStartupItem(newfilename);
end;
newvalues.Add(newfilename);
end;
SR_STATUS_INCLUDED :
begin
// handle programs that keep adding themselves back
// otherwise, replace missing items
if fileexists(dest + s) then begin
DeleteFile(si.FullName);
end else begin
ItemManager.IncludeStartupItem(si.FullName);
end;
end;
SR_STATUS_DISABLED :
begin
s := ItemManager.IncludeStartupItem(si.fullname);
ItemManager.DisableStartupItem(s);
end;
SR_STATUS_EXCLUDED :
begin
ItemManager.EnableStartupItem(si.FullName);
end;
end;
end;
// record the new items
r.EraseKey(SR_HOME_KEY, SR_SUB_STARTUPNEW);
for i := 0 to newvalues.Count - 1 do begin
s := SpecialPaths.GetStartRightStartup;
r.SetDataString(
SR_STARTUPNEW_KEY,
ExtractFilename(newvalues[i]),
s + ExtractFilename(newvalues[i])
);
end;
if (newvalues.Count > 0) then begin
r.SetDataString(SR_HOME_KEY, SR_NEWSTARTUPITEMS_VALUE, SR_NEWSTARTUPITEMS_VALUE );
end;
//self.GetStartupFolderData;
self.GenerateStartupFolderList;
end;
procedure TStartupMover.RestoreRunKeyItems;
var sl, sl2 : TStringList;
i : integer;
s : string;
begin
//
// read the shadow copy
//
sl2 := TStringList.Create();
sl := TStringList.Create();
r.GetValues(SR_RUN_KEY, sl );
for i := 0 to (sl.Count - 1) do begin
try
s := r.GetDataString(SR_RUN_KEY, sl[i]);
sl2.add(s);
finally
end;
end;
//
// write it back to the system's RUN key
// Remove StartRight from the system'm run key
//
for i := 0 to (sl2.count - 1) do begin
r.SetDataString(WINDOWS_RUN_KEY, sl[i], sl2[i]);
end;
self.RemoveSelfFromRun;
//
// Remove the shadowed data
// remove sort info
//
r.EraseKey(SR_HOME_KEY, SR_SUB_RUN);
r.EraseKey(SR_HOME_KEY, SR_SUB_RUNSORT);
sl.free;
sl2.free;
self.GetRunkeyData;
end;
procedure TStartupMover.RestoreStartupFolderItems;
procedure MoveFile(FullName, ToPath : string);
var exeName : string;
dest : string;
begin
exeName := ExtractFileName(FullName);
dest := IncludeTrailingPathDelimiter(ToPath) + exeName;
if FileExists( dest ) then begin
DeleteFile( dest );
end;
if CopyFile(PChar(FullName), PChar(Dest), true) then begin
DeleteFile(FullName);
end;
end;
var src, location, startup : string;
rec : TSearchRec;
rz : integer;
begin
//
// get destination Startup folder
//
Startup := SpecialPaths.GetCommonStartupPath;
src := SpecialPaths.GetStartRightStartup;
rz := FindFirst(src + '*.*', faHidden, rec);
while (rz = 0) do begin
location := UnitMykeys.GetStartupLocation(
IncludeTrailingPathDelimiter( src) + rec.name
);
try
if (location = '') then begin
MoveFile(src + rec.name, Startup);
end else begin
movefile(src + rec.name, location);
end;
except
begin
MoveFile(src + rec.name, Startup);
end;
end;
rz := FindNext(rec);
end;
//
// delete the startup sort key
//
r.EraseKey(SR_HOME_KEY, SR_SUB_STARTUPSORT);
//self.GetStartupFolderData;
self.GenerateStartupFolderList;
end;
/////////////////////////////////////////////////////////////////////////////
// Private Implemenation
/////////////////////////////////////////////////////////////////////////////
procedure TStartupMover.SetupSelfToRun(IncludeRunOnce : boolean = true);
begin
r.SetDataString(
WINDOWS_RUN_KEY,
SR_STARTRIGHT_VALUE,
'"' +Application.ExeName + '" -go '
);
if (IncludeRunOnce) then begin
self.SetupSelfToRunOnce;
end;
end;
procedure TStartupMover.RemoveSelfFromRun(IncludeRunOnce : boolean = true);
begin
r.DeleteDataString(WINDOWS_RUN_KEY, SR_STARTRIGHT_VALUE);
if (IncludeRunOnce) then begin
r.DeleteDataString(WINDOWS_RUNONCE_KEY, SR_STARTRIGHT_VALUE);
end;
end;
//---------------------------------------------------------
// Gather all the data from the Run key in the registry
// (that's a String)
//---------------------------------------------------------
procedure TStartupMover.GetRunkeyData;
function GetEXEFromRunValue(value : string) : string;
var i : integer;
begin
value := lowercase(value);
i := pos('.exe', value);
result := '';
if (i > 0) then begin
result := LeftStr(value, i + 3);
if leftstr(result,1) ='"' then
result := RightStr(result, length(result) - 1);
result := UPPERCASE(ExtractFileName(result));
end;
end;
procedure ExtractRunkeyData(HKEYVal : HKEY);
var i : integer;
s : string;
sl : TStringList;
rki : TRunKeyItem;
user : string;
begin
if HKEYVal = HKEY_CURRENT_USER then begin
user := UnitUtils.GetUsername;
end else begin
user := '';
end;
sl := TStringList.Create();
r.GetValues(HKEYVal, WINDOWS_RUN_KEY, sl);
// skip any values that may be blanks
for i := 0 to (sl.Count - 1) do begin
if (trim(sl.Strings[i]) = '') then continue;
try
rki := TRunkeyItem.Create;
s := r.GetDataString(HKEYVal, WINDOWS_RUN_KEY, sl.Strings[i]);
if (s <> '') then begin
rki.RunKey := sl.strings[i];
rki.RunValue := s;
rki.RunEXE := GetEXEFromRunValue(s);
rki.RunUser := '';
rki.RunHKEY := HKEYVal;
if (user <> UnitUtils.UNKNOWN_USER) then begin
rki.RunUser := user;
end;
RunkeyList.Add(rki);
end;
finally
end;
end;
sl.free;
end;
begin
RunkeyList.Clear;
ExtractRunkeyData(HKEY_CURRENT_USER);
ExtractRunkeyData(HKEY_LOCAL_MACHINE);
// debug data
//tsKeys.SaveToFile(f + 'keys.txt');
//tsVals.SaveToFile(f + 'vals.txt');
//tsEXEs.SaveToFile(f + 'exes.txt');
end;
//-----------------------------------------------------------------
// Build(xxx)Info - compile all the gathered info into 2 lists
//-----------------------------------------------------------------
procedure TStartupMover.GenerateStartupFolderList;
procedure ScanForFiles(path : string);
var rec : TSearchRec;
r : integer;
si : TStartupFolderItem;
begin
if (trim(path) <> '') then begin
path := IncludeTrailingPathDelimiter(path);
r := findfirst(path + '*.*', faHidden , rec);
while r = 0 do begin
si := TStartupFolderItem.Create();
si.FullName := path + rec.Name;
si.Location := path;
StartupFolderList.Add(si);
r := findnext(rec);
end;
end;
end;
var Startup, CommonStartup, AltStartup : string;
begin
Startup := SpecialPaths.GetStartupPath;
CommonStartup := SpecialPaths.GetCommonStartupPath;
AltStartup := SpecialPaths.GetAltStartupPath;
StartupFolderList.clear;
ScanForFiles(Startup);
ScanForFiles(CommonStartup);
ScanForFiles(AltStartup);
end;
function TStartupMover.IsFirstMove: boolean;
begin
result := not DirectoryExists(SpecialPaths.GetStartRightStartup);
end;
function TStartupMover.GetIsSetupToRun: boolean;
var data : string;
begin
result := r.ValueExistsString(WINDOWS_RUNONCE_KEY, SR_STARTRIGHT_VALUE, data);
end;
procedure TStartupMover.SetupSelfToRunOnce;
begin
r.SetDataString(WINDOWS_RUNONCE_KEY,
SR_STARTRIGHT_VALUE, '"' +Application.ExeName + '" -pre ' );
end;
procedure TStartupMover.DestroyHomekey;
begin
r.EraseKey('\SOFTWARE\JackassArswareOrg', 'StartRight');
end;
end.