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

Previous  Top  Next

    
 

 

Code:

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.

 

 

Автор: Кондратюк Виталий

©Drkb::02282

http://delphiworld.narod.ru/

DelphiWorld 6.0