Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

//*** 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.

Как я могу определить доступные сервера приложений на этой машине через Registry?

Nomadic советует:

Прочитайте ключ под HKEY_CLASSES_ROOT\CLSID\*, просматривая его насчёт ключей, которые имеют подключ "Borland DataBroker". Эти вхождения и являются серверами приложений.

Ниже пример, который загружает имена доступных серверов приложений в Listbox:

uses Registry;

procedure TForm1.FormCreate(Sender: TObject);

var

 I: integer;

 TempList: TStringList;

begin

 TempList := TStringList.Create;

 try

with TRegistry.Create do try

RootKey := HKEY_CLASSES_ROOT;