Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ

Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ

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[i]) + 1);
 inc(BufSize);
 GetMem(Buffer, BufSize);
 k := 0;
 p := Buffer;
 for i := 0 to list.Count - 1 do
 begin
  s := list[i];
  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(@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;
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(@SRegGetDataFailed, [name]);
  if DataType <> REG_MULTI_SZ then
  raise ERegistryException.CreateResFmt(@SInvalidRegType, [name]);
  {запись в TStringList}
  list.Clear;
  s := '';
  for i := 0 to BufSize - 2 do
  begin // BufSize-2 т.к. последние два нулевых символа
  if Buffer[i] = chr(0) then
  begin
  list.Add(s);
  s := '';
  end
  else
  s := s + Buffer[i];
  end;
 finally
  FreeMem(Buffer);
 end;
end;
end.
Автор: Кондратюк Виталий DelphiWorld 6.0

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...