delphi WinApi Registry


unit apiregistry;

interface

type
HKEY = type LongWord;
DWORD = LongWord;
BOOL = LongBool;
ACCESS_MASK = DWORD;
REGSAM = ACCESS_MASK;
_SECURITY_ATTRIBUTES =
record
nLength: DWORD;
lpSecurityDescriptor: Pointer;
bInheritHandle: BOOL;
end;
TSecurityAttributes = _SECURITY_ATTRIBUTES;
PSecurityAttributes = ^TSecurityAttributes;
PDWORD = ^DWORD;
_FILETIME = packed
record
dwLowDateTime: DWORD;
dwHighDateTime: DWORD;
end;
TFileTime = _FILETIME;
PFileTime = ^TFileTime;
const
  advapi32 = 'advapi32.dll';
  ERROR_SUCCESS = 0;
  REG_OPTION_NON_VOLATILE = ($00000000);
  _DELETE    = $00010000;
  READ_CONTROL    = $00020000;
  STANDARD_RIGHTS_WRITE    = READ_CONTROL;
  STANDARD_RIGHTS_EXECUTE = READ_CONTROL;
  STANDARD_RIGHTS_ALL    = $001F0000;
  SPECIFIC_RIGHTS_ALL    = $0000FFFF;
  ACCESS_SYSTEM_SECURITY   = $01000000;
  KEY_SET_VALUE    = $0002;
  KEY_CREATE_SUB_KEY = $0004;
  SYNCHRONIZE = $00100000;
  KEY_WRITE    = (STANDARD_RIGHTS_WRITE or
   KEY_SET_VALUE or
   KEY_CREATE_SUB_KEY) and not
   SYNCHRONIZE;
  STANDARD_RIGHTS_READ    = READ_CONTROL;
  KEY_QUERY_VALUE    = $0001;
  KEY_ENUMERATE_SUB_KEYS = $0008;
  KEY_NOTIFY    = $0010;
  KEY_READ    = (STANDARD_RIGHTS_READ or
   KEY_QUERY_VALUE or
   KEY_ENUMERATE_SUB_KEYS or
   KEY_NOTIFY) and not
   SYNCHRONIZE;
  REG_SZ    = 1;
  REG_MULTI_SZ    = 7;
  REG_EXPAND_SZ    = 2;
  REG_DWORD    = 4;
  REG_BINARY    = 3;
  REG_NONE    = 0;



function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetExpandString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetDWORD(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte): boolean;
function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegValueExists(RootKey: HKEY; Name: string): boolean;
function RegKeyExists(RootKey: HKEY; Name: string): boolean;
function RegDelValue(RootKey: HKEY; Name: string): boolean;
function RegDelKey(RootKey: HKEY; Name: string): boolean;
function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY): boolean;
function RegDisconnect(RemoteKey: HKEY): boolean;
function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string): boolean;

implementation

function RegConnectRegistry(lpMachineName: PChar; hKey: HKEY;
var phkResult: HKEY): Longint; stdcall; external advapi32 name 'RegConnectRegistryA';

function RegCloseKey(hKey: HKEY): Longint; stdcall; external advapi32 name 'RegCloseKey';

function RegCreateKeyEx(hKey: HKEY; lpSubKey: PChar;
Reserved: DWORD; lpClass: PChar; dwOptions: DWORD; samDesired: REGSAM;
lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY;
lpdwDisposition: PDWORD): Longint; stdcall; external advapi32 name 'RegCreateKeyExA';
function RegSetValueEx(hKey: HKEY; lpValueName: PChar;
Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; external advapi32 name 'RegSetValueExA';
function RegOpenKeyEx(hKey: HKEY; lpSubKey: PChar;
ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; stdcall; external advapi32 name 'RegOpenKeyExA';
function RegQueryValueEx(hKey: HKEY; lpValueName: PChar;
lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; stdcall; external advapi32 name 'RegQueryValueExA';
function RegDeleteValue(hKey: HKEY; lpValueName: PChar): Longint; stdcall; external advapi32 name 'RegDeleteValueA';
function RegDeleteKey(hKey: HKEY; lpSubKey: PChar): Longint; stdcall; external advapi32 name 'RegDeleteKeyA';
function RegEnumKeyEx(hKey: HKEY; dwIndex: DWORD; lpName: PChar;
var lpcbName: DWORD; lpReserved: Pointer; lpClass: PChar;
lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint; stdcall; external advapi32 name 'RegEnumKeyExA';
function RegEnumValue(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar;
var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD;
lpData: PByte; lpcbData: PDWORD): Longint; stdcall; external advapi32 name 'RegEnumValueA';

function LastPos(Needle: Char; Haystack: string): integer;
begin
for Result := Length(Haystack) downto 1 do
   if Haystack[Result] = Needle then
   Break;
end;

function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY):
boolean;
begin
Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) =
   ERROR_SUCCESS);
end;

function RegDisconnect(RemoteKey: HKEY): boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;

function RegSetValue(RootKey: HKEY; Name: string; ValType: Cardinal; PVal:
Pointer; ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
dispo: DWORD;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE,
   KEY_WRITE,
   nil, hTemp, @dispo) = ERROR_SUCCESS then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize)
   = ERROR_SUCCESS);
   RegCloseKey(hTemp);
   end;
end;
end;

function RegGetValue(RootKey: HKEY; Name: string; ValType: Cardinal; var PVal:
Pointer;
var ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
MyValType: DWORD;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
   then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) =
   ERROR_SUCCESS then
   begin
   GetMem(Buf, BufSize);
   if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize)
   = ERROR_SUCCESS then
   begin
   if ValType = MyValType then
   begin
   PVal := Buf;
   ValSize := BufSize;
   Result := True;
   end
   else
   begin
   FreeMem(Buf);
   end;
   end
   else
   begin
   FreeMem(Buf);
   end;
   end;
   RegCloseKey(hTemp);
   end;
end;
end;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value)
   + 1);
end;

function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0),
Length(Value) + 2);
end;

function RegSetExpandString(RootKey: HKEY; Name: string; Value: string):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0),
   Length(Value) + 1);
end;

function RegSetDword(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end;
{ codingworld.ru }
function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],
   length(Value));
end;
procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
begin
Move(Source^, Destination^, Length);
end;
function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
begin
   Dec(BufSize);
   SetLength(Value, BufSize);
   if BufSize > 0 then
   CopyMemory(@Value[1], Buf, BufSize);
   FreeMem(Buf);
   Result := True;
end;
end;

function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
begin
   Dec(BufSize);
   SetLength(Value, BufSize);
   if BufSize > 0 then
   CopyMemory(@Value[1], Buf, BufSize);
   FreeMem(Buf);
   Result := True;
end;
end;

function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
begin
   Dec(BufSize);
   SetLength(Value, BufSize);
   if BufSize > 0 then
   CopyMemory(@Value[1], Buf, BufSize);
   FreeMem(Buf);
   Result := True;
end;
end;

function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
begin
   CopyMemory(@Value, Buf, BufSize);
   FreeMem(Buf);
   Result := True;
end;
end;

function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
begin
   SetLength(Value, BufSize);
   CopyMemory(@Value[1], Buf, BufSize);
   FreeMem(Buf);
   Result := True;
end;
end;

function RegValueExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
   then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) =
   ERROR_SUCCESS);
   RegCloseKey(hTemp);
   end;
end;
end;

function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal):
boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
ValType: Cardinal;
begin
Result := False;
Value := REG_NONE;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS)
   then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil)
   = ERROR_SUCCESS);
   if Result then
   Value := ValType;
   RegCloseKey(hTemp);
   end;
end;
end;

function RegKeyExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
   then
   begin
   Result := True;
   RegCloseKey(hTemp);
   end;
end;
end;
{ codingworld.ru }
function RegDelValue(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
   then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
   RegCloseKey(hTemp);
   end;
end;
end;

function RegDelKey(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
   then
   begin
   SubKey := Copy(Name, n + 1, Length(Name) - n);
   Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
   RegCloseKey(hTemp);
   end;
end;
end;

function RegEnum(RootKey: HKEY; Name: string; var ResultList: string; const
DoKeys: Boolean): boolean;
var
i: integer;
iRes: integer;
s: string;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
ResultList := '';
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
   Result := True;
   BufSize := 1024;
   GetMem(buf, BufSize);
   i := 0;
   iRes := ERROR_SUCCESS;
   while iRes = ERROR_SUCCESS do
   begin
   BufSize := 1024;
   if DoKeys then
   iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
   else
   iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
   if iRes = ERROR_SUCCESS then
   begin
   SetLength(s, BufSize);
   CopyMemory(@s[1], buf, BufSize);
   if ResultList = '' then
   ResultList := s
   else
   ResultList := Concat(ResultList, #13#10,s);
   inc(i);
   end;
   end;
   FreeMem(buf);
   RegCloseKey(hTemp);
end;
end;

function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string):
boolean;
begin
Result := RegEnum(RootKey, Name, ValueList, False);
end;

function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
begin
Result := RegEnum(RootKey, Name, KeyList, True);
end;

end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678