?? regunit.pas
字號:
{
This unit is used to edit the registry
it is basically a copy of 'registry.pas'
which comes with delphi. If you use
this you dont have to give me credit or
anything.
made by blaxill
reason for creation -
i was bored and could find a
uni of this kind
Example Useage (for adding a 'run on startup' registry setting) :
procedure RunOnStartup(sProgTitle, sCmdLine: string; bStartup: boolean );
var
sKey: string;
reg : TRegIniFile;
begin
sKey := ''; //sKey := 'Once' if you wish it to only run on the next time you startup.
if bStartup = false then //If value passed is false, then value deleted from Registry.
begin
try
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.DeleteKey('Software\Microsoft' + '\Windows\CurrentVersion\Run' + sKey + #0, sProgTitle);
reg.Free;
exit;
except //Using Try Except so that if value can not be placed in registry, it
//will not give and error.
end;
end;
try
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.WriteString('Software\Microsoft' + '\Windows\CurrentVersion\Run' + sKey + #0, sProgTitle, sCmdLine );
reg.Free;
except
end;
end;
}
unit RegUnit;
interface
uses Windows;
type
TSysLocale = packed record
DefaultLCID: Integer;
PriLangID: Integer;
SubLangID: Integer;
FarEast: Boolean;
MiddleEast: Boolean;
end;
TRegKeyInfo = record
NumSubKeys: Integer;
MaxSubKeyLen: Integer;
NumValues: Integer;
MaxValueLen: Integer;
MaxDataLen: Integer;
FileTime: TFileTime;
end;
TStrings = record
Stringss : array[0..1000000] of string;
Count : integer ;
end;
TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary);
TRegDataInfo = record
RegData: TRegDataType;
DataSize: Integer;
end;
TRegistry = class(TObject)
private
FCurrentKey: HKEY;
FRootKey: HKEY;
FLazyWrite: Boolean;
FCurrentPath: string;
FCloseRootKey: Boolean;
FAccess: LongWord;
procedure SetRootKey(Value: HKEY);
protected
procedure ChangeKey(Value: HKey; const Path: string);
function GetBaseKey(Relative: Boolean): HKey;
function GetData(const Name: string; Buffer: Pointer;
BufSize: Integer; var RegData: TRegDataType): Integer;
function GetKey(const Key: string): HKEY;
procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
procedure SetCurrentKey(Value: HKEY);
public
constructor Create; overload;
constructor Create(AAccess: LongWord); overload;
destructor Destroy; override;
procedure CloseKey;
function CreateKey(const Key: string): Boolean;
function DeleteKey(const Key: string): Boolean;
function DeleteValue(const Name: string): Boolean;
function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
function GetDataSize(const ValueName: string): Integer;
function GetDataType(const ValueName: string): TRegDataType;
function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
procedure GetKeyNames(Strings: TStrings);
procedure GetValueNames(Strings: TStrings);
function HasSubKeys: Boolean;
function KeyExists(const Key: string): Boolean;
function LoadKey(const Key, FileName: string): Boolean;
procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
function OpenKeyReadOnly(const Key: String): Boolean;
function ReadCurrency(const Name: string): Currency;
function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
function ReadBool(const Name: string): Boolean;
function ReadDate(const Name: string): TDateTime;
function ReadDateTime(const Name: string): TDateTime;
function ReadFloat(const Name: string): Double;
function ReadInteger(const Name: string): Integer;
function ReadString(const Name: string): string;
function ReadTime(const Name: string): TDateTime;
function RegistryConnect(const UNCName: string): Boolean;
procedure RenameValue(const OldName, NewName: string);
function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
function RestoreKey(const Key, FileName: string): Boolean;
function SaveKey(const Key, FileName: string): Boolean;
function UnLoadKey(const Key: string): Boolean;
function ValueExists(const Name: string): Boolean;
procedure WriteCurrency(const Name: string; Value: Currency);
procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
procedure WriteBool(const Name: string; Value: Boolean);
procedure WriteDate(const Name: string; Value: TDateTime);
procedure WriteDateTime(const Name: string; Value: TDateTime);
procedure WriteFloat(const Name: string; Value: Double);
procedure WriteInteger(const Name: string; Value: Integer);
procedure WriteString(const Name, Value: string);
procedure WriteExpandString(const Name, Value: string);
procedure WriteTime(const Name: string; Value: TDateTime);
property CurrentKey: HKEY read FCurrentKey;
property CurrentPath: string read FCurrentPath;
property LazyWrite: Boolean read FLazyWrite write FLazyWrite;
property RootKey: HKEY read FRootKey write SetRootKey;
property Access: LongWord read FAccess write FAccess;
end;
TRegIniFile = class(TRegistry)
private
FFileName: string;
public
constructor Create(const FileName: string); overload;
constructor Create(const FileName: string; AAccess: LongWord); overload;
function ReadString(const Section, Ident, Default: string): string;
function ReadInteger(const Section, Ident: string;
Default: Longint): Longint;
procedure WriteInteger(const Section, Ident: string; Value: Longint);
procedure WriteString(const Section, Ident, Value: String);
function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
procedure WriteBool(const Section, Ident: string; Value: Boolean);
procedure ReadSection(const Section: string; Strings: TStrings);
procedure ReadSections(Strings: TStrings);
procedure ReadSectionValues(const Section: string; Strings: TStrings);
procedure EraseSection(const Section: string);
procedure DeleteKey(const Section, Ident: String);
property FileName: string read FFileName;
end;
var
Win32Platform: Integer = 0;
implementation
function IntToStr(I: integer): string;
begin
Str(I, Result);
end;
function StrToInt(S: string; Default:integer): integer;
begin
Val(S, Result, Result);
if result = 0 then
result := default;
end;
function AllocMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size);
FillChar(Result^, Size, 0);
end;
function DataTypeToRegData(Value: Integer): TRegDataType;
begin
if Value = REG_SZ then Result := rdString
else if Value = REG_EXPAND_SZ then Result := rdExpandString
else if Value = REG_DWORD then Result := rdInteger
else if Value = REG_BINARY then Result := rdBinary
else Result := rdUnknown;
end;
function RegDataToDataType(Value: TRegDataType): Integer;
begin
case Value of
rdString: Result := REG_SZ;
rdExpandString: Result := REG_EXPAND_SZ;
rdInteger: Result := REG_DWORD;
rdBinary: Result := REG_BINARY;
else
Result := REG_NONE;
end;
end;
procedure clear (Strings: Tstrings);
var
i : integer;
begin
i:=0;
while i <= sizeof( Strings.Stringss) do begin
strings.Stringss[i] := '';
i:= i +1;
end;
strings.Count := 0;
end;
procedure Add ( Strings : Tstrings; Instring : string);
var
i:integer;
fin:boolean;
begin
i:= 0 ;
while (i <= sizeof( Strings.Stringss)) and not (fin) do begin
if Strings.Stringss[i] = '' then begin
Strings.Stringss[i] := Instring;
fin := true;
end;
i:= i +1;
end;
strings.Count := strings.Count+1;
end;
function IsRelative(const Value: string): Boolean;
begin
Result := not ((Value <> '') and (Value[1] = '\'));
end;
constructor TRegistry.Create;
begin
RootKey := HKEY_CURRENT_USER;
FAccess := KEY_ALL_ACCESS;
LazyWrite := True;
end;
constructor TRegistry.Create(AAccess: LongWord);
begin
Create;
FAccess := AAccess;
end;
destructor TRegistry.Destroy;
begin
CloseKey;
inherited;
end;
procedure TRegistry.CloseKey;
begin
if CurrentKey <> 0 then
begin
if LazyWrite then
RegCloseKey(CurrentKey) else
RegFlushKey(CurrentKey);
FCurrentKey := 0;
FCurrentPath := '';
end;
end;
procedure TRegistry.SetRootKey(Value: HKEY);
begin
if RootKey <> Value then
begin
if FCloseRootKey then
begin
RegCloseKey(RootKey);
FCloseRootKey := False;
end;
FRootKey := Value;
CloseKey;
end;
end;
procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
begin
CloseKey;
FCurrentKey := Value;
FCurrentPath := Path;
end;
function TRegistry.GetBaseKey(Relative: Boolean): HKey;
begin
if (CurrentKey = 0) or not Relative then
Result := RootKey else
Result := CurrentKey;
end;
procedure TRegistry.SetCurrentKey(Value: HKEY);
begin
FCurrentKey := Value;
end;
function TRegistry.CreateKey(const Key: string): Boolean;
var
TempKey: HKey;
S: string;
Disposition: Integer;
Relative: Boolean;
begin
TempKey := 0;
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
if Result then RegCloseKey(TempKey)
else
begin
//ERROR
end;
end;
function TRegistry.OpenKey(const Key: String; Cancreate: boolean): Boolean;
var
TempKey: HKey;
S: string;
Disposition: Integer;
Relative: Boolean;
begin
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
TempKey := 0;
if not CanCreate or (S = '') then
begin
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
FAccess, TempKey) = ERROR_SUCCESS;
end else
Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
REG_OPTION_NON_VOLATILE, FAccess, nil, TempKey, @Disposition) = ERROR_SUCCESS;
if Result then
begin
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
ChangeKey(TempKey, S);
end;
end;
function TRegistry.OpenKeyReadOnly(const Key: String): Boolean;
var
TempKey: HKey;
S: string;
Relative: Boolean;
begin
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
TempKey := 0;
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
KEY_READ, TempKey) = ERROR_SUCCESS;
if Result then
begin
FAccess := KEY_READ;
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
ChangeKey(TempKey, S);
end
else
begin
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
STANDARD_RIGHTS_READ or KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS,
TempKey) = ERROR_SUCCESS;
if Result then
begin
FAccess := STANDARD_RIGHTS_READ or KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS;
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
ChangeKey(TempKey, S);
end
else
begin
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
KEY_QUERY_VALUE, TempKey) = ERROR_SUCCESS;
if Result then
begin
FAccess := KEY_QUERY_VALUE;
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
ChangeKey(TempKey, S);
end
end;
end;
end;
function TRegistry.DeleteKey(const Key: string): Boolean;
var
Len: DWORD;
I: Integer;
Relative: Boolean;
S, KeyName: string;
OldKey, DeleteKey: HKEY;
Info: TRegKeyInfo;
begin
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
OldKey := CurrentKey;
DeleteKey := GetKey(Key);
if DeleteKey <> 0 then
try
SetCurrentKey(DeleteKey);
if GetKeyInfo(Info) then
begin
SetString(KeyName, nil, Info.MaxSubKeyLen + 1);
for I := Info.NumSubKeys - 1 downto 0 do
begin
Len := Info.MaxSubKeyLen + 1;
if RegEnumKeyEx(DeleteKey, DWORD(I), PChar(KeyName), Len, nil, nil, nil,
nil) = ERROR_SUCCESS then
Self.DeleteKey(PChar(KeyName));
end;
end;
finally
SetCurrentKey(OldKey);
RegCloseKey(DeleteKey);
end;
Result := RegDeleteKey(GetBaseKey(Relative), PChar(S)) = ERROR_SUCCESS;
end;
function TRegistry.DeleteValue(const Name: string): Boolean;
begin
Result := RegDeleteValue(CurrentKey, PChar(Name)) = ERROR_SUCCESS;
end;
function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
begin
FillChar(Value, SizeOf(TRegKeyInfo), 0);
Result := RegQueryInfoKey(CurrentKey, nil, nil, nil, @Value.NumSubKeys,
@Value.MaxSubKeyLen, nil, @Value.NumValues, @Value.MaxValueLen,
@Value.MaxDataLen, nil, @Value.FileTime) = ERROR_SUCCESS;
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with Value do
begin
Inc(MaxSubKeyLen, MaxSubKeyLen);
Inc(MaxValueLen, MaxValueLen);
end;
end;
procedure TRegistry.GetKeyNames(Strings: TStrings);
var
Len: DWORD;
I: Integer;
Info: TRegKeyInfo;
S: string;
begin
Clear(Strings);
if GetKeyInfo(Info) then
begin
SetString(S, nil, Info.MaxSubKeyLen + 1);
for I := 0 to Info.NumSubKeys - 1 do
begin
Len := Info.MaxSubKeyLen + 1;
RegEnumKeyEx(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
Add(Strings,S);
end;
end;
end;
procedure TRegistry.GetValueNames(Strings: TStrings);
var
Len: DWORD;
I: Integer;
Info: TRegKeyInfo;
S: string;
begin
Clear(Strings);
if GetKeyInfo(Info) then
begin
SetString(S, nil, Info.MaxValueLen + 1);
for I := 0 to Info.NumValues - 1 do
begin
Len := Info.MaxValueLen + 1;
RegEnumValue(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
Add(Strings,S);
end;
end;
end;
function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
var
DataType: Integer;
begin
FillChar(Value, SizeOf(TRegDataInfo), 0);
Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil,
@Value.DataSize) = ERROR_SUCCESS;
Value.RegData := DataTypeToRegData(DataType);
end;
function TRegistry.GetDataSize(const ValueName: string): Integer;
var
Info: TRegDataInfo;
begin
if GetDataInfo(ValueName, Info) then
Result := Info.DataSize else
Result := -1;
end;
function TRegistry.GetDataType(const ValueName: string): TRegDataType;
var
Info: TRegDataInfo;
begin
if GetDataInfo(ValueName, Info) then
Result := Info.RegData else
Result := rdUnknown;
end;
procedure TRegistry.WriteString(const Name, Value: string);
begin
PutData(Name, PChar(Value), Length(Value)+1, rdString);
end;
procedure TRegistry.WriteExpandString(const Name, Value: string);
begin
PutData(Name, PChar(Value), Length(Value)+1, rdExpandString);
end;
function TRegistry.ReadString(const Name: string): string;
var
Len: Integer;
RegData: TRegDataType;
begin
Len := GetDataSize(Name);
if Len > 0 then
begin
SetString(Result, nil, Len);
GetData(Name, PChar(Result), Len, RegData);
if (RegData = rdString) or (RegData = rdExpandString) then
SetLength(Result, Length(Result))
end
else Result := '';
end;
procedure TRegistry.WriteInteger(const Name: string; Value: Integer);
begin
PutData(Name, @Value, SizeOf(Integer), rdInteger);
end;
function TRegistry.ReadInteger(const Name: string): Integer;
var
RegData: TRegDataType;
begin
GetData(Name, @Result, SizeOf(Integer), RegData);
//if RegData <> rdInteger then ReadError(Name);
end;
procedure TRegistry.WriteBool(const Name: string; Value: Boolean);
begin
WriteInteger(Name, Ord(Value));
end;
function TRegistry.ReadBool(const Name: string): Boolean;
begin
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -