Один программист другому:
- Представляешь, в Windows-2000 более четырех тысяч известных ошибок, а в моей программе только одна!
- Вот здорово! А какая?
- Не запускается.
unit Reg;
{$R-,T-,H+,X+}interfaceuses Registry, Classes, Windows, Consts, SysUtils;
type
TReg = class(TRegistry)
publicprocedure 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[i]) + 1);
inc(BufSize);
GetMem(Buffer, BufSize);
k := 0;
p := Buffer;
for i := 0 to list.Count - 1 dobegin
s := list[i];
for j := 0 to Length(s) - 1 dobegin
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 thenraise ERegistryException.CreateResFmt(@SRegSetDataFailed, [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;
beginif list = nilthen
Exit;
{чтение из реестра}
Len := GetDataSize(Name);
if Len < 1 then
Exit;
Buffer := AllocMem(Len);
if Buffer = nilthen
Exit;
try
DataType := REG_NONE;
BufSize := Len;
if RegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer),
@BufSize) <> ERROR_SUCCESS thenraise ERegistryException.CreateResFmt(@SRegGetDataFailed, [name]);
if DataType <> REG_MULTI_SZ thenraise ERegistryException.CreateResFmt(@SInvalidRegType, [name]);
{запись в TStringList}
list.Clear;
s := '';
for i := 0 to BufSize - 2 dobegin// BufSize-2 т.к. последние два нулевых символаif Buffer[i] = chr(0) thenbegin
list.Add(s);
s := '';
endelse
s := s + Buffer[i];
end;
finally
FreeMem(Buffer);
end;
end;
end.
Статья Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ (Windows NT, Windows 2000) раздела ОС и Железо Реестр может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.