Реестр

Как работать с реестром Windows?

2022-02-10T21:02:32+07:00

Вот небольшой пример работы с системным реестром;

Code:

uses

Registry, Windows;

procedure TForm1.Button1Click(Sender: TObject);

var

Registry: TRegistry;

begin

{ создаём объект TRegistry }

Registry := TRegistry.Create;

{ устанавливаем корневой ключ; напрмер hkey_local_machine или hkey_current_user }

Registry.RootKey := hkey_local_machine;

{ открываем и создаём ключ }

Registry.OpenKey('software\MyRegistryExample',true);

{ записываем значение }

Registry.WriteString('MyRegistryName','MyRegistry Value');

{ закрываем и освобождаем ключ }

Registry.CloseKey;

Registry.Free;

end;

// для удаления ключа используется функция Registry.DeleteKey

Как работать с реестром средствами API?

2022-02-10T21:22:01+07:00

Создать подраздел в реестре:

RegCreateKey (Key:HKey; SubKey: PChar; var Result: HKey): Longint;

Key - указывает на "корневой" раздел реестра, в Delphi1 доступен только один - HKEY_CLASSES_ROOT, а в Delphi3 - все.

SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1\subkey2\ ...). Если такой раздел уже существует, то он открывается.

В любом случае при успешном вызове Result содержит Handle на раздел.

Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка.

Открыть подраздел:

RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Раздел Key

Подраздел SubKey

Возвращает Handle на подраздел в переменной Result. Если раздела с таким именем нет, то он не создается.

Возврат - код ошибки или ERROR_SUCCESS, если успешно.

Закрывает раздел:

RegCloseKey(Key: HKey): Longint;

Закрывает раздел, на который ссылается Key.

Возврат - код ошибки или ERROR_SUCCESS, если успешно.

Удалить подраздел:

RegDeleteKey(Key: HKey; SubKey: PChar): Longint;

Удалить подраздел Key\SubKey.

Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Получить имена всех подразделов раздела Key:

RegEnumKey(Key:HKey; index: Longint; Buffer: PChar; cb: Longint): Longint;

Key - Handle на открытый или созданный раздел

Buffer - указатель на буфер

cb - размер буфера

index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой

Возвращает текстовую строку, связанную с ключом Key\SubKey:

RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;

Ключ\подключ Key\SubKey.

Value - буфер для строки

cb - размер, на входе - размер буфера, на выходе - длина возвращаемой строки.

Возврат - код ошибки.

Задать новое значение ключу Key\SubKey:

RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;

Ключ\подключ Key\SubKey.

ValType - тип задаваемой переменной,

Value - буфер для переменной

cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ.

Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Удаляет значение lpValueName находящееся в ключе hKey:

RegDeleteValue(HKEY hKey, LPCTSTR lpValueName);

hKey - ключ. hKey должен был быть открыт с доступом KEY_SET_VALUE процедурой RegOpenKey.

lpValueName - значение, находящееся в ключе hKey.

Возвращает ERROR_SUCCESS если успешно.

Выдает список значений у ключа hKey:

LONG RegEnumValue( HKEY hKey, DWORD dwIndex, LPTSTR lpValueName, LPDWORD lpcbValueName, LPDWORD lpReserved, LPDWORD lpType, LPBYTE lpData, LPDWORD lpcbData);

hKey - ключ.

dwIndex - этот параметр должен быть 0 при первом вызове, а далее по анологии с RegEnumKey (т.е. можно использовать в цикле),

lpValueName - буфер для названия значения

lpcbValueName - размер lpValueName

lpReserved должно быть всегда 0

lpType - буфер для названия типа (int)

lpData - буфер для данных

lpcbData-размер для lpData

Примечание:

При каждой новом вызове функции после предыдущего нужно заново переназначить lpcbValueName.

lpcbValueName = sizeof(lpValueName)

Примеры:

Code:

{ Создаем список всех подразделов указанного раздела }

procedure TForm1.Button1Click(Sender: TObject);

var

MyKey: HKey; { Handle для работы с разделом }

Buffer: array[0 .. 1000] of char; { Буфер }

Err, { Код ошибки }

index: longint; { Индекс подраздела }

begin

Err := RegOpenKey(HKEY_CLASSES_ROOT, 'DelphiUnit', MyKey); { Открыли раздел }

if Err <> ERROR_SUCCESS then

begin

MessageDlg('Нет такого раздела !!', mtError, [mbOk], 0);

exit;

end;

index := 0;

{Определили имя первого подраздела }

Err := RegEnumKey(MyKey, index, Buffer, Sizeof(Buffer));

while err = ERROR_SUCCESS do { Цикл, пока есть подразделы }

begin

memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }

inc(index); { Увеличим номер подраздела }

Err := RegEnumKey(MyKey, index, Buffer, Sizeof(Buffer)); { Запрос }

end;

RegCloseKey(MyKey); { Закрыли подраздел }

end;

Взято с https://delphiworld.narod.ru

Реестр предназначен для хранения системных переменных и позволяет зарегистрировать файлы программы, что обеспечивает их показ в проводнике с соответствующей иконкой, вызов программы при щелчке на этом файле, добавление ряда команд в меню, вызываемое при нажатии правой кнопки мыши над файлом. Кроме того, в реестр можно внести некую свою информацию (переменные, константы, данные о инсталлированной программы ...). Программу можно добавить в список деинсталляции, что позволит удалить ее из менеджера "Установка/Удаление программ" панели управления.

Для работы с реестром применяется ряд функций API :

RegCreateKey (Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Создать подраздел в реестре. Key указывает на "корневой" раздел реестра, в Delphi1 доступен только один - HKEY_CLASSES_ROOT, в в Delphi3 - все. SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1\subkey2\ ...). Если такой раздел уже существует, то он открывается (в любом случае при успешном вызове Result содержит Handle на раздел). Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка.

RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Открыть подраздел Key\SubKey и возвращает Handle на него в переменной Result. Если раздела с таким именем нет, то он не создается. Возврат - код ошибки или ERROR_SUCCESS, если успешно.

RegCloseKey(Key: HKey): Longint;

Закрывает раздел, на который ссылается Key. Возврат - код ошибки или ERROR_SUCCESS, если успешно.

RegDeleteKey(Key: HKey; SubKey: PChar): Longint;

Удалить подраздел Key\SubKey. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

RegEnumKey(Key: HKey; index: Longint; Buffer: PChar;cb: Longint): Longint;

Получить имена всех подразделов раздела Key, где Key - Handle на открытый или созданный раздел (см. RegCreateKey и RegOpenKey), Buffer - указатель на буфер, cb - размер буфера, index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой (см. пример).

RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;

Возвращает текстовую строку, связанную с ключом Key\SubKey.Value - буфер для строки; cb- размер, на входе - размер буфера, на выходе - длина возвращаемой строки. Возврат - код ошибки.

RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;

Задать новое значение ключу Key\SubKey, ValType - тип задаваемой переменной, Value - буфер для переменной, cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Примеры :

Code:

{ Создаем список всех подразделов указанного раздела }

procedure TForm1.Button1Click(Sender: TObject);

var

MyKey : HKey; { Handle для работы с разделом }

Buffer : array[0..1000] of char; { Буфер }

Err, { Код ошибки }

index : longint; { Индекс подраздела }

begin

Err:=RegOpenKey(HKEY_CLASSES_ROOT,'DelphiUnit',MyKey); { Открыли раздел }

if Err<> ERROR_SUCCESS then

begin

MessageDlg('Нет такого раздела !!',mtError,[mbOk],0);

exit;

end;

index:=0;

{Определили имя первого подраздела }

Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer));

while err=ERROR_SUCCESS do { Цикл, пока есть подразделы }

begin

memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }

inc(index); { Увеличим номер подраздела }

Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer)); { Запрос }

end;

RegCloseKey(MyKey); { Закрыли подраздел }

end;

Источник: https://dmitry9.nm.ru/info/

Автор: i-s-v

Code:

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;

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;

RegCloseKey(hTemp);

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

FreeMem(buf);

RegCloseKey(hTemp);

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.

Как уведомить все приложения, что реестр был изменён?

2022-02-17T20:45:22+07:00

Для этого можно послать в систему широковещательное сообщение WM_WININICHANGE, указав в нём, что изменения касаются реестра. Большинство приложений, работа которых связана с реестром, должны реагировать на сообщение WM_WININICHANGE.

Пример:

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

SendMessage(HWND_BROADCAST,WM_WININICHANGE,0,LongInt(PChar('RegistrySection')));

end;

Как читать REG_MULTI_SZ значение?

2022-02-17T21:05:24+07:00

Code:

uses

Registry;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;

Strings: TStrings);

var

valueType: DWORD;

valueLen: DWORD;

p, buffer: PChar;

key: HKEY;

begin

// Clear TStrings

Strings.Clear;

// open the specified key

if RegOpenKeyEx(CurrentKey,

PChar(Subkey),

0, KEY_READ, key) = ERROR_SUCCESS then

begin

// retrieve the type and data for a specified value name

SetLastError(RegQueryValueEx(key,

PChar(ValueName),

nil,

@valueType,

nil,

@valueLen));

if GetLastError = ERROR_SUCCESS then

if valueType = REG_MULTI_SZ then

begin

GetMem(buffer, valueLen);

try

// receive the value's data (in an array).

RegQueryValueEx(key,

PChar(ValueName),

nil,

PBYTE(buffer),

@valueLen);

// Add values to stringlist

p := buffer;

while p^ <> #0 do

begin

Strings.Add(p);

Inc(p, lstrlen(p) + 1)

end

finally

FreeMem(buffer)

end

else

raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...')

else

raise ERegistryException.Create('Cannot Read MULTI_SZ Value/'+

'Kann den MULTI_SZ Wert nicht lesen...');

end;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);

begin

ReadREG_MULTI_SZ(HKEY_CURRENT_USER, 'Software\XYZ', 'Test44', Memo1.Lines);

end;

Code:

{******************************************}

{2. by Ralph Friedman }

{

Question:

I want to read out the binary-value "problems" of the path

HKEY_DYN_DATA\Config Manager\Enum\[add the key of a hardware component] to

detect if a hardware component is troubled and not working right.

But I cannot handle the ReadBinaryData-Method of TRegistry correct.

Everytime I use it, it always returns "4" as content of the buffer.

How do I detect if the content of the binary-key "problems" is

not "00 00 00 00" but something else like "16 00 00 00" or such?

}

{Answer: Here's an example of ReadBinaryData }

procedure TFrmReadBinary.Button1Click(Sender: TObject);

const

CKeyName: string = 'System\Setup';

CValName: string = 'NetcardDlls';

var

keyGood: boolean;

p: integer;

regKey: TRegistry;

tmpStr: string;

vSize: integer;

begin

regKey := TRegistry.Create;

try

regKey.RootKey := HKEY_LOCAL_MACHINE;

keyGood := regKey.OpenKey(CKeyName, False);

if (keyGood) then

begin

vSize := regKey.GetDataSize(CValName);

if (vSize > 0) then

begin

SetLength(tmpStr, vSize);

regKey.ReadBinaryData(CValName, tmpstr[1], vSize);

repeat

p := Pos(#0, tmpStr);

if p <> 0 then

begin

Delete(tmpStr, p, 1);

Insert(#13#10, tmpStr, p);

end;

until p = 0;

(*StringReplace(tmpStr, #0, #13#10, [rfReplaceAll]); *)

ListBox1.Items.Text := tmpStr;

end;

finally

regKey.Free;

end;

Code:

{******************************************}

{3. by Michael Winter }

procedure RaiseWin32Error(Code: Cardinal);

var

Error: EWin32Error;

begin

Error := EWin32Error.CreateResFmt(@SWin32Error, [Code,

SysErrorMessage(Code)]);

Error.ErrorCode := Code;

raise Error;

end;

// Write REG_MULTI_SZ

procedure TForm1.Button1Click(Sender: TObject);

const

Str = 'multiple'#0'strings'#0'in one'#0'registry'#0'value'#0;

var

Reg: TRegistry;

Res: Integer;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CURRENT_USER;

if not Reg.OpenKey('\Software\Test\RegMultiSzTest', true) then

raise Exception.Create('Can''t open key');

Res := RegSetValueEx(

Reg.CurrentKey, // handle of key to set value for

'TestValue', // address of value to set

0, // reserved

REG_MULTI_SZ, // flag for value type

PChar(Str), // address of value data

Length(Str) + 1); // size of value data

if Res <> ERROR_SUCCESS then

RaiseWin32Error(Res);

finally

Reg.Free;

end;

// Read REG_MULTI_SZ

procedure TForm1.Button2Click(Sender: TObject);

var

Reg: TRegistry;

DataType: Cardinal;

DataSize: Cardinal;

Res: Integer;

Str: String;

i: Integer;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CURRENT_USER;

if not Reg.OpenKeyReadOnly('\Software\Test\RegMultiSzTest') then

raise Exception.Create('Can''t open key');

DataSize := 0;

Res := RegQueryValueEx(

Reg.CurrentKey, // handle of key to query

'TestValue', // address of name of value to query

nil, // reserved

@DataType, // address of buffer for value type

nil, // address of data buffer

@DataSize); // address of data buffer size

if Res <> ERROR_SUCCESS then

RaiseWin32Error(Res);

if DataType <> REG_MULTI_SZ then

raise Exception.Create('Wrong data type');

SetLength(Str, DataSize - 1);

if DataSize > 1 then begin

Res := RegQueryValueEx(

Reg.CurrentKey, // handle of key to query

'TestValue', // address of name of value to query

nil, // reserved

@DataType, // address of buffer for value type

PByte(Str), // address of data buffer

@DataSize); // address of data buffer size

if Res <> ERROR_SUCCESS then

RaiseWin32Error(Res);

end;

for i := Length(Str) downto 1 do

if Str[i] = #0 then

Str[i] := #13;

ShowMessage(Str);

finally

Reg.Free;

end;

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

TExRegistry = class(TRegistry)

public

function ReadStrings(const ValueName: String): String;

end;

function TExRegistry.ReadStrings(const ValueName: String): String;

var

ValueType : DWORD;

ValueLen : DWORD;

P, Buffer : PChar;

begin

Result := '';

SetLastError(RegQueryValueEx(CurrentKey, PChar (ValueName), nil,

@ValueType, nil, @ValueLen));

if GetLastError = ERROR_SUCCESS then

begin

if ValueType = REG_MULTI_SZ then

begin

GetMem(Buffer, ValueLen);

try

RegQueryValueEx(CurrentKey, PChar(ValueName), nil, nil, PBYTE(Buffer), @ValueLen);

P := Buffer;

while P^ <> #0 do

begin

if Result <> '' then

Result := Result + sLineBreak;

Result := Result + P;

Inc(P, lstrlen(P) + 1);

end;

finally

FreeMem (Buffer);

end;

end

else

raise ERegistryException.Create ('String list expected');

end

else

raise Exception.Create ('Unable read MULTI_SZ value');

end;

Автор: Александр (Rouse_) Багель

Облегчённый вариант класса TRegistry

2022-02-17T20:53:20+07:00

Code:

unit MiniReg;

{

lightweight replacement for TRegistry. Does not use Classes or SysUtils. Intended

for space-limited applets where only the commonly used functions are necessary.

Returns True if Successful, else False.

Written by Ben Hochstrasser (bhoc@surfeu.ch).

This code is GPL.

}

// Function Examples:

procedure TForm1.Button1Click(Sender: TObject);

var

ba1, ba2: array of byte;

n: integer;

s: String;

d: Cardinal;

begin

setlength(ba1, 10);

for n := 0 to 9 do ba1[n] := byte(n);

RegSetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', 'TestMe');

RegSetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString',

'%SystemRoot%\Test');

RegSetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString',

'String1'#0'String2'#0'String3');

RegSetDword(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', 7);

RegSetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', ba1);

RegGetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', s);

RegGetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s);

RegGetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString', s);

RegGetDWORD(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', d);

RegGetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', s);

SetLength(ba2, Length(s));

for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);

Button1.Caption := IntToStr(Length(ba2));

if RegKeyExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo') then

if RegValueExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary') then

MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);

RegDelValue(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString');

RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar');

RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo');

RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test');

RegDelKey(HKEY_CURRENT_USER, 'Software\My Company');

if RegEnumKeys(HKEY_CURRENT_USER, 'Software\My Company', s) then

ListBox1.Text := s;

if RegEnumValues(HKEY_CURRENT_USER, 'Software\My Company', s) then

ListBox1.Text := s;

if RegConnect('\\server1', HKEY_LOCAL_MACHINE, RemoteKey) then

begin

RegGetString(RemoteKey, 'Software\My Company\Test\foo\bar\TestString', s);

RegDisconnect(RemoteKey);

end;

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;

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;

RegCloseKey(hTemp);

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

FreeMem(buf);

RegCloseKey(hTemp);

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.

Проблемы использования TRegistry под NT/2000/XP

2022-02-17T20:50:40+07:00

При использованиии компонента TRegistry под NT пользователь с права доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти?

Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра.

Автор: p0s0l

Вообще-то можно ничего не переписывать:

Reg := TRegistry.Create(KEY_READ);

т.е. у TRegistry есть два конструктора - один без параметра, тогда доступ будет

KEY_ALL_ACCESS, а другой конструктор - с параметром...

Примечание к примечанию Vit

Дополнительные конструкторы появились только в последних версиях Дельфи

В справке про TRegistry указано неверно, что ключ открывается всегда с параметром KEY_ALL_ACCESS. В случае если открывать через TRegistry.OpenKeyReadOnly он откроется с параметром KEY_READ

Что такое реестр?

2022-02-10T20:52:45+07:00

Реестр - это системная база данных. Получить доступ к ней можно написав в командной строке ("ПУСК > "Выполнить") слово "RegEdit" - при этом запуститься программа для редактирования реестра. Окно этой программы поделено на две части. В левой (более узкой панели) показана древовидная структура ключей. Ключ - это раздел, отвечающий за какие-либо установки. Сами установки называются параметрами, находящимися в правой панели. Каждый параметр имеет своё имя, значение и тип. Параметры бывают строкового типа, двоичного и типа DWORD. Их очень много, но их назначение зависит от того, в каком ключе находится той или иной параметр. Ключи делятся между шестью основными разделами:

HKEY_CLASSES_ROOT - Содержит информацию об OLE, операциях перетаскивания (drag-and-drop - с англ. перетащить-и-отпустить) и ярлыках. В данном разделе можно так же указать программы, запускаемые при активизации файлов определённого типа. Данный раздел является псевдонимом для ветви HKEY_LOCAL_MACHINE\Software\Classes

HKEY_CURRENT_USER - Содержит индивидуальные установки для каждого пользователя, зарегистрированного в системе. Данный раздел является псевдонимом для ветви HKEY_USERS

HKEY_LOCAL_MACHINE - Содержит аппаратные и программные установки, необходимые для функционирования оборудования и программ. Данный раздел так же хранит конфигурацию Windows.

HKEY_USERS - Содержит установки пользователей и соответствующие конфигурационные данные, такие как цвет окна, расположение элементов на рабочем столе, обои, заставки.

HKEY_CURRENT_CONFIG - Содержит информацию о текущем аппаратном профиле. Если вы не используете аппаратные профили, данный раздел содержит установки Windows по умолчанию.

HKEY_DYN_DATA - В отличие от других разделов, которые хранят статистические данные (неизменяющиеся во время сеанса), данный раздел содержит указатели на динамические данные (постоянно изменяющиеся во время работы компьютера). Windows использует данный раздел для отслеживания профилей оборудования plug-and-play, статистики по производительности и драйверов виртуальных устройств VxD.

Все данные системного реестра заключаются в двух файлах, находящихся в директории Windows - это System.dat и User.dat.