home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2002 November
/
Chip_2002-11_cd1.bin
/
zkuste
/
delphi
/
unity
/
d56
/
DW
/
DW10242.ZIP
/
RegWorks.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2002-08-11
|
14KB
|
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.