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

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.