Chip 2002 November/Chip_2002-11_cd1.bin/zkuste/delphi/unity/d56/DW/DW10242.ZIP/RegWorks.pas

Pascal/Delphi Source File | 2002-08-11 | 13.4 KB | 390 lines

(*---------------------------------RegWorks.pas--------------------------
 V1.0.237 - 11.08.2002 current release
------------------------------------------------------------------------*)
unit RegWorks;

interface

uses Windows, Graphics, Registry, SysUtils, Classes, StringWorks;

type
   TDWAutorunRootKey = (dwarkHKCU,
                        dwarkHKLM);
   TDWAutorunOption  = (dwaoRun,
                        dwaoRunOnce,
                        dwaoRunOnceEx,
                        dwaoRunServices,
                        dwaoRunServicesOnce);

//added rev. 1.0.237 / 30.05.2002
function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                               const AutorunOption:  TDWAutorunOption;
                               const ValueName:      String): Boolean; overload;

function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                               const AutorunOption:  TDWAutorunOption;
                               const ValueName,
                                     CommandString:  String): Boolean; overload;

function GetAutostart(const AutorunRootKey: TDWAutorunRootKey;
                      const AutorunOption:  TDWAutorunOption;
                      const ValueName:      String): String;

function RefreshIconCache: Boolean;

function RegisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
                           const AutorunOption:     TDWAutorunOption;
                           const ValueName,
                                 CommandString:     String;
                           const OverwriteExisting: Boolean): Boolean;

function UnregisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
                             const AutorunOption:     TDWAutorunOption;
                             const ValueName:         String): Boolean;

// Added rev. 1.0.236 / 10.01.2002
function RegColorToStr(const RegColor: String): String;
function ColorToRegColor(const Color: TColor): String;
function ReadRegColor(const RootKey: HKEY; const KeyName, ValueName: String): TColor;
function WriteRegColor(const Color: TColor; const RootKey: HKEY; const KeyName, ValueName: String): Boolean;

// Added rev. 1.0.235 / 27.12.2001
function HKEYToStr(const KEY: HKEY): String;
function StrToHKEY(const KEY: String): HKEY;

implementation

uses Messages;

const
   sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
   sRun =             'Run\';
   sRunOnce =         'RunOnce\';
   sRunOnceEx =       'RunOnceEx\';
   sRunServices =     'RunServices\';
   sRunServicesOnce = 'RunServicesOnce\';

function _AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                                const AutorunOption:  TDWAutorunOption;
                                const ValueName,
                                      CommandString:  String;
                                const ProofCmdStr:    Boolean): Boolean;
var
   bCanOpenKey,
   bValueExists,
   bCmdSame: Boolean;
   sOpenKey,
   sValue: String;
begin
   bCmdSame:= TRUE;
   bValueExists:= FALSE;
   with TRegistry.Create do begin
      case AutorunRootKey of
      dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
      dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
      end;
      case AutorunOption of
      dwaoRun:             sOpenKey:= sBaseKey + sRun;
      dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
      dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
      dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
      dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
      end;
      bCanOpenKey:= OpenKey(sOpenKey, FALSE);
      if bCanOpenKey then begin
         bValueExists:= ValueExists(ValueName);
         if bValueExists then begin
            sValue:= ReadString(ValueName);
            if ProofCmdStr then bCmdSame:= (sValue = CommandString);
         end;
      end;
      Free;
   end;
   result:= (bCanOpenKey and bValueExists and bCmdSame);
end;

function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                               const AutorunOption:  TDWAutorunOption;
                               const ValueName:      String): Boolean; overload;
begin
   result:= _AutostartIsRegistered(AutorunRootKey, AutorunOption, ValueName, '', FALSE);
end;

function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                               const AutorunOption:  TDWAutorunOption;
                               const ValueName,
                                     CommandString:  String): Boolean; overload;
begin
   result:= _AutostartIsRegistered(AutorunRootKey, AutorunOption, ValueName, CommandString, TRUE);
end;

function GetAutostart(const AutorunRootKey: TDWAutorunRootKey;
                      const AutorunOption:  TDWAutorunOption;
                      const ValueName:      String): String;
var
   sOpenKey: String;
begin
   with TRegistry.Create do begin
      case AutorunRootKey of
      dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
      dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
      end;
      case AutorunOption of
      dwaoRun:             sOpenKey:= sBaseKey + sRun;
      dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
      dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
      dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
      dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
      end;
      Free;
   end;
   result:= sOpenKey;
end;

function RefreshIconCache: Boolean;
const
  KEY_TYPE = HKEY_CURRENT_USER;
  KEY_NAME = 'Control Panel\Desktop\WindowMetrics';
  KEY_VALUE = 'Shell Icon Size';
var
  Reg: TRegistry;
  strDataRet, strDataRet2: string;
 procedure BroadcastChanges;
 var
   success: DWORD;
 begin
   SendMessageTimeout(HWND_BROADCAST,
                      WM_SETTINGCHANGE,
                      SPI_SETNONCLIENTMETRICS,
                      0,
                      SMTO_ABORTIFHUNG,
                      10000,
                      success);
 end;
begin
  Result := False;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := KEY_TYPE;
    // 1. open HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics
    if Reg.OpenKey(KEY_NAME, False) then
    begin
      // 2. Get the value for that key
      strDataRet := Reg.ReadString(KEY_VALUE);
      Reg.CloseKey;
      if strDataRet <> '' then
      begin
        // 3. Convert sDataRet to a number and subtract 1,
        //    convert back to a string, and write it to the registry
        strDataRet2 := IntToStr(StrToInt(strDataRet) - 1);
        if Reg.OpenKey(KEY_NAME, False) then
        begin
          Reg.WriteString(KEY_VALUE, strDataRet2);
          Reg.CloseKey;
          // 4. because the registry was changed, broadcast
          //    the fact passing SPI_SETNONCLIENTMETRICS,
          //    with a timeout of 10000 milliseconds (10 seconds)
          BroadcastChanges;
          // 5. the desktop will have refreshed with the
          //    new (shrunken) icon size. Now restore things
          //    back to the correct settings by again writing
          //    to the registry and posing another message.
          if Reg.OpenKey(KEY_NAME, False) then
          begin
            Reg.WriteString(KEY_VALUE, strDataRet);
            Reg.CloseKey;
            // 6.  broadcast the change again
            BroadcastChanges;
            Result := True;
          end;
        end;
      end;
    end;
  finally
    Reg.Free;
  end;
end;

function RegisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
                           const AutorunOption:     TDWAutorunOption;
                           const ValueName,
                                 CommandString:     String;
                           const OverwriteExisting: Boolean): Boolean;
{const
   sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
   sRun =             'Run\';
   sRunOnce =         'RunOnce\';
   sRunOnceEx =       'RunOnceEx\';
   sRunServices =     'RunServices\';
   sRunServicesOnce = 'RunServicesOnce\';}
var
   bCanOpenKey,
   bCanWriteValue,
   bValueExists: Boolean;
   sOpenKey: String;
begin
   bCanWriteValue:= FALSE;
   with TRegistry.Create do begin
      case AutorunRootKey of
      dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
      dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
      end;
      case AutorunOption of
      dwaoRun:             sOpenKey:= sBaseKey + sRun;
      dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
      dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
      dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
      dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
      end;
      bCanOpenKey:= OpenKey(sOpenKey, FALSE);
      if bCanOpenKey then begin
         bValueExists:= ValueExists(ValueName);
         bCanWriteValue:= ((bValueExists and OverwriteExisting) or (not bValueExists));
         if bCanWriteValue then WriteString(ValueName, CommandString);
      end;
      Free;
      result:= (bCanOpenKey and bCanWriteValue);
   end;
end;

function UnregisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
                             const AutorunOption:     TDWAutorunOption;
                             const ValueName:         String): Boolean;
{const
   sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
   sRun =             'Run\';
   sRunOnce =         'RunOnce\';
   sRunOnceEx =       'RunOnceEx\';
   sRunServices =     'RunServices\';
   sRunServicesOnce = 'RunServicesOnce\';}
var
   bCanOpenKey,
   bValueExists: Boolean;
   sOpenKey: String;
begin
   bValueExists:= FALSE;
   with TRegistry.Create do begin
      case AutorunRootKey of
      dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
      dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
      end;
      case AutorunOption of
      dwaoRun:             sOpenKey:= sBaseKey + sRun;
      dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
      dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
      dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
      dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
      end;
      bCanOpenKey:= OpenKey(sOpenKey, FALSE);
      if bCanOpenKey then begin
         bValueExists:= ValueExists(ValueName);
         if bValueExists then DeleteValue(ValueName);
      end;
      result:= (bCanOpenKey and bValueExists);
      Free;
   end;
end;


function HKEYToStr(const KEY: HKEY): String;
begin
   case KEY of
   HKEY_CLASSES_ROOT: result:= 'HKEY_CLASSES_ROOT';
   HKEY_CURRENT_USER: result:= 'HKEY_CURRENT_USER';
   HKEY_LOCAL_MACHINE: result:= 'HKEY_LOCAL_MACHINE';
   HKEY_USERS: result:= 'HKEY_USERS';
   HKEY_PERFORMANCE_DATA: result:= 'HKEY_PERFORMANCE_DATA';
   HKEY_CURRENT_CONFIG: result:= 'HKEY_CURRENT_CONFIG';
   HKEY_DYN_DATA: result:= 'HKEY_DYN_DATA';
   else result:= 'HKEY_LOCAL_MACHINE';
   end;
end;

function StrToHKEY(const KEY: String): HKEY;
begin
   if KEY = 'HKEY_CLASSES_ROOT' then result:= HKEY_CLASSES_ROOT else
   if KEY = 'HKEY_CURRENT_USER' then result:= HKEY_CURRENT_USER else
   if KEY = 'HKEY_LOCAL_MACHINE' then result:= HKEY_LOCAL_MACHINE else
   if KEY = 'HKEY_USERS' then result:= HKEY_USERS else
   if KEY = 'HKEY_PERFORMANCE_DATA' then result:= HKEY_PERFORMANCE_DATA else
   if KEY = 'HKEY_CURRENT_CONFIG' then result:= HKEY_CURRENT_CONFIG else
   if KEY = 'HKEY_DYN_DATA' then result:= HKEY_DYN_DATA else
   result:= HKEY_LOCAL_MACHINE;
end;

function RegColorToStr(const RegColor: String): String;
var
   TempList: TStringList;
   sR, sG, sB: String;
begin
   result:= '';
   if CountCharInStr(RegColor, ' ') <> 2 then exit;
   if (StringLen(RegColor) > 11) or
      (StringLen(RegColor) <  5) then exit;
   TempList:= TStringList.Create;
   TempList.Assign(StrToList(RegColor, ' '));
   sR:= TempList[0];
   sG:= TempList[1];
   sB:= TempList[2];
   result:= '$00' +
            IntToHex(StrToIntDef(sB, 0), 2) +
            IntToHex(StrToIntDef(sG, 0), 2) +
            IntToHex(StrToIntDef(sR, 0), 2);
   TempList.Free;
end;

function ColorToRegColor(const Color: TColor): String;
var
   clStr, sR, sG, sB: String;
const
   spc: Char = ' ';
   dlr: Char = '$';
begin
   clStr:= IntToHex(Color, 6);
   sR:= StrRight(clStr, 2);
   sG:= StrMid(clStr, 3, 2);
   sB:= StrMid(clStr, 2, 2);
   sR:= IntToStr(StrToInt(dlr + sR));
   sG:= IntToStr(StrToInt(dlr + sG));
   sB:= IntToStr(StrToInt(dlr + sB));
   result:= sR + spc + sG + spc + sB;
end;

function ReadRegColor(const RootKey: HKEY; const KeyName, ValueName: String): TColor;
var
   Reg: TRegistry;
   DataInfo: TRegDataInfo;
begin
   result:= clNone;
   Reg:= TRegistry.Create(KEY_READ);
   Reg.RootKey:= RootKey;
   with Reg do begin
      if OpenKey(KeyName, FALSE) then begin
         GetDataInfo(ValueName, DataInfo);
         if (DataInfo.RegData = rdString) then begin
            result:= StringToColor(RegColorToStr(ReadString(ValueName)));
         end;
      end;
      Free;
   end;
end;

function WriteRegColor(const Color: TColor; const RootKey: HKEY; const KeyName, ValueName: String): Boolean;
var
   Reg: TRegistry;
begin
   result:= FALSE;
   Reg:= TRegistry.Create;
   with Reg do begin
      RootKey:= RootKey;
      if OpenKey(KeyName, TRUE) then begin
         WriteString(ValueName, ColorToRegColor(Color));
         result:= TRUE;
      end;
      Free;
   end;
end;

end.