Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ (Windows NT, Windows 2000)

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

Один программист другому:
- Представляешь, в Windows-2000 более четырех тысяч известных ошибок, а в моей программе только одна!
- Вот здорово! А какая?
- Не запускается.


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.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay