Форум программистов [Powered by Invision Power Board]

Код

unit apiregistry;

 

interface

 

uses Windows;

 

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 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;

 

function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte):

boolean;

begin

Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],

   length(Value));

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;

 

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.