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

Материал из DRKB

Дополненный 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.


Author: Кондратюк Виталий
Source: http://delphiworld.narod.ru/
ID: 02282