$ Include ../cdefines.inc}
UNIT CREGISTRY;
{}
{Windows registry functions v3.01}
{}
{THIS UNIT IS COPYRIGHT? 2002-2004 by David J Butler}
{}
{THIS UNIT IS Part of Delphi Fundamentals.
{ITS Original File Name IS Cregistry.PAS}
{The Latest Version IS Available from The Fundamentals Home Page}
{Http://fundementals.sourceforge.net/}
{}
{I invite you to use this unit, free of charge.
{I invite you to distibute this unit, but it must be for free.
{I also invite you to controle to its development,}
{But do not distribute a modified copy of this file.
{}
{A forum is available on sourceforge for general discussion}
{Http://sourceforge.net/forum/forum.php?forum_id=2117}
{}
{Description:}
{Windows registry functions.
{} {Revision history:}
{2002/09/22 3.00 Created Cregistry Unit from CWindows.
{2002/12/08 3.01 small revisions.
{}
Interface
Uses
{DELPHI}
Windows,
{Fundamentals}
CUTILS;
{}
{Registry functions}
{}
Procedure splitregname
Const Name:
String;
Var Key, Valuename:
String);
{EXISTS}
Function Regkeyexists
Const rootkey: HKEY;
Const Key:
String):
Boolean;
Function regvalueexists
Const rootkey: HKEY;
Const Key, Name:
String):
Boolean;
{Set}
Function RegSetValue
Const rootkey: HKEY;
Const Key, Name:
String;
CONST VALUETYPE: Cardinal
Const value: Pointer;
Const Valuesize:
Integer:
Boolean;
OVERLOAD;
Function RegSetValue
Const rootkey: HKEY;
Const Name:
String;
CONST VALUETYPE: Cardinal
Const value: Pointer;
Const Valuesize:
Integer:
Boolean;
OVERLOAD;
Function setRegistryString
Const rootkey: HKEY;
Const Key:
String;
Const Name:
String;
Const Value:
String):
Boolean;
OVERLOAD;
Function setRegistryString
Const rootkey: HKEY;
Const Name:
String;
Const Value:
String):
Boolean;
OVERLOAD;
Function setRegistryDword (const rootkey: hkey;
Const Name:
String;
Const value: longword:
Boolean;
Function setRegistryBinary Binary (
Const rootkey: HKEY;
Const Name:
String;
CONST VALUE;
Const Valuesize:
Integer:
Boolean;
{Get}
Function ReggetValue
Const rootkey: HKEY;
Const Key, Name:
String;
CONST VALUETYPE: Cardinal
Var RegvalueType: cardinal
VAR valuebuf: Pointer;
Var valueSize:
Integer:
Boolean;
OVERLOAD;
Function ReggetValue
Const rootkey: HKEY;
Const Name:
String;
CONST VALUETYPE: Cardinal
Var RegvalueType: cardinal
VAR valuebuf: Pointer;
Var valueSize:
Integer:
Boolean;
OVERLOAD;
Function getRegistryString
Const rootkey: HKEY;
Const Key, Name:
String):
String;
OVERLOAD;
Function getRegistryString
Const rootkey: HKEY;
Const Name:
String):
String;
OVERLOAD;
Function GetRegistrydWord
Const rootkey: HKEY;
Const Key, Name:
: Longword;
{Delete}
Function deleteregistryValue
Const rootkey: HKEY;
Const Key, Name:
String):
Boolean;
Function deleteregistryKey
Const rootkey: HKEY;
Const Key:
String):
Boolean;
{Transote registries}
Function ConnectRegistry (
Const Machinename:
String;
Const rootkey: HKEY;
Var RemoteKey: HKEY):
Boolean;
Function disconnectregistry
Const Remotekey: HKey:
Boolean;
{ENUMERATE}
Function enumregistryValues
Const rootkey: HKEY;
Const Name:
String;
VAR Valuelist: StringArray:
Boolean;
Function enumregistryKeys
Const rootkey: HKEY; Const Name:
String;
VAR Keylist: StringArray:
Boolean;
IMPLEMENTATION
Uses
{DELPHI}
SYSUTILS,
{Fundamentals}
CSTRINGS;
{}
{Registry}
{}
Procedure splitregname
Const Name:
String;
Var Key, Valuename:
String);
Var S:
String;
I:
Integer;
Begin
S: = strexclsuffix (strexclprefix (Name,
'/'),
'/');
I: = poschar
'/', S);
IF i <=
0
THEN
Begin
Key: = S;
VALUENAME: =
'';
EXIT;
END;
Key: = COPYLEFT (S, I -
1);
Valuename: = CopyFrom (S, I
1);
END;
{EXISTS}
Function Regkeyexists
Const rootkey: HKEY;
Const Key:
String):
Boolean;
VAR HANDLE: HKEY;
Begin
IF Regopenkeyex (RootKey, Pchar (Key),
0, key_read, handle = error_success
THEN
Begin
Result: =
True;
RegcloseKey (Handle);
end
Else
Result: =
False;
END;
Function regvalueexists
Const rootkey: HKEY;
Const Key, Name:
String):
Boolean;
VAR HANDLE: HKEY;
Begin
IF Regopenkeyex (RootKey, Pchar (Key),
0, key_read, handle = error_success
THEN
Begin
Result: = RegQueryValueex (Handle, Pointer (Name), NIL, NIL, NIL, NIL) = Error_suCcess;
RegcloseKey (Handle);
end
Else
Result: =
False;
END;
{Set}
Function RegSetValue
Const rootkey: HKEY;
Const Key, Name:
String;
CONST VALUETYPE: Cardinal
Const value: Pointer;
Const Valuesize:
Integer:
Boolean;
VAR D: DWORD;
Handle: HKEY;
Begin
Result: =
False;
IF valueesize <
0
THEN
EXIT;
If RegcreateKeyex (Rootkey, Pchar (Key),
0, NIL, REG_OPTION_NON_VOLATILE,
Key_Write, NIL, Handle, @D) <> error_success
THEN
EXIT;
Result: = RegSetValueex (Handle, Pointer (Name),
0, valueetype, value, valueesize = error_success;
RegcloseKey (Handle);
END;
Function RegSetValue
Const rootkey: HKEY;
Const Name:
String;
CONST VALUETYPE: Cardinal
Const value: Pointer;
Const Valuesize:
Integer:
Boolean;
VAR K, N:
String;
Begin
SplitRegname (Name, K, N);
Result: = RegSetValue (RootKey, K, N, ValueType, Value, VALUESize);
END;
Function setRegistryString
Const rootkey: HKEY;
Const Key:
String;
Const Name:
String;
Const Value:
String):
Boolean;
Begin
Result: = RegSetValue (RootKey, Key, Name, Reg_SZ, Pchar (Value), Length
1);
END;
Function setRegistryString
Const rootkey: HKEY;
Const Name:
String;
Const Value:
String):
Boolean;
Begin
Result: = RegSetValue (RootKey, Name, Reg_sz, Pchar (Value), Length (Value)
1);
END;
Function setRegistryDWord
Const rootkey: HKEY;
Const Name:
String;
Const value: longword:
Boolean;
Begin
Result: = RegSetValue (rootkey, name, reg_dword, @Value, sizeof (longword));
END;
Function setRegistryBinary Binary (
Const rootkey: HKEY;
Const Name:
String;
CONST VALUE;
Const Valuesize:
Integer:
Boolean;
Begin
Result: = RegSetValue (RootKey, Name, Reg_binary, @Value, VALUESIZE);
END;
{Get}
Function ReggetValue
Const rootkey: HKEY;
Const Key, Name:
String;
CONST VALUETYPE: Cardinal
Var RegvalueType: cardinal; var valuebuf: Pointer
Var valueSize:
Integer:
Boolean;
VAR HANDLE: HKEY;
BUF: POINTER;
BUFSIZE: Cardinal
Begin
Result: =
False;
VALUESIZE: =
0;
Valuebuf: = NIL;
IF Regopenkeyex (RootKey, Pchar (Key),
0, Key_Read, Handle <> error_success
THEN
EXIT;
BUFSIZE: =
0;
RegQueryValueex (Handle, Pointer (Name), NIL, @RegvalueType, NIL, @Bufsize);
IF bufsize <=
0
THEN
EXIT;
GetMem (buf, bufsize);
If RegQueryValueex (Handle, Pointer (Name), NIL, @RegvalueType, BUF, @Bufsize) = Error_Success
THEN
Begin
Valuebuf: = BUF;
VALUESIZE: =
Integer (bufsize);
Result: =
True;
END;
IF
NOT RESULT
THEN
FreeMem (buf);
RegcloseKey (Handle);
END;
Function ReggetValue
Const rootkey: HKEY;
Const Name:
String;
CONST VALUETYPE: Cardinal
Var RegvalueType: cardinal
VAR valuebuf: Pointer;
Var valueSize:
Integer:
Boolean;
VAR K, N:
String;
Begin
SplitRegname (Name, K, N);
Result: = ReggetValue (RootKey, K, N, ValueType, RegvalueType, ValueBuf, VALUESIZE);
END;
Function getRegistryString
Const rootkey: HKEY;
Const Key, Name:
String):
String;
VAR BUF: POINTER;
Size:
Integer;
Vtype: cardinal;
Begin
Result: =
'';
IF
NOT ReggetValue (RootKey, Key, Name, Reg_sz, Vtype, BUF, SIZE)
THEN
EXIT;
IF (VTYPE = REG_DWORD)
AND (size> = sizeof (longword))
THEN
Result: = INTOSTR (Plongword (buf) ^)
Else
IF size>
0
THEN
Begin
SETLENGTH (Result, Size)
1);
MoveMem (buf ^, Pointer (Result) ^, Size
1);
END;
FreeMem (buf);
END;
Function getRegistryString
Const rootkey: HKEY;
Const Name:
String):
String;
VAR K, N:
String;
Begin
SplitRegname (Name, K, N);
Result: = GetRegistryString (RootKey, K, N); END;
Function GetRegistrydWord
Const rootkey: HKEY;
Const Key, Name:
: Longword;
VAR BUF: POINTER;
Size:
Integer;
Vtype: cardinal;
Begin
Result: =
0;
IF
NOT ReggetValue (RootKey, Key, Name, Reg_dword, Vtype, BUF, SIZE)
THEN
EXIT;
IF (VTYPE = REG_DWORD)
AND (size> = sizeof (longword))
THEN
Result: = Plongword (buf) ^;
FreeMem (buf);
END;
{Delete}
Function deleteregistryValue
Const rootkey: HKEY;
Const Key, Name:
String):
Boolean;
VAR HANDLE: HKEY;
Begin
IF Regopenkeyex (RootKey, Pchar (Key),
0, key_write, handle) = error_success
THEN
Begin
Result: = RegdeleteValue (Handle, Pointer (Name) = Error_suCcess;
RegcloseKey (Handle);
end
Else
Result: =
False;
END;
Function deleteregistryKey
Const rootkey: HKEY;
Const Key:
String):
Boolean;
VAR HANDLE: HKEY;
K, N:
String;
Begin
SplitRegname (Key, K, N);
IF regopenkeyex (RootKey, Pchar (K),
0, key_write, handle) = error_success
THEN
Begin
Result: = regdeleteKey (Handle, Pointer (N)) = Error_Success;
RegcloseKey (Handle);
end
Else
Result: =
False;
END;
{Transote registries}
Function ConnectRegistry (
Const Machinename:
String;
Const rootkey: HKEY;
Var RemoteKey: HKEY):
Boolean;
Begin
Result: = regonnectregistry (Pchar (Machinename), Rootkey, RemoteKey = Error_Success;
END;
Function disconnectregistry
Const Remotekey: HKey:
Boolean;
Begin
RESULT: = regclosekey (remotekey) = error_success;
END;
{Enumerate} Function Regenum
Const rootkey: HKEY;
Const Name:
String;
Var Resultlist: StringArray;
Const dokeys:
Boolean:
Boolean;
VAR BUF:
Array [
0 ..
2047]
Of char;
BUFSIZE: Cardinal
I:
Integer;
RES:
Integer;
S:
String;
Handle: HKEY;
Begin
Resultlist: = NIL;
Result: = regopenkeyex (rootkey, pchar (name),
0, key_read, handle = error_success;
IF
NOT RESULT
THEN
EXIT;
I: =
0;
Repeat
BUFSIZE: = Sizeof (BUF);
IF dokeys
THEN
Res: = regenumKeyex (Handle, I, @BUF [
0], BUFSIZE, NIL, NIL, NIL, NIL
Else
Res: = regenumvalue (Handle, I, @BUF [
0] BUFSIZE, NIL, NIL, NIL, NIL;
if res = error_success
THEN
Begin
SETLENGTH (S, BUFSIZE);
IF buffsize>
0
THEN
MoveMem (BUF [
0], Pointer (s) ^, buffsize;
Append (ResultList, s);
INC (I);
END;
Until RES <> Error_Success;
RegcloseKey (Handle);
END;
Function enumregistryValues
Const rootkey: HKEY;
Const Name:
String;
VAR Valuelist: StringArray:
Boolean;
Begin
Result: = Regenum (Rootkey, Name, Valuelist,
FALSE);
END;
Function enumregistryKeys
Const rootkey: HKEY;
Const Name:
String;
VAR Keylist: StringArray:
Boolean;
Begin
Result: = Regenum (Rootkey, Name, Keylist,
True);
END;
End.
