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

Pascal/Delphi Source File | 2004-10-03 | 13KB | 459 lines

unit UnitMyKeys;
{
    Purpose:
        define all registry keys used by ME

    Notes:
        There are some util functions that really don't belong here
        or anywhere else
}

interface
uses SysUtils, StrUtils, Registry, Windows;




const SR_SUB_RUN = 'Run';
const SR_SUB_RUNSORT = 'RunSort';
const SR_SUB_STARTUPSORT = 'StartupSort';
const SR_SUB_RUNNEWITEMS = 'RunNewItems';
const SR_SUB_STARTUPNEW = 'StartupNew';
const SR_SUB_EXECMETHOD = 'ExecMethod';
const SR_SUB_CUSTOMDELAYS = 'CustomDelays';
const SR_SUB_RUN_LOCATION = 'RunLocation';
const SR_SUB_STARTUP_LOCATION = 'StartupLocation';

const SR_STARTRIGHT_VALUE = 'STARTRIGHT';
const SR_EXCLUDE_DATA = 'EXCLUDE';
const SR_SORTINDEX_VALUE  = 'SortIndex';
const SR_RUNONCE_VALUE = 'RUNONCE';
const SR_NEWRUNITEMS_VALUE = 'NewRunItems';
const SR_NEWSTARTUPITEMS_VALUE = 'NewStartupItems';
const SR_ISINSTALLED_VALUE = 'IsInstalled';
const SR_LOWCPU_STAT = 'LowCPUStat';
const SR_HIGHCPU_STAT = 'HighCPUStat';


const SR_HOME_KEY = '\SOFTWARE\JackassArswareOrg\StartRight';
const SR_RUN_KEY = SR_HOME_KEY + '\' + SR_SUB_RUN;
const SR_RUNEXCLUDE_KEY =  SR_HOME_KEY +'\RunExclude';
const SR_RUNSORT_KEY = SR_HOME_KEY + '\' + SR_SUB_RUNSORT;
const SR_RUNNEWITEMS_KEY = SR_HOME_KEY + '\' + SR_SUB_RUNNEWITEMS;

const SR_STARTUPSORT_KEY = SR_HOME_KEY + '\' + SR_SUB_STARTUPSORT;
const SR_STARTUPEXCLUDE_KEY = SR_HOME_KEY +'\StartupExclude';
const SR_STARTUPDISABLE_KEY = SR_HOME_KEY +'\StartupDisable';
const SR_STARTUPNEW_KEY = SR_HOME_KEY + '\' + SR_SUB_STARTUPNEW;

const SR_EXECMETHOD_KEY = SR_HOME_KEY + '\' + SR_SUB_EXECMETHOD;
const SR_CUSTOMDELAYS_KEY = SR_HOME_KEY + '\' + SR_SUB_CUSTOMDELAYS;

const SR_RUNDISABLED_KEY = SR_HOME_KEY + '\RunDisabled';
const SR_AUTOTUNE_KEY = SR_HOME_KEY + '\AutoTune';
const SR_STARTUP_LOCATION = SR_HOME_KEY + '\' +  SR_SUB_STARTUP_LOCATION;
const SR_RUN_LOCATIOn = SR_HOME_KEY + '\' + SR_SUB_RUN_LOCATION;

const WINDOWS_CURRENT_VERSION = '\SOFTWARE\Microsoft\Windows\CurrentVersion';
const WINDOWS_APPSPATH_KEY = WINDOWS_CURRENT_VERSION + '\App Paths';
const WINDOWS_RUN_KEY = WINDOWS_CURRENT_VERSION + '\Run';
const WINDOWS_RUNONCE_KEY = WINDOWS_RUN_KEY + 'Once';


type SR_STATUS = (
    SR_STATUS_NORMAL,
    SR_STATUS_EXCLUDED,
    SR_STATUS_DISABLED,
    SR_STATUS_INCLUDED
);

function GetRunkeyStatus(value : string) : SR_STATUS;
function GetStartupStatus(value : string) : SR_STATUS;
function GetIsNewRunkey(value : string) : boolean;
function GetIsNewStartup(value : string) : boolean;

function GetRunSortCount : integer;
function GetRunSortValue(index : integer) : string;
function GetRunSortData(index : integer) : string; overload;
function GetRunSortData(value : string) : string; overload;

function GetStartupSortCount : integer;

function GetIsExcludedRunkey(value : string) : boolean;
function GetIsExcludedStartup(value : string) : boolean;

function GetEXEPathFromRunValue(value : string) : string;
function FindExecutableFromRunValue(value : string) : string;

function GetCustomDelay(value : string) : integer;
procedure SetCustomDelay(value : string; delay : integer);
function GetTunnedCustomDelay(value : string) : integer;
procedure SetTunnedCustomDelay(value : string; delay : integer);
function ReadStat(name : string; default : integer = 0) : integer;
procedure UpdateStat(name : string; value : integer);
function ReadPreviousStat(name : string; default : integer = 0) : integer;
procedure UpdatePreviousStat(name : string; value : integer);


procedure SetStartupLocation(value : string; location : string);
procedure SetRunLocation(value : string; location: string);
function GetStartupLocation(value : string) : string;
function GetRunLocation(value : string) : string;
procedure SetRunLocationRootkey(value : string; HKEYVal : HKEY);
function GetRunLocationRootkey(value : string) : HKEY;

//procedure SetCurrentUsername(name : string);
//function GetCurrentUsername : string;

function GetLowCPUStat : integer;
function GetHighCPUStat : integer;
procedure SaveLowHighCPUStats;

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

uses UnitMyRegistry,  Dialogs;
var r : TMyRegistry;
var LowCPUStat : integer;
var HighCPUStat : integer;
const HKEY_STRING = '_HKEY';

//-----------------------------------------------------
// util functions
// - getting and setting a string
// - EXE stuff
//-----------------------------------------------------


function FindExecutableFromRunValue(value : string) : string;
begin
    // extract EXE fullname from 'value'
    // if it doesn't exists, look it up in the registry under "AppsPath"
    // if it still doesn't exist, return an empty string

    result := GetEXEPathFromRunValue(value);
    if (result <> '') and
        (not FileExists(result)) then begin

        result := r.GetDataString(WINDOWS_APPSPATH_KEY + '\' + result, '');
        if (not FileExists(result)) then begin
            result := '';
        end;
    end;
end;


function GetEXEPathFromRunValue(value : string) : string;
var i : integer;
begin
    i := pos('.exe', lowercase(value));
    result := '';

    if (i > 0) then begin
        result := LeftStr(value, i + 3);

        if leftstr(result,1) ='"' then
            result := RightStr(result, length(result) - 1);
    end;
end;




//-----------------------------------------------------
// end of util functions
//-----------------------------------------------------


procedure SetCurrentUsername(name : string);
begin
    r.SetDataString(HKEY_CURRENT_USER,SR_HOME_KEY, 'username', name);
end;
function GetCurrentUsername : string;
begin
    result := r.GetDataString(HKEY_CURRENT_USER,SR_HOME_KEY, 'username');
end;


procedure SetStartupLocation(value : string; location : string);
begin
    r.SetDataString(SR_STARTUP_LOCATION, value, location);
end;
procedure SetRunLocation(value : string; location: string);
begin
    r.SetDataString(SR_RUN_LOCATION, value, location);
end;
procedure SetRunLocationRootkey(value : string; HKEYVal : HKEY);
begin
    r.SetDataInteger(SR_RUN_LOCATION, value + HKEY_STRING, HKEYVal);
end;
function GetRunLocationRootkey(value : string) : HKEY;
begin
    result := r.GetDataInteger(SR_RUN_LOCATION, value + HKEY_STRING);
end;


function GetStartupLocation(value : string) : string;
begin
    result := r.GetDataString(SR_STARTUP_LOCATION,value);
end;
function GetRunLocation(value : string) : string;
begin
    result := r.GetDataString(SR_RUN_LOCATION, value);
end;


//-----------------------------------------------------
// stat functions
//-----------------------------------------------------

function GetLowCPUStat : integer;
begin
    if not r.ValueExistsInteger(SR_AUTOTUNE_KEY, SR_LOWCPU_STAT, result) then begin
        result := 0;
    end;
end;
function GetHighCPUStat : integer;
begin
    if not r.ValueExistsInteger(SR_AUTOTUNE_KEY, SR_HIGHCPU_STAT, result) then begin
        result := 0;
    end;
end;

procedure SaveLowHighCPUStats;
begin
    r.SetDataInteger(SR_AUTOTUNE_KEY, SR_LOWCPU_STAT , LowCPUStat);
    r.SetDataInteger(SR_AUTOTUNE_KEY, SR_HIGHCPU_STAT, HighCPUStat);
end;


function ReadStat(name : string; default : integer = 0) : integer;
begin
    result := 0;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKey(SR_AUTOTUNE_KEY, true)) then begin
        if (r.ValueExists(name)) then begin
            result := r.ReadInteger(name, default);
        end;
        r.CloseKey;
    end;
end;
procedure UpdateStat(name : string; value : integer);
var x : integer;
begin

    x := ReadStat(name, 10);

    // quick and dirty exponential average (%new_value + %history)
    x := trunc((value * 0.60) + (x * 0.40));

    if (x < lowCPUStat) then lowCPUStat := x;
    if (x > highCPUStat) then HighCPUStat := x;


    r.SetDataInteger(SR_AUTOTUNE_KEY, name, x);
end;

procedure UpdatePreviousStat(name : string; value : integer);
begin
    r.SetDataInteger(SR_AUTOTUNE_KEY, name +   '_PREVIOUS', value);
end;

function ReadPreviousStat(name : string; default : integer = 0) : integer;
begin
    result := ReadStat(name + '_PREVIOUS', default);
end;


function GetTunnedCustomDelay(value : string) : integer;
begin
    result := 0;
    value := value +  '_tunned';
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKeyReadOnly(SR_CUSTOMDELAYS_KEY) then begin
        if r.ValueExists(value) then begin
            result := r.ReadInteger(value);
        end;

        r.CloseKey;
    end;
end;

procedure SetTunnedCustomDelay(value : string; delay : integer);
begin
    value := value +  '_tunned';
    r.SetDataInteger(SR_CUSTOMDELAYS_KEY, value, delay);
end;


function GetCustomDelay(value : string) : integer;
begin
    result := 0;
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKeyReadOnly(SR_CUSTOMDELAYS_KEY) then begin
        if r.ValueExists(value) then begin
            result := r.ReadInteger(value);
        end;

        r.CloseKey;
    end;
end;

procedure SetCustomDelay(value : string; delay : integer);
begin
    r.SetDataInteger(SR_CUSTOMDELAYS_KEY, value, delay);
end;


//-----------------------------------------------------
// Status function
//-----------------------------------------------------

function GetRunkeyStatus(value : string) : SR_STATUS;
var i : integer;
begin
    result := SR_STATUS_NORMAL;

    if GetIsExcludedRunkey(value) then begin
        result := SR_STATUS_EXCLUDED;
    end;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (r.OpenKeyReadOnly(SR_RUNDISABLED_KEY)) then begin
        if r.ValueExists(value) then begin
            result := SR_STATUS_DISABLED;
        end;
        r.CloseKey;
    end;

    for i := 0 to GetRunSortCount - 1 do begin
         if (lowercase(GetRunSortValue(i)) = lowercase(value)) then begin
            result := SR_STATUS_INCLUDED;
            BREAK;
         end;
    end;
end;


function GetIsExcludedRunkey(value : string) : boolean;
begin
    result := (value = SR_STARTRIGHT_VALUE);
    if result then EXIT;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (not r.OpenKeyReadOnly(SR_RUNEXCLUDE_KEY)) then EXIT;
    result :=  r.ValueExists(value);
    r.CloseKey;
end;

function GetIsExcludedStartup(value : string) : boolean;
begin
    result := false;

    r.RootKey := HKEY_LOCAL_MACHINE;
    if (not r.OpenKeyReadOnly(SR_STARTUPEXCLUDE_KEY)) then EXIT;
    result := r.ValueExists(value);
    r.CloseKey;
end;


function GetStartupStatus(value : string) : SR_STATUS;
var i, count : integer;
    s : string;
    filename : string;
begin
    result := SR_STATUS_NORMAL;

    if GetIsExcludedStartup(value) then begin
        result := SR_STATUS_EXCLUDED;
    end;

    count := GetStartupSortCount;
    for i := 0 to (count - 1) do begin
        s := r.GetDataString(SR_STARTUPSORT_KEY, IntToStr(i));
        filename := Lowercase(ExtractFileName(s));

        if (filename = Lowercase(ExtractFilename(value))) then begin
            result := SR_STATUS_INCLUDED;
        end;
    end;

    if (r.ValueExistsString(SR_STARTUPDISABLE_KEY, value, s)) then begin
        result := SR_STATUS_DISABLED;
    end;
end;



function GetIsNewRunkey(value : string) : boolean;
var data : string;
begin
    result := r.ValueExistsString(SR_RUNNEWITEMS_KEY, value, data);
end;
function GetIsNewStartup(value : string) : boolean;
var data : string;
begin
    result := r.ValueExistsString(SR_STARTUPNEW_KEY, value, data);
end;



function GetCount(Key : string) : integer;
var i : integer;
begin
    result := 0; // default to failure

    if r.ValueExistsInteger(key, SR_SORTINDEX_VALUE, i) then begin
        result := i;
    end;
end;


function GetRunSortCount : integer;
begin
    result := GetCount(SR_RUNSORT_KEY);
end;

function GetStartupSortCount : integer;
begin
    result := GetCount(SR_STARTUPSORT_KEY);
end;

function GetRunSortValue(index : integer) : string;
begin
    result := r.GetDataString(SR_RUNSORT_KEY, IntToStr(index));
end;

function GetRunSortData(index : integer) : string;
var s : string;
begin
    result := ''; // default to failure

    s := GetRunSortValue(index);
    if (s = '') then EXIT;

    result := GetRunSortData(s);
end;


function GetRunSortData(value : string) : string;
begin
    result := r.GetDataString(SR_RUN_KEY, value);
end;



initialization
begin
    r := TMyRegistry.Create;
    LowCPUStat := 100;
    HighCPUStat := 0;
end

finalization
begin
    r.Free;
end;
end.