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

Pascal/Delphi Source File | 2002-10-26 | 18.2 KB | 657 lines

unit UnitItemManager;
{
    Purpose:
        Create one centralized location where items
        are Excluded/Disabled/Included. PPP

    Updates:
        Items that are excluded will be removed from disabled lists
        (They can be both excluded and disabled because of the AutoExcluding)

    Notes:
        When an Item is removed from a sorted list, the sorted list
        must be recreated to keep it contiguous.
}

interface

uses Registry;

type TItemManager = class(TObject)
    private
        r : TRegistry;

        procedure AddToRunkeySortItems(value : string);
        procedure AddToStartupfolderItem(filename : string);
        procedure AddItem(key : string; itemdata : string);
        procedure DeleteStartupSortItem(filename : string);

        procedure MoveFile(FullName, ToPath : string);
    public
        constructor Create;
        destructor Destroy; override;
        procedure AutoExcludeRunkeyItems;
        procedure AutoExcludeStartupItems;

        procedure DisableRunkeyItem(value : string);
        procedure DisableStartupItem(filename : string);

        procedure ExcludeRunkeyItem(value : string);
        procedure ExcludeStartupItem(shortcutname : string);

        procedure IncludeRunkeyItem(value : string);
        procedure IncludeStartupItem(filename : string);

        procedure EnableRunkeyItem(value : string);
        procedure EnableStartupItem(filename : string);

        procedure CorrectExcludedShortcutItem(value : string);

        procedure ResortRunkeySortItems;
        procedure ResortStartupSortItems;


end;

var ItemManager : TItemManager;

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

uses Classes, Windows, UnitMyKeys, StrUtils, SysUtils, ShellAPI, ShlObj,
    UnitFrmDummyRunner, Forms, UnitSpecialPaths;

constructor TItemManager.Create;
begin
    r := TRegistry.Create;
end;

destructor TItemManager.Destroy;
begin
    r.Free;
    inherited Destroy;
end;


procedure TItemManager.CorrectExcludedShortcutItem(value : string);
var s, cs, als : string;
begin
    s := IncludeTrailingPathDelimiter(  SpecialPaths.GetStartupPath);
    cs := IncludeTrailingPathDelimiter(  SpecialPaths.GetCommonStartupPath);
    als := IncludeTrailingPathDelimiter(  SpecialPaths.GetAltStartupPath);

    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_STARTUPEXCLUDE_KEY, false) then begin
        if FileExists(s + value) then begin
            r.WriteString(value, s + value);
        end else if FileExists(cs + value) then begin
            r.WriteString(value, cs + value);
        end else if FileExists(als + value) then begin
             r.WriteString(value, als + value);
        end;
        r.CloseKey;
    end;
end;

procedure TItemManager.DisableStartupItem(filename : string);
var j, index : longint;
    value : string;
begin
    // write the value to the disabled items
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPDISABLE_KEY, true)) then begin
        r.WriteString(ExtractFilename(filename), filename);
        r.CloseKey;
    end;

    // find the sorted item and remove it
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPSORT_KEY, false)) then begin
        try
            index := r.ReadInteger(SR_SORTINDEX_VALUE);
            for j := 0 to (index - 1) do begin
                value := r.ReadString(IntToStr(j));
                if lowercase(value) = lowercase(filename) then begin
                    r.DeleteValue(IntToStr(j));
                end;
            end;
        finally
            r.CloseKey;
        end;
    end;

    self.ResortStartupSortItems;
end;


procedure TItemManager.AutoExcludeStartupItems;
    procedure ScanForFiles(path : string; files : TStringList);
    var rec : TSearchRec;
        r : integer;
    begin
        if (trim(path) <> '') then begin
            path := IncludeTrailingPathDelimiter(path);

            r := findfirst(path + '*.*', faHidden  , rec);
            while r = 0 do begin
                files.Add(rec.Name);

                r := findnext(rec);
            end;
        end;
    end;
var
   Startup, CommonStartup, AltStartup : string;
   newExcludes, files : TStringList;
   i, cnt : longint;
   s : string;

begin
    files := TStringList.Create;
    newExcludes := TStringList.Create;

    //
    // get all existing startup folder files
    //

    Startup := SpecialPaths.GetStartupPath;
    CommonStartup := SpecialPaths.GetCommonStartupPath;
    AltStartup := SpecialPaths.GetAltStartupPath;

    ScanForFiles(Startup, files);
    ScanForFiles(CommonStartup, files);
    ScanForFiles(AltStartup, files);

    //
    // search for my startup files for matches in the startupsort key
    // exclude all matches (remove the startup sort item and add it to excluded list)
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPSORT_KEY, false )) then begin
        cnt := r.ReadInteger(SR_SORTINDEX_VALUE);
        for i := 0 to (cnt - 1) do begin
            s := ExtractFilename(r.ReadString(IntToStr(i)));
            if (files.IndexOf(s) <> - 1) then begin
                r.DeleteValue(IntToStr(i));
                newExcludes.Add(s);
            end;
        end;

        r.closekey;
    end;


    for i := 0 to (newExcludes.Count - 1) do begin
        ExcludeStartupItem(newExcludes.Strings[i]);
    end;

    files.Free;
    newExcludes.Free;
end;



procedure TItemManager.ExcludeStartupItem(shortcutname : string);
var src, startup : string;
begin
    //
    // move file back to system's startup folder
    // write to excluded list
    // remove from disabled list
    // (autoexcluded items that are also disabled don't work anyways)
    startup := SpecialPaths.GetCommonStartupPath;
    src := SpecialPaths.GetStartRightStartup;

    MoveFile(src + ExtractFilename(shortcutname), Startup);

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPEXCLUDE_KEY, true)) then begin
        r.WriteString(ExtractFilename(ShortcutName),
            IncludeTrailingPathDelimiter(Startup) + ExtractFilename(Shortcutname));
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPDISABLE_KEY, false)) then begin
        r.DeleteValue(ExtractFilename(shortcutname));
        r.closekey;
    end;

    self.DeleteStartupSortItem(shortcutname);
end;

procedure TItemManager.AutoExcludeRunkeyItems;
var winrun, myrun, exclude : TStringList;
    i : longint;
    s : string;
begin
    winrun := TStringList.Create;
    myrun := TStringList.Create;
    exclude  := TStringList.Create;

    //
    // get both run keys and compare for matches
    // on a match, delete from my run key and add to excluded items
    //
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(WINDOWS_RUN_KEY, false)) then begin
        r.GetValueNames(winrun);
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUN_KEY, false)) then begin
        r.GetValueNames(myrun);

        for i := 0 to (myrun.Count - 1) do begin
            s := myrun.Strings[i];
            if (winrun.IndexOf(s) <> -1) then begin
                exclude.Add(s);
                r.DeleteValue(s);
            end;
        end;
        r.CloseKey;
    end;
    self.ResortStartupSortItems;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNEXCLUDE_KEY, false)) then begin
        for i := 0 to (exclude.Count - 1) do begin
            r.WriteString(exclude.Strings[i], SR_EXCLUDE_DATA);
        end;
        r.CloseKey;
    end;


    winrun.free;
    myrun.Free;
    exclude.free;
end;



procedure TItemManager.ExcludeRunkeyItem(value : string);
var data : string;
begin
    // add the items to the registry excluded list
    // read the data from SR's run key and delete the value
    // if was Disabled - it didn't work so remove it from disabled list
    // add the value/data back to the Windows' Run key
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNEXCLUDE_KEY, true)) then begin
        r.WriteString(value, SR_EXCLUDE_DATA);
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUN_KEY, false)) then begin
        data := r.ReadString(value);
        r.DeleteValue(value);
        r.CloseKey;
    end;
    self.ResortRunkeySortItems;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_RUNDISABLED_KEY, false) then begin
        r.DeleteValue(value);
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(WINDOWS_RUN_KEY, false)) then begin
        r.WriteString(value, data);
        r.CloseKey;
    end;
end;

procedure TItemManager.DisableRunkeyItem(value : string);
var i : longint;
    runvalue, rundata : string;
    SortValues : TStringList;
begin
    SortValues := TStringList.Create;

    // Delete the run key value
    // [save the data for later]
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUN_KEY, false)) then begin
        rundata := r.ReadString(value);
        r.DeleteValue(value);
        r.CloseKey;
    end;

    // find all entries in the RunSort key and remove them
    // [there should only be one key, but older versions might
    // screw that up]
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNSORT_KEY, false)) then begin
        r.GetValueNames(SortValues);
        SortValues.Delete(SortValues.IndexOf(SR_SORTINDEX_VALUE));

        for i := (SortValues.Count - 1) downto 0 do begin
            RunValue := r.ReadString(SortValues.Strings[i]);
            if RunValue = value then begin
                r.DeleteValue(SortValues.Strings[i]);
            end;
        end;
        r.CloseKey;
    end;

    // Add the entry into the RunDisabled key, so that it
    // may be enabled at at future date
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNDISABLED_KEY, true)) then begin
        r.WriteString(value, rundata);
        r.CloseKey;
    end;

    // resort since we just screwed up the contiguos numbers
    // in the sort key

    self.ResortRunkeySortItems;
    SortValues.Free;
end;




procedure TItemManager.IncludeRunkeyItem(value : string);
var rundata : string;
begin
    // Find the item in windows' run key
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(WINDOWS_RUN_KEY, false) then begin
        rundata := r.ReadString(value);
        r.CloseKey;
    end;

    // Ignore if item doesn't exist
    // write into my runkey
    if (rundata <> '') then begin
        r.RootKey := HKEY_LOCAL_MACHINE;
        if r.OpenKey(SR_RUN_KEY, true) then begin
            r.WriteString(value, rundata);
            r.CloseKey;
        end;
        self.AddToRunkeySortItems(value);
        self.ResortRunkeySortItems; {just to be sure}
    end;

    // remove from my excluded list
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_RUNEXCLUDE_KEY, false) then begin
        r.DeleteValue(value);
        r.CloseKey;
    end;
end;
procedure TItemManager.IncludeStartupItem(filename : string);
var dest : string;
begin
    // move the file back to the SR's startup folder
    // remove the item from the exclusion list
    dest := SpecialPaths.GetStartRightStartup;
    if FileExists(filename) then begin
        MoveFile(FileName, dest);
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_STARTUPEXCLUDE_KEY, false) then begin
        r.DeleteValue(ExtractFileName(filename));
        r.CloseKey;
    end;

    self.AddToStartupfolderItem(IncludeTrailingPathDelimiter(dest)
        + ExtractFilename(filename));
end;


procedure TItemManager.EnableRunkeyItem(value : string);
var rundata : string;
begin
    // Find the data in my disabled list
    // and remove it
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKey(SR_RUNDISABLED_KEY, false) then begin
        rundata := r.ReadString(value);
        r.DeleteValue(value);
        r.CloseKey;
    end;

    // Ignore if item doesn't exist
    // write into my runkey
    if (rundata <> '') then begin
        r.RootKey := HKEY_LOCAL_MACHINE;
        if r.OpenKey(SR_RUN_KEY, false) then begin
            r.WriteString(value, rundata);
            r.CloseKey;
        end;
        self.AddToRunkeySortItems(value);
        self.ResortRunkeySortItems; {just to be sure}
    end;
end;

procedure TItemManager.EnableStartupItem(filename : string);
begin
    // remove the disable key
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPDISABLE_KEY, false)) then begin
        r.DeleteValue(ExtractFilename(filename));
        r.closekey;
    end;

    self.AddToStartupfolderItem(filename);
end;


//====================================
// Util methods
//====================================





procedure TItemManager.ResortRunKeySortItems;
var runvalues, values, data : TStringList;
    sortdata : string;
    i : longint;
begin
    values := TStringList.Create;
    data := TStringList.Create;
    runvalues := TStringList.Create;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUN_KEY, false)) then begin
        r.GetValueNames(runvalues);
        r.CloseKey;
    end;

    //
    // read the Startup sort data
    // remove any invalid entries and the SortIndex value

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNSORT_KEY, false)) then begin
        r.GetValueNames(values);
        for i := (values.Count - 1) downto 0 do begin
            if (values.Strings[i] = SR_SORTINDEX_VALUE) then begin
                values.Delete(i);
                CONTINUE;
            end;

            {remove sort links to items no longer in the run key}
            sortdata := r.ReadString(values.Strings[i]);
            if (runvalues.IndexOf(sortdata) <> -1) then begin
                data.Insert(0, sortdata);
            end else begin
                values.Delete(i);
            end;
        end;

        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false)) then begin
        r.DeleteKey(SR_SUB_RUNSORT);
        r.CreateKey(SR_SUB_RUNSORT);
        r.CloseKey;
    end;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_RUNSORT_KEY, false)) then begin
        for i := 0 to (data.Count - 1) do begin
            r.WriteString(IntToStr(i), data.Strings[i]);
        end;
        r.WriteInteger(SR_SORTINDEX_VALUE, data.count);
        r.CloseKey;
    end;

    runvalues.Free;
    values.Free;
    data.Free;
end;


procedure TItemManager.ResortStartupSortItems;
begin
    self.DeleteStartupSortItem('');
end;




//================================
// Private Implemenation
//================================

procedure TItemManager.AddItem(key : string; itemdata : string);
var i, sortIndex : integer;
    values, data : TStringList;
begin
    values := TStringList.Create;
    data := TStringList.Create;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(KEY, true)) then begin
        // read current list of items / so duplicates
        // can be ignored
        r.GetValueNames(values);
        i := values.IndexOf(SR_SORTINDEX_VALUE);
        if (i <> -1) then values.Delete(i);
        for i := 0 to (values.count - 1) do begin
            data.Add(r.ReadString(values[i]));
        end;


        // read the sort index (default if doesn't exist)
        // write new entry at end of list
        // increment the sort index
        if (not r.ValueExists(SR_SORTINDEX_VALUE)) then begin
            sortIndex := 0;
        end else begin
            sortIndex := r.ReadInteger(SR_SORTINDEX_VALUE);
        end;

        {Add only if doesn't already exist}
        if (data.IndexOf(itemdata) = -1) then begin
            r.WriteString(IntToStr(sortIndex), itemdata);
            r.WriteInteger(SR_SORTINDEX_VALUE, sortIndex + 1);
        end;
        r.CloseKey;
    end;

    values.Free;
    data.Free;
end;

procedure TItemManager.AddToStartupfolderItem(filename : string);
begin
    self.AddItem(SR_STARTUPSORT_KEY, filename);
end;

procedure TItemManager.AddToRunkeySortItems(value : string);
begin
    self.AddItem(SR_RUNSORT_KEY, value);
end;


procedure TItemManager.DeleteStartupSortItem(filename : string);
var values, data : TStringList;
    i : integer;
    s : string;
begin
    //
    values := TStringList.Create();
    data := TStringList.Create();

    //
    // extract the existing values/data
    // [minus the sort index]
    // [delete any entries matching filename]
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPSORT_KEY, false)) then begin
        r.GetValueNames(values);
        values.Delete(values.IndexOf(SR_SORTINDEX_VALUE));

        for i := 0 to values.Count - 1 do begin
            s := r.ReadString(values[i]);
            if (filename <> s) or (filename = '') then begin
                data.Add(s);
            end else begin
                values.Delete(i);
            end;
        end;

        r.CloseKey;
    end;

    //
    // delete existing and recreate
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_HOME_KEY, false)) then begin
        r.DeleteKey(SR_SUB_STARTUPSORT);
        r.CreateKey(SR_SUB_STARTUPSORT);
        r.CloseKey;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_STARTUPSORT_KEY, false)) then begin
        for i := 0 to (values.Count - 1) do begin
            r.WriteString(values[i], data[i]);
        end;
        r.WriteInteger(SR_SORTINDEX_VALUE, values.count);
        r.CloseKey;
    end;

    values.free;
    data.Free;
end;


procedure TItemManager.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 (lowercase(dest) <> lowercase(fullname)) then begin
        if CopyFile(PChar(FullName), PChar(Dest), true) then begin
            DeleteFile(FullName);
        end;
    end;
end;






initialization
    ItemManager := TItemManager.Create();
end.