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

Pascal/Delphi Source File | 2002-10-26 | 16.2 KB | 651 lines

unit UnitStartupMover;
{
    Purpose:
        Move all unexluded items into StartRight
        or
        Restore all items back to the system

    Updates:
        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, Registry, 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;
    RunProcID : cardinal;
    public
        function ToString() : string;
end;

type TStartupFolderItem = Class(Tobject)
    FullName : String;
end;


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

        tsVals : THashedStringList;
        tsKeys : THashedStringList;
        tsEXEs : THashedStringList;

        tsProc : THashedStringList;
        tsProcID : THashedStringList;

        RunkeyList : TObjectList;
        StartupFolderList : TObjectList;

        HasNewItems : boolean;


        procedure GetRunkeyData;
        procedure GetStartupFolderData;
        procedure GenerateRunkeyList;
        procedure GenerateStartupFolderList;
        procedure SetupSelfToRun;

    public
        constructor Create(handle : THandle);
        destructor Destroy(); override;


        function GetRunkeyItemsCount : cardinal;
        function GetRunkeyItem(index : cardinal) : TRunkeyItem;
        function GetStartupFolderItemsCount : cardinal;
        function GetStartupFolderItem(index : cardinal) : TStartupFolderItem;

        procedure MoveRunKeyItems;
        procedure MoveStartupFolderItems;


        procedure RestoreRunKeyItems;
        procedure RestoreStartupFolderItems;

        function GetHasNewItems : boolean;
end;


{////////////////////}
{//}implementation

uses UnitSpecialPaths, UnitItemManager;{//}
{////////////////////}


function TRunkeyItem.ToString() : string;
begin
    result := self.RunKey + '|' + self.RunValue + '|' + self.RunEXE + '|' + IntToStr(self.RunProcID);
end;



////////////////////////////////
// Public Interface
////////////////////////////////

function TStartupMover.GetHasNewItems : boolean;
begin
    result := self.HasNewItems;
end;

constructor TStartupMover.Create(handle : THandle);
begin
    h := handle;
    r := TRegistry.Create();

    tsKeys := THashedStringList.Create();
    tsVals := THashedStringList.Create();
    tsEXEs := THashedStringList.Create();

    tsProc :=  THashedStringList.Create();
    tsProcID := THashedStringList.Create();

    RunkeyList := TObjectList.Create();
    StartupFolderList := TObjectList.Create();

    //
    // Purpose: Gather everything needed to create the RunkeyList
    //          and the StartupFolderList
    //

    self.HasNewItems := false;
    self.GetRunkeyData;
    self.GetStartupFolderData;
    self.GenerateRunkeyList;
    self.GenerateStartupFolderList;

    HasNewItems := false;
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;


//--------------------------------------------------------------
// 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;
    procedure DeleteOtherRunData(excluded : THashedStringList);
    var i : integer;
    begin
        if (r.OpenKey(WINDOWS_RUN_KEY, false)) then begin
            for i := 0 to (tsKeys.Count - 1) do begin
                if (tsKeys[i] <> SR_STARTRIGHT_VALUE) and
                    (excluded.IndexOf(tsKeys[i]) = -1 ) then begin
                    r.DeleteValue(tsKeys[i]);
                end;
            end;
            r.CloseKey;
        end;
    end;

var i : integer;
    sti : TRunkeyItem;
    excluded : THashedStringList;
    newvalues : THashedStringList;

begin
    excluded := THashedStringList.Create();
    newvalues := THashedStringList.Create();
    //
    // read excluded key names
    // [exclude StartRight always]
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNEXCLUDE_KEY, false)) then begin
        r.GetValueNames(excluded);
        r.CloseKey;
    end;
    excluded.Add(SR_STARTRIGHT_VALUE);

    //
    // Copy all keys, except for those that are excluded (and ME!)
    // Write all new items into the registry
    for i := 0 to (RunkeyList.Count - 1) do begin
        sti := TRunkeyItem( RunkeyList.Items[i] );

        if (excluded.IndexOf(sti.RunKey ) = -1) then begin
            ItemManager.IncludeRunkeyItem(sti.Runkey);
            newvalues.Add(sti.RunKey);
        end;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false)) then begin
        r.DeleteKey(SR_SUB_RUNNEWITEMS);
        r.CloseKey;
    end;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNNEWITEMS_KEY, true)) then begin
        for i := 0 to (newvalues.Count - 1) do begin
            r.WriteString(newvalues.Strings[i], 'NEW');
        end;
        r.CloseKey;
    end;
    self.HasNewItems := self.HasNewItems or (newvalues.Count > 0);


    //
    // delete the other run data
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    DeleteOtherRunData(excluded);

    r.RootKey := HKEY_CURRENT_USER;
    DeleteOtherRunData(excluded);

    self.SetupSelfToRun;
    self.GetRunkeyData;
    self.GenerateRunkeyList;


    excluded.Free;
    newvalues.free;
end;

procedure TStartupMover.MoveStartupFolderItems;
var si : TStartupFolderItem;
    i : integer;
    dest, s : string;

    excluded : THashedStringList;
    disabled, newvalues : THashedStringList;
begin
    //
    // build my startup path
    //
    excluded := THashedStringList.Create();
    disabled := THashedStringList.Create();
    newvalues := THashedStringList.Create();

    dest := SpecialPaths.GetStartRightStartup ;
    if not DirectoryExists(dest) then begin
        MkDir(dest);
    end;


    //
    // get excluded/disabled shortcuts
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPEXCLUDE_KEY, false)) then begin
        r.GetValueNames(excluded);
        r.CloseKey;
    end;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPDISABLE_KEY, false)) then begin
        r.GetValueNames(disabled);
        r.CloseKey;
    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);
        if (excluded.IndexOf(s) = -1)
            and (disabled.indexOf(s) = -1) then begin
            ItemManager.IncludeStartupItem(si.FullName);
            newvalues.Add(si.fullname);
        end;
    end;
    // record the new items
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false)) then begin
        r.DeleteKey(SR_SUB_STARTUPNEW);
        r.CreateKey(SR_SUB_STARTUPNEW);
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPNEW_KEY, true)) then begin
        for i := 0 to newvalues.Count - 1 do begin
            s := SpecialPaths.GetStartRightStartup;
            r.WriteString(ExtractFilename(newvalues[i]), s + ExtractFilename(newvalues[i]));
        end;
        r.CloseKey;
    end;
    self.HasNewItems := self.HasNewItems or (newvalues.Count > 0);


    excluded.Free;
    disabled.Free;

    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.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_RUN_KEY, false) then begin
        r.GetValueNames(sl);

        for i := 0 to (sl.Count - 1) do begin
            try
               s := r.ReadString(sl[i]);
               sl2.add(s);
            finally
            end;
        end;

        r.CloseKey;
    end;

    //
    // write it back to the system's RUN key
    // Remove StartRight from the system'm run key
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(WINDOWS_RUN_KEY, false)) then begin
        for i := 0 to (sl2.count - 1) do begin
            r.WriteString(sl[i], sl2[i]);
        end;

        r.DeleteValue(SR_STARTRIGHT_VALUE);
        r.CloseKey;
    end;

    //
    // Remove the shadowed data
    // remove sort info
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false )) then begin
        r.DeleteKey(SR_SUB_RUN);
        r.DeleteKey(SR_SUB_RUNSORT);
        r.CloseKey;
    end;

    sl.free;
    sl2.free;

    self.GetRunkeyData;
    self.GenerateRunkeyList;
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, 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
        MoveFile(src + rec.name, Startup);

        rz := FindNext(rec);
    end;

    //
    // delete the startup sort key
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false)) then begin
        r.DeleteKey(SR_SUB_STARTUPSORT);
        r.CloseKey;
    end;


    self.GetStartupFolderData;
    self.GenerateStartupFolderList;
end;







/////////////////////////////////////////////////////////////////////////////
// Private Implemenation
/////////////////////////////////////////////////////////////////////////////



procedure TStartupMover.SetupSelfToRun;
begin
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.openkey(WINDOWS_RUN_KEY, false)) then begin
        r.WriteString(SR_STARTRIGHT_VALUE, '"' +Application.ExeName + '" -go ' );
        r.CloseKey;
    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();
    var i : integer;
        s : string;
        sl : TStringList;
    begin
        sl := TStringList.Create();
        if (r.OpenKey(WINDOWS_RUN_KEY, false)) then begin
            r.GetValueNames(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
                    s := r.ReadString( sl.Strings[i] );
                    if (s <> '') then begin
                        tsKeys.Add(sl.Strings[i]);
                        tsVals.add(s);
                        tsEXEs.Add( GetEXEFromRunValue(s) );
                    end;
                finally
                end;
            end;

            r.CloseKey;
        end;
        sl.free;
    end;
var f : string;
begin
    tsKeys.Clear;
    tsVals.Clear;
    tsEXEs.Clear;

    r.RootKey := HKEY_LOCAL_MACHINE;
    ExtractRunkeyData;


    r.RootKey := HKEY_CURRENT_USER;

    // debug data
    ExtractRunkeyData;
    f := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
    tsKeys.SaveToFile(f + 'keys.txt');
    tsVals.SaveToFile(f + 'vals.txt');
    tsEXEs.SaveToFile(f + 'exes.txt');
end;






//-------------------------------------------------------------------
// Get the Process EXE & Process ID name from a current snapshot
//-------------------------------------------------------------------
procedure TStartupMover.GetStartupFolderData;
var h : THandle;
    b : longbool;
    s : string;
    pInfo : TProcessEntry32;
begin
    h := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if (h <> 0) then begin
        pInfo.dwSize := sizeof(pInfo);
        b := Process32First(h, pInfo);

        while b do begin
            s := UPPERCASE(String(pInfo.szExeFile));
            tsProc.Add( s );
            tsProcID.Add( IntToStr(pInfo.th32ProcessID) );
            b := Process32Next(h, pInfo);
        end;

        CloseHandle(h);
    end;
end;


//-----------------------------------------------------------------
// Build(xxx)Info - compile all the gathered info into 2 lists
//-----------------------------------------------------------------

procedure TStartupMover.GenerateRunkeyList;
var sti : TRunkeyItem;
    i : integer;
    idx : integer;
begin
    RunkeyList.Clear;

    for i := 0 to tsKeys.Count - 1 do begin
        sti := TRunkeyItem.Create();

        sti.RunKey := tsKeys[i];
        sti.RunValue := tsVals[i];
        sti.RunEXE := tsEXEs[i];
        sti.RunProcID := 0;
        idx := tsProc.IndexOf(sti.RunEXE);
        if (idx <> -1) then begin
            sti.RunProcID := StrToInt( tsProcID[i] );
        end;

        RunkeyList.Add(sti);
    end;
end;

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;
                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;









end.