Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

procedureReadStringList( constname : string; list : TStringList);

procedureWriteStringList( constname : string; list : TStringList);

end;

implementation

//*** TReg *********************************************************************

//------------------------------------------------------------------------------

// Запись TStringList ввиде значения типа REG_MULTI_SZ в реестр

//------------------------------------------------------------------------------

procedureTReg.WriteStringList( constname : string; list : TStringList);

var

Buffer : Pointer;

BufSize : DWORD;

i, j, k : Integer;

s : string;

p : PChar;

begin

{подготовим буфер к записи}

BufSize := 0;

fori:=0 tolist.Count-1 do inc(BufSize, Length(list[i])+1);

inc(BufSize);

GetMem(Buffer, BufSize);

k := 0;

p := Buffer;

fori:=0 tolist.Count-1 do begin

s := list[i];

forj:=0 toLength(s)-1 do begin

p[k] := s[j+1];

inc(k);

end;

p[k] := chr(0);

inc(k);

end;

p[k] := chr(0);

{запись в реестр}

ifRegSetValueEx(CurrentKey, PChar(name), 0, REG_MULTI_SZ, Buffer, BufSize) <> ERROR_SUCCESS then raiseERegistryException.CreateResFmt(@SRegSetDataFailed, [name]);

end;

//------------------------------------------------------------------------------

// Чтение TStringList ввиде значения типа REG_MULTI_SZ из реестра

//------------------------------------------------------------------------------

procedureTReg.ReadStringList( constname : string; list : TStringList);

var

BufSize,DataType: DWORD;

Len, i: Integer;

Buffer: PChar;

s: string;

begin

iflist = nil thenExit;

{чтение из реестра}

Len := GetDataSize(Name);

ifLen < 1 thenExit;

Buffer := AllocMem(Len);

ifBuffer = nil thenExit;

try

DataType := REG_NONE;

BufSize := Len;

ifRegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then raiseERegistryException.CreateResFmt(@SRegGetDataFailed, [name]);

ifDataType <> REG_MULTI_SZ then raiseERegistryException.CreateResFmt(@SInvalidRegType, [name]);

{запись в TStringList}

list.Clear;s := '';

fori:=0 toBufSize-2 do begin

// BufSize-2 т.к. последние два нулевых символа

ifBuffer[i] = chr(0) then begin

list.Add(s);

s := '';

end else s := s + Buffer[i];

end;

finally

FreeMem(Buffer);

end;

end;

end.

Nomadicсоветует:

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

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

usesRegistry;

procedureTForm1.FormCreate(Sender: TObject);

var

I: integer;

TempList: TStringList;

begin

TempList := TStringList.Create;

try

with TRegistry.Create do try

RootKey := HKEY_CLASSES_ROOT;

ifOpenKey('CLSID', False) thenGetKeyNames(TempList);

CloseKey;

forI := 1 toTempList.Count - 1 do

ifKeyExists('CLSID\' + TempList[I] + '\Borland DataBroker') then begin

ifOpenKey('CLSID\' + TempList[I] + '\ProgID', False) then begin

Listbox1.Items.Add(ReadString(''));

CloseKey;

end;

end;

finally

Free;

end;

finally

TempList.Free;

end;

end;

Это происходит при использовании сервера автоматизации Delphi, или когда сервер автоматизации (например, word.basic) не запущен.

procedureTForm1.Button1Click(Sender: TObject);

varV: OleVariant;

begin

V := GetActiveOleObject('Word.Basic');

V.FileNew;

V.Insert('тест');

end;

GetActiveOleObject определен в ComObj.pas. Он преобразует имя класса в guid и передает его при вызове Windows api функции GetActiveObject.

functionGetActiveOleObject( constClassName: string): IDispatch;

var

ClassID: TCLSID;

Unknown: IUnknown;

begin

ClassID := ProgIDToClassID(ClassName);

OleCheck(GetActiveObject(ClassID, nil, Unknown));

OleCheck(Unknown.QueryInterface(IDispatch, Result));

end;

GetActiveOleObject использует интерфейс с именем IRunningObjectTable. Мы не регистрируем это автоматически в таблице, поэтому, чтобы воспользоваться его функциональным назначением, вы должны получить этот интерфейс и использовать его методы для регистрации.

Обычно это происходит при неправильном порядке изменения имени ActiveForm (смотри README.TXT). Если сначала изменяется имя CoClass, а затем делается обновление (refresh), возникает AV. При дальнейшей попытке изменить имя в Инспекторе Объектов вы получите ошибку «TActiveFormX declaration missing or incorrect» (определение TActiveFormX отсутствует или неправильно). Для решения проблемы откройте .DFM-файл и измените строчку:

objectActiveFormX: TActiveFormX

на

objectMyForm: TMyForm

Почему ACTIVEX и активные формы иногда не отображаются в INTERNET EXPLORER? Все, что появляется, это .HTM-страница с пустым квадратом и красным «X» в нем.

Вероятно, при создании ActiveForm вы выбрали опцию лицензирования и не поместили .LIC-файл в ваш .OCX-файл. Обычно с ActiveForms/ActiveXs лицензирование не используется, поскольку активные элементы в основном используются для повышения привлекательности Интернет-сервера и «распространяются» свободно. Чтобы выключить лицензию времени разработки (Design-Time Licensing), найдите секцию initialization в вашем ActiveForm XXXImpl-файле и замените предпоследний параметр вызова TActiveXControlFactory.Create на пустую строку:

initialization

TActiveXControlFactory.Create( ComServer, TAnimateX, TAnimate, Class_AnimateX, 1, '', 0);

end.

Так когда мне нужно будет использовать Design-Time Licensing?

Ваш элемент управления должен использовать design-time-лицензию только в случае, если вы продаете ActiveX или ActiveForm другим разработчикам, которые встраивают их в продаваемые ими приложения для конечных пользователей. То есть, элемент управления работает в среде разработки (например, Delphi, C++Builder, VB и пр.) только когда LIC-файл присутствует, но это не работает когда .LIC-файл отсутствует во время выполнения приложения без среды разработки (например, в приложении для конечного пользователя).