Последние записи
- Рандомное слайдшоу
- Событие для произвольной области внутри TImage
- Удаление папки с файлами
- Распечатка файла
- Преобразовать массив байт в вещественное число (single)
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
30th
Ноя
Как записать в реестр мультистроковой параметр?
Posted by maloy under Delphi, Архив
tetraciclinum+
Суть проблемы в том, что необходимо добавить в реестр програмным способом занчение реестра в разделе HKEY_LOCAL_MACHINE\SYSTEM\ControlSe t001\Services\lanmanserver\Shares значение мультистрокового параметра для открытия шары…
Гриха
unit Reg;
{$R-,T-,H+,X+}
interface
uses Registry, Classes, Windows, Consts, SysUtils;
type
TReg = class(TRegistry)
public
procedure ReadStringList(const name: string; list: TStringList);
procedure WriteStringList(const name: string; list: TStringList);
end;
implementation
//*** TReg *********************************** **********************************
//------------------------------------------------------------------------------
// Запись TStringList ввиде значения типа REG_MULTI_SZ в реестр
//------------------------------------------------------------------------------
procedure TReg.WriteStringList(const name: string; list: TStringList);
var
Buffer: Pointer;
BufSize: DWORD;
i, j, k: Integer;
s: string;
p: PChar;
begin
{подготовим буфер к записи}
BufSize := 0;
for i := 0 to list.Count - 1 do
inc(BufSize, Length(list) + 1);
inc(BufSize);
GetMem(Buffer, BufSize);
k := 0;
p := Buffer;
for i := 0 to list.Count - 1 do
begin
s := list;
for j := 0 to Length(s) - 1 do
begin
p[k] := s[j + 1];
inc(k);
end;
p[k] := chr(0);
inc(k);
end;
p[k] := chr(0);
{запись в реестр}
if RegSetValueEx(CurrentKey, PChar(name), 0, REG_MULTI_SZ, Buffer,
BufSize) <> ERROR_SUCCESS then
raise ERegistryException.CreateResFmt(@SR egSetDataFailed, [name]);
end;
//------------------------------------------------------------------------------
// Чтение TStringList ввиде значения типа REG_MULTI_SZ из реестра
//------------------------------------------------------------------------------
procedure TReg.ReadStringList(const name: string; list: TStringList);
var
BufSize,
DataType: DWORD;
Len, i: Integer;
Buffer: PChar;
s: string;
begin
if list = nil then
Exit;
{чтение из реестра}
Len := GetDataSize(Name);
if Len < 1 then
Exit;
Buffer := AllocMem(Len);
if Buffer = nil then
Exit;
try
DataType := REG_NONE;
BufSize := Len;
if RegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer),
@BufSize) <> ERROR_SUCCESS then
raise ERegistryException.CreateResFmt(@SR egGetDataFailed, [name]);
if DataType <> REG_MULTI_SZ then
raise ERegistryException.CreateResFmt(@SI nvalidRegType, [name]);
{запись в TStringList}
list.Clear;
s := '';
for i := 0 to BufSize - 2 do
begin // BufSize-2 т.к. последние два нулевых символа
if Buffer = chr(0) then
begin
list.Add(s);
s := '';
end
else
s := s + Buffer;
end;
finally
FreeMem(Buffer);
end;
end;
end.
и еще…
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;
тема на форуме от 2006 года
Случайные статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)