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

Ошибка 'TACTIVEFORMX DECLARATION MISSING OR INCORRECT' (определение TACTIVEFORMX отсутствует или неправильно)

Delphi 3

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

object ActiveFormX: TActiveFormX

на

object MyForm: TMyForm

Лицензирование активных форм и ActiveX

Delphi 3

Почему 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-файл отсутствует во время выполнения приложения без среды разработки (например, в приложении для конечного пользователя).

Если вы распространяете ваш ActiveX в Интернете, то вы должны задать режим разработки для конечного пользователя (в противоположность передачи другим разработчикам), и вам в этом случае не потребуется лицензия времени разработки.

Кроме того, для показа ActiveForm необходимо установить в Internet Explorer уровень «Active content security» (безопасность активного содержимого) в medium (средняя). Чтобы это сделать, войдите в Панель Управления и щелкните на иконке Internet. Перейдите на страницу безопасности и нажмите на кнопку «Safety Level» (уровень безопасности). Убедитесь в том, что уровень находится на отметке «средний».

Примечание: Данный совет отностится только если вы разрабатываете собственные элементы управления. Потенциально хакерские элементы ActiveX могут нанести вред компьютеру!

Добавление IPERSISTPROPERTYBAG к активным элементам управления

Delphi 3

Данный совет рассказывает о том, как можно добавить интерфейс IPersistPropertyBag к элементу управления ActiveX. Существует возможность установки свойств элемента управления ActiveX с помощью HTML тэгов PARAM. Добавление интерфейса IPersistPropertyBag в элемент управления ActiveX также позволяет изменять его свойства с помощью инструментов типа ActiveX Control Pad.

Добавление интерфейса IPersistPropertyBag к элементу управления ActiveX очень простая процедура. Все, что необходимо сделать, это добавить интерфейс к определению класса объекта и реализовать три метода интерфейса. Приведенный здесь пример покажет вам эту технологию шаг за шагом, где наш элемент управления ActiveX будет базироваться на TButton. Для упрощения примера мы покажем реализацию функциональности для свойства "Caption" (заголовок). Для реализации полной функциональности можно экстраполировать данный пример на все доступные свойства элемента управления.

Начнем с использования ActiveX Control Wizard и создадим элемент управления ActiveX на основе TButton.

Активизируйте пункт меню File|New и выберите в диалоге New Item (новый элемент) закладку ActiveX. Затем в списке выберите элемент "ActiveX Control". В появившемся диалоговом окне выберите TButton для VCL Class Name. Все остальные настройки можете не трогать и оставить как есть. После нажатия на кнопку OK Delphi сгенерирует базовый код для вашего элемента управления.

Следующим шагом будет добавление интерфейса IPersistPropertyBag к определению класса. Измените первую строку определения, декларирующую тип…

type TButtonX = class(TActiveXControl, IButtonX)

на…

type TButtonX = class(TActiveXControl, IButtonX, IPersistPropertyBag)

Теперь интерфейс IPersistPropertyBag добавлен к объявлению типа. Затем объявите необходимые методы, добавляя следующие строки в секцию protected:

function IPersistPropertyBag.InitNew = PersistPropBagInitNew;

function IPersistPropertyBag.Load = PersistPropBagLoad;

function IPersistPropertyBag.Save = PersistPropBagSave;

function PersistPropBagInitNew: HResult; stdcall;

function PersistPropBagLoad(const pPropBag: IPropertyBag; const pErrorLog: IErrorLog): HResult; stdcall;

function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL; fSaveAllProperties: BOOL): HResult;

stdcall;

Затем, конечно, реализуйте эти функции…

// – реализация PersistPropBagInitNew

function TButtonX.PersistPropBagInitNew: HResult;

begin

Result := S_OK;

end;

// -- реализация PersistPropBagLoad

function TButtonX.PersistPropBagLoad(const pPropBag: IPropertyBag; const pErrorLog: IErrorLog): HResult; stdcall;

var v: OleVariant;

begin

if pPropBag.Read('Caption', v, pErrorLog) = S_OK then FDelphiControl.Caption := v;

Result := S_OK;

end;

// -- реализация PersistPropBagSave

function TButtonX.PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL; fSaveAllProperties: BOOL) : HResult; stdcall;

var v: OleVariant;

begin

v:= FDelphiControl.Caption;

pPropBag.Write('Caption', v);

Result := S_OK;

end;

Добавлением этого кода завершается создание элемента управления. Продолжаем дальше: соберите (build) элемент управления ActiveX и разместите его в сети. Сделайте это с помощью мастера Web Delpoy Wizard. Просто сделайте необходимые настройки на странице Project|Web Delpoyment Options и разместите ActiveX через Project| Web Deploy.

Мастер Web Deployment Wizard создаст HTML-страницу, содержащую тэг OBJECT, которая должна выглядеть приблизительно так:

<OBJECT classid="clsid:324EB783-20A4-11D1-AB11-0020AF3E6306" codebase="ActiveX/ButtonXControl.ocx" width=100 height=50 align=center hspace=0 vspace=0> </OBJECT>

Эта страница должна заработать без проблем. Тем не менее, теперь у вас имеется возможность задания заголовка для кнопок через HTML простым добавлением тэга PARAM. Вам измененный тэг OBJECT должен выглядеть таким образом:

<OBJECT classid="clsid:324EB783-20A4-11D1-AB11-0020AF3E6306" codebase="ActiveX/ButtonXControl.ocx" width=100 height=50 align=center hspace=0 vspace=0> <Param Name="Caption» Value="Привет"> </OBJECT>

Заголовок кнопки теперь будет говорить вам «Привет». В нашем примере заголовок будет доступен только с помощью данного метода. Для того, чтобы рулить другими свойствами, следуйте нашему примеру и изменяйте имя свойства, которое вы хотите использовать.

Использование ChartFX

Delphi 1

Это код, который я использую для установки chartfx.

chart1.Opendata[cod_values]:=makelong(no_of_series, no_of_classes);

{установка последовательных значений}

chart1.closedata[cod_values]:=0;

unit TstChart;

interface

uses= WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Menus, Dialogs, StdCtrls, Buttons, ExtCtrls, Tabs, ChartFX, {Похоже, действительно необходимо включить этот модульв список, чтобы иметь доступ к константам, например к COD_VALUES} VBXCtrl, Chart2fx;

type TF_Chart = class(TForm)

SpeedPanel: TPanel;

ExitBtn: TSpeedButton;

NB: TNotebook;

TB: TTabSet;

Chart1: TChartFX;

Chart2: TChartFX;

procedure ExitItemClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure TBClick(Sender: TObject);

procedure FormResize(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Procedure Build1(Ch : TChartFX);

Procedure Build2(Ch : TChartFX);

end;

var F_Chart: TF_Chart;

implementation

{$R *.DFM}

procedure TF_Chart.ExitItemClick(Sender: TObject);

begin

Close;

end;

procedure TF_Chart.FormCreate(Sender: TObject);

begin

TB.Tabs := NB.Pages;

NB.PageIndex := 0;

Build1(Chart2);

Build2(Chart2); {добавляем значения для Chart2: length... и т.д.}

end;

procedure TF_Chart.TBClick(Sender: TObject);

begin

NB.PageIndex := TB.TabIndex;

end;

Procedure TF_Chart.Build1(Ch : TChartFX);

begin

{Эта процедура изменяет свойства, которые могут устанавливаться во время разработки или временя выполнения. В коментариях подробно указано чем занимается метод Design}

with Ch do begin

Adm[CSA_GAP] := 25.0;

{Design: Используйте свойство AdmDlg для изменения координаты Y}

pType := BAR or CT_LEGEND;

{Design: Изменяем свойство ChartType с 1 - lineна 2 - bar.}

DecimalsNum[CD_YLEG] := 0;

{Design: Изменяем свойство Decimals с 2 до 0}

Stacked := CHART_STACKED;

{Design: Изменяем свойство Stacked с 0 - None на 1 - Normal}

RightGap := 20;

{Design: Тоже}

OpenData[COD_COLORS] := 2;

Color[0] := clBlack;

Color[1] := clYellow;

CloseData[COD_COLORS] := 0;

{Фу!!}

{Design: Для изменения цветов 2 серий:1) Убедитесь, что ThisSerie установлен в 0. ИзменитеThisColor на clBlack.2) Установите ThisSerie в 1. Измените ThisColor наclYellow.}

Title[CHART_TOPTIT] := 'Статьи и заголовки';

Title[CHART_LEFTTIT] := 'CCM';

Title[CHART_BOTTOMTIT] := 'Карты';

{Design: щелкните на свойстве TitleDlg и установите верхний, левый и нижний заголовки}

end;

Procedure TF_Chart.Build2(Ch : TChartFX);

{Данная процедура устанавливает свойства, которые не могут (насколько я определил это) быть установлены в режиме разработки}

const

XAbbrevs : array[0..4] of string[4] =('Acc', 'Bar', 'Mas', 'Amex', 'Din');

SeriesTitles : array[0..1] of string[8] =('Статьи', 'Заголовки');

XTitles : array[0..4] of string[20] = ('Access', 'Barclaycard', 'Mastercard', 'American Express', 'Diners');

{естественно, вы должны нормально читать из базы данных xTitles и значения}

Values : array[0..1, 0..4] of double =((50, 60, 70, 80, 90),(30, 35, 25, 37, 42));

var i, SerieNo : integer;

begin

with Ch do begin

LegendWidth := 120;

{Установка количества серий, количества значений ******************}

OpenData[COD_INIVALUES] := MAKELONG(2, 5);

CloseData[COD_INIVALUES] := 0;

{*********************************************************}

OpenData[COD_VALUES] := 2;

{если вы пропускаете приведенное выше утверждение, (в котором вы вводите номер SERIES и VALUES), и CloseData ниже, назначение значений не создает ошибки, но и не работает! Назначение значений Legend и KeyLeg работает без OpenData/CloseData}

ThisSerie := 0;

for i := 0 to 1 do SerLeg[i] := SeriesTitles[i];

for i := 0 to 4 do= begin

Legend[i] := XTitles[i];

KeyLeg[i] := XAbbrevs[i];

end;

SerieNo := 0;

for SerieNo := 0 to 1 do begin

ThisSerie := SerieNo;

for i := 0 to 4 do Value[i] := Values[SerieNo, i];

end;

CloseData[COD_VALUES] := 0;

end;

procedure TF_Chart.FormResize(Sender: TObject);

var w, h : longint;

begin

w := NB.Width;

H := NB.Height;

{при необходимости увеличиваем/уменьшаем размер диаграммы}

Chart1.Width := W – 18;

Chart1.Height := H – 12;

Chart2.Width := W – 18;

Chart2.Height := H – 12;

{перемещаем кнопку выхода в правый угол}

ExitBtn.Left := SpeedPanel.Width – 32;

end;

end.

CHARTFX – минимум максимум

Delphi 2

Так можно сделать с ChartFX в Delphi 2…. Я думаю то же самое будет и в D1…

cfxStockTrends.Adm[CSA_MIN] := X; //устанавливаем минимум по оси Y

cfxStockTrends.Adm[CSA_MAX] := Y; //Устанавливаем максимум по оси Y

Пример CHARTFX

Delphi 1

Документация, поставляемая с Delphi, слишком запутанна и тяжела, особенно если вы не пользователь VBX…

Следующий пример устанавливает некоторые значения и пр. для ChartFX:

{Код получает данные из базы данных и рисует их}

begin

MyTable.active := True; {открываем базу данных}

MyTable.first;

MyChart.title[CHART_BOTTOMTIT] := 'Заголовок по оси X';

MyChart.title[CHART_LEFTTIT] := 'Заголовок по оси Y';

MyChart.OpenData[COD_XVALUES] := MakeLong(numOfSeries,numofPoints);

MyChart.OpenData[COD_VALUES] := MakeLong(numOfSeries, NumofPoints);

MyChart.ThisSerie := SeriesNum; {начинаем с 0}

While MyTable.EOF <> True do begin

MyChart.value[i] := MyTable.FieldByName('SOMEFIELD').AsFloat;

MyChart.Xvalue[i] := MyTable.FieldByName('SOMEOTHERFIELD').AsFloat;

MyTable.next;

i:=i+1; {естественно, вам необходимо определить и инициализировать 'i'}

end;

MyChart.CloseData[COD_Values] := 0;

MyChart.CloseData[COD_XValues] := 0;

MyTable.active := False; {закрываем базу данных}

end;

{Обратите внимание на то, что данный код отностится к диаграмме типа xy scatter. Если вы хотите сменить тип диаграммы ChartFX, вам не нужно устанавливать значения для COD_XVALUES}

Управление свойством Font через сервер автоматизации

Данный документ предназначен главным образом тем программистам, кто использует OLE/COM и хочет встроить объект Font (типа Delphi-го TFont) в свой сервер автоматизации. Интерфейс IFontDisp для COM будет иметь ту же функциональность, что и Delphi-ий TFont. Например, если у вас имеется клиент автоматизации, содержащий объект со свойством Font, и в сервере автоматизации для изменения атрибутов текста вы хотите иметь те же методы (наприр, имя шрифта, жирное или наклонное начертание). Для хранения и управления шрифтом сервер автоматизации может применять реализацию интерфейса IFontDisp.

Приведенный ниже демонстрационный проект содержит элементы и шаги, необходимые для реализации интерфейса IFontDisp в сервере автоматизации COM, и осуществление взаимодействия между клиентом автоматизации COM и интерфейсом. Ниже вы найдете полный листинг исходных модулей, и некоторые комментарии относительно проекта.

Демонстрационный проект содержит следующие модули:

Project1_TLB: Паскалевская обертка для библиотеки типов, содержащей определение интерфейса.

Unit1: Реализация интерфейса: код, содержащий описание свойств интерфейса и реализующий его методы.

Unit2: Главная форма сервера автоматизации. Данный модуль не является обязательным, но он в ходе тестирования обеспечивает обратную связь, так что мы можем видеть как отрабатываются вызовы наших методов.

FontCli: Клиент автоматизации, получающий ссылку на интерфейс, и использующий его методы.

Ниже приведены общие шаги для достижения цели. Вы можете сравнить каждый из этих шагов с кодом модулей, приведенных ниже.

1. Выберите пункт меню File|New|ActiveX|Automation Object и в Мастере Automation Object Wizard выберите в качестве имени класса MyFontServer. Создайте единственное свойство с именем MyFont и типом IFontDisp. Для получения дополнительной информции смотри Developer's Guide, chapter 42 (руководство разработчика, глава 42), там подробно описана работа с библиотеками типов и создание интерфейсов в редакторе библиотеки типов.

2. В предыдущем шаге при добавлении интерфейса с помошью редактора библиотеки типов вы должны были получить паскалевский модуль-обертку (в нашем примере модуль имеет имя Unit1). Unit1 будет содержать обертку реализаций методов получения и назначения свойства MyFont. На данном этапе вы обеспечите хранение значений свойства MyFont в форме FFont (TFont) и добавите код реализации, наполняющий функциональностью методы получения и установки (get/set).

Unit1 использует Unit2. Unit2 содержит форму, компонент Memo и StatusBar для отображения каждого реализованного метода, для диагностических целей.

3. Создайте Unit2, содержащий форму с компонентами TMemo и TStatusBar. Форма используется для отображения жизнедеятельности в модуле Unit1.pas. Это шаг не является строго обязательным, он помогает понять что происходит в данный момент между клиентом автоматизации и сервером.

4. Создайте клиент автоматизации. В нашем случае модуль имеет имя FontCli, содержит метку, показывающую текущий шрифт и кнопку, устанавливающую MyFont на сервере.

unit Project1_TLB;

{ Данный файл содержит паскалевские декларации, импортированные из библиотеки типов. Данный файл записывается во время каждого импорта или обновления (refresh) в редакторе библиотеки типов. Любые изменения в данном файле будут потеряны в процессе очередного обновления. }

{ Библиотека Project1 }

{ Версия 1.0 }

interface

uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

const LIBID_Project1: TGUID = '{29C7AC94-0807-11D1-B2BA-0020AFF2F575}';

const

{ GUID'ы класса компоненты }

Class_MyFontServer: TGUID = '{29C7AC96-0807-11D1-B2BA-0020AFF2F575}';

type

{ Предварительные объявления: Интерфейсы }

IMyFontServer = interface;

IMyFontServerDisp = dispinterface;

{ Предварительные объявления: CoClasse'ы }

MyFontServer = IMyFontServer;

{ Диспинтерфейс для объекта MyFontServer }

IMyFontServer = interface(IDispatch)['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']

function Get_MyFont: IFontDisp; safecall;

procedure Set_MyFont(const Value: IFontDisp); safecall;

property MyFont: IFontDisp read Get_MyFont write Set_MyFont;

end;

{ Объявление диспинтерфейса для дуального интерфейса IMyFontServer }

IMyFontServerDisp = dispinterface['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']

property MyFont: IFontDisp dispid 1;

end;

{ MyFontServerObject }

CoMyFontServer = class

class function Create: IMyFontServer;

class function CreateRemote(const MachineName: string): IMyFontServer;

end;

implementation

uses ComObj;

class function CoMyFontServer.Create: IMyFontServer;

begin

Result := CreateComObject(Class_MyFontServer) as IMyFontServer;

end;

class function CoMyFontServer.CreateRemote(const MachineName: string): IMyFontServer;

begin

Result := CreateRemoteComObject(MachineName, Class_MyFontServer) as IMyFontServer;

end;

end.

{--------------------------------------------------------------------}

unit Unit1;

interface

uses ComObj, Project1_TLB, ActiveX, Graphics;

type TMyFontServer = class(TAutoObject, IMyFontServer)

private

FFont: TFont;

public

procedure Initialize; override;

destructor Destroy; override;

function Get_MyFont: IFontDisp; safecall;

procedure Set_MyFont(const Value: IFontDisp); safecall;

end;

implementation

uses ComServ, AxCtrls, Unit2;

procedure TMyFontServer.Initialize;

begin

inherited Initialize;

FFont := TFont.Create;

end;

destructor TMyFontServer.Destroy;

begin

FFont.Free;

inherited Destroy;

end;

function TMyFontServer.Get_MyFont: IFontDisp;

begin

FFont.Assign(Form2.Label1.Font);

GetOleFont(FFont, Result);

end;

procedure TMyFontServer.Set_MyFont(const Value: IFontDisp);

begin

SetOleFont(FFont, Value);

Form2.Label1.Font.Assign(FFont);

end;

initialization

TAutoObjectFactory.Create(ComServer, TMyFontServer, Class_MyFontServer, ciMultiInstance);

end.

{--------------------------------------------------------------------}

unit Unit2;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm2 = class(TForm)

Label1: TLabel;

end;

var Form2: TForm2;

implementation

{$R *.DFM}

end.

{--------------------------------------------------------------------}

unit FontCli1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StdVCL, Project1_TLB;

type TForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

FontDialog1: TFontDialog;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

public

MyFontServer: IMyFontServer;

end;

var Form1: TForm1;

implementation

uses ActiveX, AxCtrls;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var Temp: IFontDisp;

begin

if (FontDialog1.Execute) then begin

Label1.Font.Assign(FontDialog1.Font);

GetOleFont(Label1.Font, Temp);

MyFontServer.Set_MyFont(Temp);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

MyFontServer := CoMyFontServer.Create;

end;

end.

{--------------------------------------------------------------------}

Так для чего нам Unit1, создающий реализацию интерфейса? Интерфейс Ole, такой как, например, IFontDisp, может считаться соглашением о том, что свойства и функции будут определены в заданном формате, а функции будут реализованы как определено (для получения дополнительной информации смотри Руководство Разработчика, главу 36, «An Overview of COM» (Обзор COM). Тот факт, что интерфейс определен, не означает, что он реализован. Например, чтобы заставить определенный вами интерфейс IFontDisp быть полезным, необходимо обеспечить хранение шрифта и механизм добавления и извлечения информации об атрибутах шрифта, таких, как имя шрифта, наклонное начертание, размер и пр.

Примечание:

GetOleFont и SetOleFont определены в AxCtrls.pas. IFontDisp определен в ActiveX.pas

Использование CHARTFX.VBX

Delphi 1

Хотя это можно было бы пообсуждать и здесь, но для ChartFX существует контекстно-зависимая подсказка. Киньте компонент на форму, выберите его и нажмите F1.

VBX в приложениях DELPHI: как распространять?

Delphi 1

Чтобы использовать любые элементы управления VBX с компилированным Delphi EXE-файлом, вам необходимо распространить BIVBX11.DLL (расположен в каталоге \WINDOWS\SYSTEM – Borland при установке копирует его туда).

Расскажите, как использовать ChartFX?

Nomadic советует:

Лyчше на простеньком примере.

unit Chart;

.......................

with ChartFX do begin

Visible := false;

{ Устанавливаем режим ввода значений }

{ 1 – количество серий (в нашем случае 1), 3 – количество значений }

OpenData[COD_VALUES] := MakeLong(1,3);

{ Hомер текущей серии }

ThisSerie := 0;

{ Value[i] – значение с индексом i }

{ Legend[i] – комментарий к этому значению }

Value[0] := a;

Legend[0] := 'Значение переменной A';

Value[1] := b;

Legend[1] := 'Значение переменной B';

Value[2] := c;

Legend[2] := 'Значение переменной C';

{ Закрываем режим }

CloseData[COD_VALUES] := 0;

{ Ширина поля с комментариями на экране (в пикселах) }

LegendWidth := 150;

Visible := true;

end;

end.

Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch?

Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch (и, следовательно, поддерживающих методы автоматизации)?

Nomadic советует:

Вызовите CreateRemoteComObject, передав GUID интерфейса и имя компьютера, к которому Вы пытаетесь подключиться. Если функция вернет ошибку, то наличествует проблема сервера, иначе возможная проблема относится к клиенту.

const MyGUID = '{444…111}'; //Whatever the guid is…

var

Unk: IUnknown;

Disp: IDispatch;

begin

{ Make sure this line works correctly }

Unk := CreateRemoteComObject('server1', StringToGUID(MyGUID));

{ If it does, then cast it to a IDispatch }

Disp := Unk as IDispatch;

end;

Если этот кусок кода работает, а проблема остается, то Вам требуется шаг за шагом пройти через код клиента и найти, где он дает трещину. Если не сможете этого обнаружить, Вам придется запустить сервер под отладчиком и установить связь с клиентом, чтобы Вы могли произвести отладку рядом со местом, дающем слабину.

DCOM

В чем разница между сокетами, DCOM и OLE Enterprise при использовании их в качестве транспорта?

Nomadic отвечает:

Sockets (TCP/IP):

• на клиентах и сервере требуется наличие стека TCP/IP;

• не требуется дополнительной настройки клиентов;

DCOM:

• на клиентах и серверах требуется наличие DCOM (входит в состав Windows NT 4.0, для Windows 95 доступен как опция)

• требуется настройка клиентов (DCOM Configuration Utility — DCOMCNFG.EXE);

• встроенная поддержка модели безопасности Windows NT;

• поддержка обратных вызовов (методов);

CORBA

• на клиентах и серверах требуется наличие Common Object Request Broker;

• требуется настройка клиентов;

• поддержка обратных вызовов (методов);

OLE Enterprise:

• на клиентах и серверах требуется наличие OLE Enterprise;

• требуется настройка клиентов;

• поддержка обратных вызовов (методов);

DDE

DDE – передача текста

Delphi 1

Вот я как работаю с Excel:

type

DDEClientConv1.SetLink('Excel','Sheet1');

try

DDEClientConv1.OpenLink;

DDEClientItem1.DDEItem:= 'R1C1';

DDEClientConv1.PokeData(DDEClientItem1.DDEItem, StrPCopy(P, SomeString)));

finally

DDEClientConv1.CloseLink;

end;

Как вы можете здесь видеть, свойство DDEItem определяется сервером. Если ваш сервер является приложением Delphi, то DDEItem – имя DDEServerItem. На вашем месте я бы не стал так долго заниматься отладкой DDE-программ. Воспользуйтесь синхронизацией, позволяющей понять при отладке правильность действий.

Управление Program Manager в Win95 с помощью DDE

Delphi 1

Для управления программными группами в Program Manager с помощью DDE мною был использован следующий модуль. За основу был взят код Steve Texeira (sp) из руководства Dephi Developers Guide.

Работает под Win 3.1 и '95.

unit Pm;

interface

uses SysUtils, Classes, DdeMan;

type

EProgManError = class(Exception);

TProgMan = class(TComponent)

private

FDdeClientConv: TDdeClientConv;

procedure InitDDEConversation;

function ExecMacroString(Macro: String): Boolean;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

Procedure CreateGroup(GroupName: String; ShowGroup:Boolean);

procedure DeleteGroup(GroupName: String);

procedure DeleteItem(ItemName: String);

procedure AddItem(CmdLine, ItemName: String);

end;

implementation

uses Utils;

const

{ DDE-макростроки для Program Manager }

SDDECreateGroup = '[CreateGroup(%s)]';

SDDEShowGroup = '[ShowGroup(%s, 1)]';

SDDEDeleteGroup = '[DeleteGroup(%s)]';

SDDEDeleteItem = '[DeleteItem(%s)]';

SDDEAddItem = '[AddItem(%s, "%s", %s)]';

constructor TProgMan.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

InitDDEConversation;

end;

destructor TProgMan.Destroy;

begin

if Assigned(FDDEClientConv) then FDdeClientConv.CloseLink;

inherited Destroy;

end;

function TProgMan.ExecMacroString(Macro: String): Boolean;

Begin

StringAsPchar(Macro);

Result := FDdeClientConv.ExecuteMacro(@Macro[1], False);

End;

Procedure TProgMan.InitDDEConversation;

begin

FDdeClientConv := TDdeClientConv.Create(Self);

If NOT FDdeClientConv.SetLink('PROGMAN', 'PROGMAN') then

raise EProgManError.Create('Не могу установить DDE Link');

end;

Procedure TProgMan.CreateGroup(GroupName: String; ShowGroup:Boolean);

Begin

{ Удаляем группу, если она существует }ExecMacroString(Format(SDDEDeleteGroup, [GroupName]));

If NOT ExecMacroString(Format(SDDECreateGroup, [GroupName])) then

raise EProgManError.Create('Не могу создать группу ' + GroupName);

If ShowGroup then

If not ExecMacroString(Format(SDDEShowGroup, [GroupName])) then

raise EProgManError.Create('Не могу показать группу ' + GroupName);

End;

Procedure TProgMan.DeleteGroup(GroupName: String);

Begin

if NOT ExecMacroString(Format(SDDEDeleteGroup, [GroupName])) then

raise EProgManError.Create('Не могу удалить группу ' + GroupName);

End;

Procedure TProgMan.DeleteItem(ItemName: String);

Begin

if NOT ExecMacroString(Format(SDDEDeleteGroup, [ItemName])) then

raise EProgManError.Create('Не могу удалить элемент ' + ItemName);

End;

Procedure TProgMan.AddItem(CmdLine, ItemName: String);

Var

P: PChar;

PSize: Word;

Begin

PSize := StrLen(SDDEAddItem) + (Length(CmdLine) *2) + Length(ItemName) + 1;

GetMem(P, PSize);

try

StrFmt(P, SDDEAddItem, [CmdLine, ItemName, CmdLine]);

if NOT FDdeClientConv.ExecuteMacro(P, False) then

raise EProgManError.Create('Не могу добавить элемент ' + ItemName);

finally

FreeMem(P, PSize);

end;

End;

end.

GROUPFILE и ADDITEM для групп

Delphi 1

Вот код для создания файла группы и добавления в группу файла-элемента. Чтобы использовать эту процедуру, определите DDE clientconv App как ProgMan.

procedure TMainForm.CreateWinGroup(Sender: TObject);

var

Name: string;

Name1: string;

Macro: string;

Macro1: string;

Cmd, Cmd1: array[0..255] of Char;

begin

{destDir - dos-каталог, хранящий YourFile.Ext'}

Name := 'GroupName';

Name1 := destDir + 'YourFile.Ext, FileName_in_Group ';

Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10;

Macro1 :=Format('[Additem(%s)]',[Name1]) +#13#10;

StrPCopy(Cmd, Macro);

StrPCopy(cmd1, Macro1);

DDEClient.OpenLink;

if not DDEClient.ExecuteMacro(Cmd, False) then

MessageDlg('Невозможно создать группу '+Name, mtInformation, [mbOK], 0)

else begin

DDEClient.ExecuteMacro(Cmd1, False);

end;

DDEClient.CloseLink;

end;

Как можно работать с DDE под Delphi, используя вызовы API?

Delphi 3

Кстати, достаточно легко: следующий пример демонстрирует как можно научить общаться клиентскую программу с программой-сервером. Обе программы полностью созданы на Delphi. В итоге мы имеем 2 проекта, 3 формы и 3 модуля. Для работы с DDE-запросами данный пример использует методы DDE ML API.

Сервер должен начать свою работу перед тем, как клиент будет загружен. Данный пример демонстрирует 3 способа взаимодействия между клиентом и сервером:

1. Клиент может "пропихивать" (POKE) данные на сервер.

2. Сервер может автоматически передавать данные клиенту, после чего клиент обновляет свой вид на основе результатов, полученных от сервера.

3. Данные сервера изменяются, после чего клиент делает запрос серверу для получения новых данных и обновляет свой вид.

Как работает программа.

Ниже приведены 8 файлов, сконкатенированных в единое целое. Каждый файл имеет следующую структуру:

{ *** НАЧАЛО КОДА FILENAME.EXT *** } КОД { *** КОНЕЦ КОДА FILENAME.EXT *** },

поэтому вам остается всего-лишь взять код, расположенный между маркерами { *** }, скопировать в файл с соответствующим именем, и собрать оба проекта в среде Delphi.

{ *** НАЧАЛО КОДА DDEMLCLI.DPR *** }

program Ddemlcli;

uses Forms,Ddemlclu in 'DDEMLCLU.PAS' {Form1};

{$R *.RES}

begin

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

{ *** КОНЕЦ КОДА DDEMLCLI.DPR *** }

{ *** НАЧАЛО КОДА DDEMLCLU.DFM *** }

object Form1: TForm1

Left = 197

Top = 95

Width = 413

Height = 287

HorzScrollBar.Visible = False

VertScrollBar.Visible = False

Caption = 'Демонстрация DDEML, Клиентское приложение'

Font.Color = clWindowText

Font.Height = -13

Font.Name = 'System'

Font.Style = []

Menu = MainMenu1

PixelsPerInch = 96

OnCreate = FormCreate

OnDestroy = FormDestroy

OnShow = FormShow

TextHeight = 16

object PaintBox1: TPaintBox

Left = 0

Top = 0

Width = 405

Height = 241

Align = alClient

Color = clWhite

ParentColor = False

OnPaint = PaintBox1Paint

end

object MainMenu1: TMainMenu

Top = 208

object File1: TMenuItem

Caption = '&Файл'

object exit1: TMenuItem

Caption = 'В&ыход'

OnClick = exit1Click

end

object DDE1: TMenuItem

Caption = '&DDE'

object RequestUpdate1: TMenuItem

Caption = '&Запрос на обновление'

OnClick = RequestUpdate1Click

end

object AdviseofChanges1: TMenuItem

Caption = '&Сообщение об изменениях'

OnClick = AdviseofChanges1Click

end

object N1: TMenuItem

Caption = '-'

end

object PokeSomeData: TMenuItem

Caption = '&Пропихивание данных'

OnClick = PokeSomeDataClick

end

{ *** КОНЕЦ КОДА DDEMLCLU.DFM *** }

{ *** НАЧАЛО КОДА DDEMLCLU.PAS *** }

{***************************************************}

{ }

{ Delphi 1.0 DDEML Демонстрационная программа }

{ Copyright (c) 1996 by Borland International }

{ }

{***************************************************}

{ Это демонстрационное приложение, демонстрирующее использование DDEML API в клиентском приложении. Оно использует серверное приложение DataEntry, которое является частью данной демонстрации, и служит для ввода данных и отображения их на графической панели.

Сначала вы должны запустить приложение-сервер (в DDEMLSRV.PAS), а затем стартовать клиента. Если сервер не запущен, клиент при попытке соединения потерпит неудачу.

Интерфейс сервера определен списком имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся локально как целые. }

unit Ddemlclu;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, VBXCtrl, ExtCtrls, DDEML, Menus, StdCtrls;

const NumValues = 3;

type

{ Структура данных, представленная в примере }

TDataSample = array [1..NumValues] of Integer;

TDataString = array [0..20] of Char; { Размер элемента как текста }

{ Главная форма }

TForm1 = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

exit1: TMenuItem;

DDE1: TMenuItem;

RequestUpdate1: TMenuItem;

AdviseofChanges1: TMenuItem;

PokeSomeData: TMenuItem;

N1: TMenuItem;

PaintBox1: TPaintBox;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure RequestUpdate1Click(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure AdviseofChanges1Click(Sender: TObject);

procedure PokeSomeDataClick(Sender: TObject);

procedure Request(HConversation: HConv);

procedure exit1Click(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

private

{ Private declarations }

public

Inst: Longint;

CallBackPtr: ^TCallback;

ServiceHSz : HSz;

TopicHSz : HSz;

ItemHSz : array [1..NumValues] of HSz;

ConvHdl : HConv;

DataSample : TDataSample;

end;

var Form1: TForm1;

implementation

const

DataEntryName : PChar = 'DataEntry';

DataTopicName : PChar = 'SampledData';

DataItemNames : array [1..NumValues] of pChar = ('DataItem1', 'DataItem2', 'DataItem3');

{$R *.DFM}

{ Локальная функция: Процедура обратного вызова для DDEML }

function CallbackProc(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ; Data: HDDEData; Data1, Data2: Longint): HDDEData; export;

begin

CallbackProc := 0; { В противном случае смотрите доказательство }

case CallType of

xtyp_Register:

begin

{ Ничего ... Просто возвращаем 0 }

end;

xtyp_Unregister:

begin

{ Ничего ... Просто возвращаем 0 }

end;

xtyp_xAct_Complete:

begin

{ Ничего ... Просто возвращаем 0 }

end;

xtyp_Request, Xtyp_AdvData:

begin

Form1.Request(Conv);

CallbackProc := dde_FAck;

end;

xtyp_Disconnect:

begin

ShowMessage('Соединение разорвано!');

Form1.Close;

end;

{ Посылка DDE запроса для получения cf_Text данных с сервера. Запрашиваем данные для всех полей DataSample, и обновляем окно для их отображения. Данные с сервера получаем синхронно, используя DdeClientTransaction.}

procedure TForm1.Request(HConversation: HConv);

var

hDdeTemp : HDDEData;

DataStr : TDataString;

Err, I : Integer;

begin

if HConversation <> 0 then begin

for I := Low(ItemHSz) to High(ItemHSz) do begin

hDdeTemp:= DdeClientTransaction(nil, 0, HConversation, ItemHSz[I], cf_Text, xtyp_Request, 0, nil);

if hDdeTemp <> 0 then begin

DdeGetData(hDdeTemp, @DataStr, SizeOf(DataStr), 0);

Val(DataStr, DataSample[I], Err);

end; { if }

end; { for }

Paintbox1.Refresh; { Обновляем экран }

end; { if }

end;

procedure TForm1.FormCreate(Sender: TObject);

var I : Integer;

{ Создаем экземпляр окна DDE-клиента. Создаем окно, используя унаследованный конструктор, инициализируем экземпляр данных.}

begin

Inst:= 0;

{ Должен быть нулем для первого вызова DdeInitialize }

CallBackPtr:= nil;

{ MakeProcInstance вызывается из SetupWindow }

ConvHdl:= 0;

ServiceHSz := 0;

TopicHSz:= 0;

for I := Low(DataSample) to High(DataSample) do begin

ItemHSz[I]:= 0;

DataSample[I] := 0;

end;

procedure TForm1.FormDestroy(Sender: TObject);

{ Уничтожаем экземпляр клиентского окна. Освобождаем дескрипторы DDE строк, и освобождаем экземпляр функции обратного вызова, если она существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка. }

var I : Integer;

begin

if ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz);

if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz);

for I := Low(ItemHSz) to High(ItemHSz) do

if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]);

if Inst <> 0 then DdeUninitialize(Inst); { Игнорируем возвращаемое значение }

if CallBackPtr <> nil then FreeProcInstance(CallBackPtr);

end;

procedure TForm1.RequestUpdate1Click(Sender: TObject);

begin

{ Генерируем запрос DDE в ответ на выбор пункта меню DDE | Request.}

Request(ConvHdl);

end;

procedure TForm1.FormShow(Sender: TObject);

{ Завершаем инициализацию окна сервера DDE. Выполняем те действия, которые требует правильное окно. Инициализируем использование DDEML. }

var

I: Integer;

InitOK: Boolean;

begin

CallBackPtr := MakeProcInstance(@CallBackProc, HInstance);

{ Инициализируем DDE и устанавливаем функцию обратного вызова. Если сервер отсутствует, вызов терпит неудачу. }

if CallBackPtr <> nil then begin

if DdeInitialize(Inst, TCallback(CallBackPtr), AppCmd_ClientOnly,0) = dmlErr_No_Error then begin

ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi);

TopicHSz:= DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi);

InitOK := True;

{for I := Low(DataItemNames) to High(DataItemNames) do begin }

for I := 1 to NumValues do begin

ItemHSz[I]:= DdeCreateStringHandle(Inst, DataItemNames[I], cp_WinAnsi);

InitOK := InitOK and (ItemHSz[I] <> 0);

end;

if (ServiceHSz <> 0) and (TopicHSz <> 0) and InitOK then begin

ConvHdl := DdeConnect(Inst, ServiceHSz, TopicHSz, nil);

if ConvHdl = 0 then begin

ShowMessage('Не могу инициализировать диалог!');

Close;

end

end else begin

ShowMessage('Не могу создать строки!');

Close;

end

end else begin

ShowMessage('Не могу осуществить инициализацию!');

Close;

end;

procedure TForm1.AdviseofChanges1Click(Sender: TObject);

{ Переключаемся на режим DDE Advise с помощью пункта меню DDE | Advise (уведомление). При выборе этого пункта меню все три элемента переключаются на уведомление. }

var

I: Integer;

TransType: Word;

TempResult: Longint;

begin

with TMenuITem(Sender) do begin

Checked := not Checked;

if Checked then TransType:= (xtyp_AdvStart or xtypf_AckReq)

else TransType:= xtyp_AdvStop;

end; { with }

for I := Low(ItemHSz) to High(ItemHSz) do

if DdeClientTransaction(nil, 0, ConvHdl, ItemHSz[I], cf_Text,TransType, 1000, @TempResult) = 0 then ShowMessage('Не могу выполнить транзакцию-уведомление');

if TransType and xtyp_AdvStart <> 0 then Request(ConvHdl);

end;

procedure TForm1.PokeSomeDataClick(Sender: TObject);

{ Генерируем DDE-Poke транзакцию в ответ на выбор пункта меню DDE | Poke. Запрашиваем значение у пользователя, которое будем "проталкивать" в DataItem1 в качестве иллюстрации Poke-функции.}

var

DataStr: pChar;

S: String;

begin

S := '0';

if InputQuery('PokeData', 'Задайте проталкиваемую (Poke) величину', S) then begin

S := S + #0;

DataStr := @S[1];

DdeClientTransaction(DataStr, StrLen(DataStr) + 1, ConvHdl, ItemHSz[1], cf_Text, xtyp_Poke, 1000, nil);

Request(ConvHdl);

end;

procedure TForm1.exit1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

{ После запроса обновляем окно. Рисуем график объема текущих продаж.}

const

LMarg = 30; { Левое поле графика }

var

I,Norm: Integer;

Wd: Integer;

Step : Integer;

ARect: TRect;

begin

Norm := 0;

for I := Low(DataSample) to High(DataSample) do begin

if abs(DataSample[I]) > Norm then Norm := abs(DataSample[I]);

end; { for }

if Norm = 0 then Norm := 1; { В случае если у нас все нули }

with TPaintBox(Sender).Canvas do begin

{ Рисуем задний фон }

Brush.color:= clWhite;

FillRect(ClipRect);

{ Рисуем ось }

MoveTo(0, ClipRect.Bottom div 2);

LineTo(ClipRect.Right, ClipRect.Bottom div 2);

MoveTo(LMarg, 0);

LineTo(LMarg, ClipRect.Bottom);

{ Печатаем текст левого поля }

TextOut(0, 0, IntToStr(Norm));

TextOut(0, ClipRect.Bottom div 2, '0');

TextOut(0, ClipRect.Bottom + Font.Height, IntToStr(-Norm));

TextOut(0, ClipRect.Bottom div 2, '0');

{ Печатаем текст оси X }

{ Теперь рисуем бары на основе нормализованного значения. Вычисляем ширину баров (чтобы они все вместились в окне) и ширину пробела между ними, который приблизительно равен 20% от их ширины. }

{ SelectObject(PaintDC, CreateSolidBrush(RGB(255, 0, 0)));

SetBkMode(PaintDC, Transparent);}

ARect := ClipRect;

Wd := (ARect.Right - LMarg) div NumValues;

Step := Wd div 5;

Wd := Wd - Step;

with ARect do begin

Left := LMarg + (Step div 2);

Top := ClipRect.Bottom div 2;

end; { with }

{ Выводим бары и текст для оси X }

For i := Low(DataSample) to High(DataSample) do begin

with ARect do begin

Right := Left + Wd;

Bottom:= Top - Round((Top-5) * (DataSample[I] / Norm));

end; { with }

{ Заполняем бар }

Brush.color:= clFuchsia;

FillRect(ARect);

{ Выводим текст для горизонтальной оси }

Brush.color:= clWhite;

TextOut(ARect.Left, ClipRect.Bottom div 2 - Font.Height, StrPas(DataItemNames[i]));

with ARect do Left := Left + Wd + Step;

end; { for }

end; { with }

end;

end.{ *** КОНЕЦ КОДА DDEMLCLU.PAS *** }

{ *** НАЧАЛО КОДА DDEMLSVR.DPR *** }

program Ddemlsvr;

uses Forms,Ddesvru in 'DDESVRU.PAS' {Form1}, Ddedlg in '\DELPHI\BIN\DDEDLG.PAS' {DataEntry};

{$R *.RES}

begin

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TDataEntry, DataEntry);

Application.Run;

end.

{ *** КОНЕЦ КОДА DDEMLSVR.DPR *** }

{ *** НАЧАЛО КОДА DDESVRU.DFM *** }

object Form1: TForm1

Left = 712

Top = 98

Width = 307

Height = 162

Caption = 'Демонстрация DDEML, Серверное приложение'

Color = clWhite

Font.Color = clWindow

TextFont.Height = -13

Font.Name = 'System'

Font.Style = []

Menu = MainMenu1

PixelsPerInch = 96

OnCreate = FormCreate

OnDestroy = FormDestroy

OnShow = FormShow

TextHeight = 16

object Label1: TLabel

Left = 0

Top = 0

Width = 99

Height = 16

Caption = 'Текущие значения:'

end

object Label2: TLabel

Left = 16

Top = 24

Width = 74

Height = 16

Caption = 'Data Item1:'

end

object Label3: TLabel

Left = 16

Top = 40

Width = 74

Height = 16

Caption = 'Data Item2:'

end

object Label4: TLabel

Left = 16

Top = 56

Width = 74

Height = 16

Caption = 'Data Item3:'

end

object Label5: TLabel

Left = 0

Top = 88

Width = 265

Height = 16

Caption = 'Выбор данных | Ввод данных для изменения значений.'

end

object Label6: TLabel

Left = 96

Top = 24

Width = 8

Height = 16

Caption = '0'

end

object Label7: TLabel

Left = 96

Top = 40

Width = 8

Height = 16

Caption = '0'

end

object Label8: TLabel

Left = 96

Top = 56

Width = 8

Height = 16

Caption = '0'

end

object MainMenu1: TMain

MenuLeft = 352

Top = 24

object File1: TMenuItem

Caption = '&Файл'

object Exit1: TMenuItem

Caption = '&Выход'

OnClick = Exit1Click

end

object Data1: TMenuItem

Caption = '&Данные'

object EnterData1: TMenuItem

Caption = '&Ввод данных'

OnClick = EnterData1Click

end

object Clear1: TMenuItem

Caption = '&Очистить'

OnClick = Clear1Click

end

{ *** КОНЕЦ КОДА DDESVRU.DFM *** }

{ *** НАЧАЛО КОДА DDESVRU.PAS *** }

{***************************************************}

{ }

{ Delphi 1.0 DDEML Демонстрационная программа }

{ Copyright (c) 1996 by Borland International }

{ }

{***************************************************}

{ Данный демонстрационный пример использует библиотеку DDEML на стороне сервера кооперативного приложения. Данный сервер является простым приложением для ввода данных и позволяет оператору осуществлять ввод трех элементов данных, которые становятся доступными через DDE "заинтересованным" клиентам.

Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами:

Service: 'DataEntry'

Topic : 'SampledData'

Items : 'DataItem1', 'DataItem2', 'DataItem3'

В-принципе, в качестве сервисов могли бы быть определены и другие темы. Полезными темами, на наш взгляд, могут быть исторические даты, информация о сэмплах и пр..

Вы должны запустить этот сервер ПЕРЕД тем как запустите клиента (DDEMLCLI.PAS), в противном случае клиент не сможет установить связь.

Интерфейс для этого сервера определен как список имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся у клиента локально как целые. }

unit Ddesvru;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, DDEML, { DDE APi }ShellApi;

const

NumValues = 3;

DataItemNames : array [1..NumValues] of PChar = ('DataItem1', 'DataItem2', 'DataItem3');

type

TDataString = array [0..20] of Char; { Размер элемента как текста }

TDataSample = array [1..NumValues] of Integer;

{type

{ Структура данных, составляющих образец }

{ TDataSample = array [1..NumValues] of Integer;

{ TDataString = array [0..20] of Char; { Размер элемента как текста }

const

DataEntryName: PChar = 'DataEntry';

DataTopicName: PChar = 'SampledData';

type TForm1 = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

Data1: TMenuItem;

EnterData1: TMenuItem;

Clear1: TMenuItem;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

procedure Exit1Click(Sender: TObject);

function MatchTopicAndService(Topic, Service: HSz): Boolean;

function MatchTopicAndItem(Topic, Item: HSz): Integer;

function WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData;

function AcceptPoke(Item: HSz; ClipFmt: Word;Data: HDDEData): Boolean;

function DataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure EnterData1Click(Sender: TObject);

procedure Clear1Click(Sender: TObject);

private

Inst : Longint;

CallBack : TCallback;

ServiceHSz : HSz;

TopicHSz : HSz;

ItemHSz : array [1..NumValues] of HSz;

ConvHdl : HConv;

Advising : array [1..NumValues] of Boolean;

DataSample : TDataSample;

public

{ Public declarations }

end;

var Form1: TForm1;

implementation

uses DDEDlg; { Форма DataEntry }

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);

begin

Close;

end;

{ Глобальная инициализация }

const

DemoTitle: PChar = 'DDEML демо, серверное приложение';

MaxAdvisories = 100;

NumAdvLoops : Integer = 0;

{ Локальная функция: Процедура обратного вызова для DDEML }

{ Данная функция обратного вызова реагирует на все транзакции, генерируемые DDEML. Объект "target Window" (окно-цель) берется из глобально хранимых, и для реагирования на данную транзакцию, тип которой указан в параметре CallType, используются подходящие методы этих объектов.}

function CallbackProc(CallType, Fmt: Word; Conv: HConv; HSz1, HSz2: HSZ; Data: HDDEData; Data1, Data2: Longint): HDDEData; export;

var

ItemNum: Integer;

begin

CallbackProc := 0; { В противном случае смотрите доказательство }

case CallType of

xtyp_WildConnect:

CallbackProc := Form1.WildConnect(HSz1, HSz2, Fmt);

xtyp_Connect:

if Conv = 0 then begin

if Form1.MatchTopicAndService(HSz1, HSz2) then CallbackProc := 1; { Связь! }

end;

{ После подтверждения установки соединения записываем дескриптор связи как родительское окно.}

xtyp_Connect_Confirm:

Form1.ConvHdl := Conv;

{ Клиент запрашивает данные, делает прямой запрос или отвечает на уведомление. Возвращаем текущее состояние данных.}

xtyp_AdvReq, xtyp_Request:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

if ItemNum > 0 then CallbackProc := Form1.DataRequested(CallType, ItemNum, Fmt);

end;

{ Отвечаем на Poke-запрос ... данная демонстрация допускает только Pokes для DataItem1. Для подтверждения получения запроса возвращаем dde_FAck, в противном случае 0.}

xtyp_Poke:

begin

if Form1.AcceptPoke(HSz2, Fmt, Data) then CallbackProc := dde_FAck;

end;

{ Клиент сделал запрос для старта цикла-уведомления. Имейте в виду, что мы организуем "горячий" цикл. Устанавливаем флаг Advising для указания открытого цикла, который будет проверять данные на предмет их изменения.}

xtyp_AdvStart:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

if ItemNum > 0 then begin

if NumAdvLoops < MaxAdvisories then begin

{ Произвольное число }

Inc(NumAdvLoops);

Form1.Advising[ItemNum] := True;

CallbackProc := 1;

end;

{ Клиент сделал запрос на прерывание цикла-уведомления.}

xtyp_AdvStop:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

if ItemNum > 0 then begin

if NumAdvLoops > 0 then begin

Dec(NumAdvLoops);

if NumAdvLoops = 0 then Form1.Advising[ItemNum] := False;

CallbackProc := 1;

end;

end; { Case CallType }

end;

{ Возращает True, если данные Topic и Service поддерживаются этим приложением. В противном случае возвращается False.}

function TForm1.MatchTopicAndService(Topic, Service: HSz): Boolean;

begin

Result := False;

if DdeCmpStringHandles(TopicHSz, Topic) = 0 then

if DdeCmpStringHandles(ServiceHSz, Service) = 0 then Result := True;

end;

{ Определяем, один ли Topic и Item поддерживается этим приложением. Возвращаем номер заданного элемента (Item Number) (в пределах 1..NumValues), если он обнаружен, и ноль в противном случае.}

function TForm1.MatchTopicAndItem(Topic, Item: HSz): Integer;

var I : Integer;

begin

Result := 0;

if DdeCmpStringHandles(TopicHSz, Topic) = 0 then

for I := 1 to NumValues do

if DdeCmpStringHandles(ItemHSz[I], Item) = 0 then

Result := I;

end;

{ Отвечаем на запрос wildcard-соединения (дословно - дикая карта, шаблон). Такие запросы возникают всякий раз, когда клиент пытается подключиться к серверу с сервисом или именем топика, установленного в 0. Если сервер обнаруживает использование такого рода шаблона, он возвращает дескриптор массива THSZPair, содержащего найденные по шаблону Service и Topic.}

function TForm1.WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData;

var

TempPairs: array [0..1] of THSZPair;

Matched : Boolean;

begin

TempPairs[0].hszSvc:= ServiceHSz;

TempPairs[0].hszTopic:= TopicHSz;

TempPairs[1].hszSvc:= 0; { 0-завершает список }

TempPairs[1].hszTopic:= 0;

Matched := False;

if (Topic= 0) and (Service = 0) then Matched := True { Шаблон обработан, элементов не найдено }

else

if (Topic = 0) and (DdeCmpStringHandles(Service, ServiceHSz) = 0) then Matched := True

else if (DdeCmpStringHandles(Topic, TopicHSz) = 0) and (Service = 0) then Matched := True;

if Matched then

WildConnect := DdeCreateDataHandle(Inst, @TempPairs, SizeOf(TempPairs), 0, 0, ClipFmt, 0)

else WildConnect := 0;

end;

{ Принимаем и проталкиваем данные по просьбе клиента. Для демонстрации этого способа используем только значение DataItem1, изменяемое Poke.}

function TForm1.AcceptPoke(Item: HSz; ClipFmt: Word; Data: HDDEData): Boolean;

var

DataStr: TDataString;

Err: Integer;

TempSample: Integer;

begin

if (DdeCmpStringHandles(Item, ItemHSz[1]) = 0) and (ClipFmt = cf_Text) then begin

DdeGetData(Data, @DataStr, SizeOf(DataStr), 0);

Val(DataStr, TempSample, Err);

if IntToStr(TempSample) <> Label6.Caption then begin

Label6.Caption:= IntToStr(TempSample);

DataSample[1] := TempSample;

if Advising[1] then DdePostAdvise(Inst, TopicHSz, ItemHSz[1]);

end;

AcceptPoke := True;

end else AcceptPoke := False;

end;

{ Возвращаем данные, запрашиваемые значениями TransType и ClipFmt. Такое может произойти в ответ на просьбу xtyp_Request или xtyp_AdvReq. Параметр ItemNum указывает на поддерживаемый (в диапазоне 1..NumValues) и требуемый элемент (обратите внимание на то, что данный метод подразумевает, что вызывающий оператор уже установил достоверность и ID требуемого пункта с помощью MatchTopicAndItem). Соответствующие данные из переменной экземпляра DataSample преобразуются в текст и возвращаются клиенту.}

function TForm1.DataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData;

var ItemStr: TDataString; { Определено в DataEntry.TPU }

begin

if ClipFmt = cf_Text then begin

Str(DataSample[ItemNum], ItemStr);

DataRequested := DdeCreateDataHandle(Inst, @ItemStr, StrLen(ItemStr) + 1, 0, ItemHSz[ItemNum], ClipFmt, 0);

end else DataRequested := 0;

end;

{ Создаем экземпляр окна DDE сервера. Вызываем унаследованный конструктор, затем устанавливаем эти объекты родителями экземпляров данных. }

procedure TForm1.FormCreate(Sender: TObject);

var I : Integer;

begin

Inst:= 0; { Должен быть нулем для первого вызова DdeInitialize }

@CallBack := nil; { MakeProcInstance вызывается из SetupWindow }

for I := 1 to NumValues do begin

DataSample[I] := 0;

Advising[I] := False;

end; { for }

end;

{ Разрушаем экземпляр окна DDE сервера. Проверяем, был ли создан экземпляр процедуры обратного вызова, если он существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка.}

procedure TForm1.FormDestroy(Sender: TObject);

var I : Integer;

begin

if ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz);

if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz);

for I := 1 to NumValues do

if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]);

if Inst <> 0 then DdeUninitialize(Inst); { Игнорируем возвращаемое значение }

if @CallBack <> nil then FreeProcInstance(@CallBack);

end;

procedure TForm1.FormShow(Sender: TObject);

var

I : Integer;

{ Завершаем инициализацию окна DDE сервера. Процедура инициализации использует DDEML для регистрации сервисов, предусмотренных данным приложением. Помните о том, что реальные имена, использованные в регистрах, определены в отдельном модуле (DataEntry), поэтому они могут быть использованы и клиентом. }

begin

@CallBack:= MakeProcInstance(@CallBackProc, HInstance);

if DdeInitialize(Inst, CallBack, 0, 0) = dmlErr_No_Error then begin

ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi);

TopicHSz := DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi);

for I := 1 to NumValues do

ItemHSz[I] := DdeCreateStringHandle(Inst, DataItemNames[I],cp_WinAnsi);

if DdeNameService(Inst, ServiceHSz, 0, dns_Register) = 0 then

ShowMessage('Ошибка в процессе регистрации.');

end;

procedure TForm1.EnterData1Click(Sender: TObject);

{ Активизируем диалог ввода данных и обновляем хранимые данные по окончании ввода.}

var I: Integer;

begin

if DataEntry.ShowModal = mrOk then begin

with DataEntry do begin

Label6.Caption := S1;

Label7.Caption := S2;

Label8.Caption := S3;

DataSample[1] := StrToInt(S1);

DataSample[2] := StrToInt(S2);

DataSample[3] := StrToInt(S3);

end; { with }

for I := 1 to NumValues do

if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]);

end; { if }

end;

procedure TForm1.Clear1Click(Sender: TObject);

{ Очищаем текущую дату. }

var I: Integer;

begin

for I := 1 to NumValues do begin

DataSample[I] := 0;

if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]);

end;

Label6.Caption := '0';

Label7.Caption := '0';

Label8.Caption := '0';

end;

end.

{ *** КОНЕЦ КОДА DDESVRU.PAS *** }

{ *** НАЧАЛО КОДА DDEDLG.DFM *** }

object DataEntry: TDataEntry

Left = 488

Top = 132

ActiveControl = OK

BtnBorderStyle = bsDialog

Caption = 'Ввод данных'

ClientHeight = 264

ClientWidth = 199

Font.Color = clBlack

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

PixelsPerInch = 96

Position = poScreenCenter

OnShow = FormShow

TextHeight = 13

object Bevel1: TBevel

Left = 8

Top = 8

Width = 177

Height = 201

Shape = bsFrame

IsControl = True

end

object OKBtn: TBitBtn

Left = 16

Top = 216

Width = 69

Height = 39

Caption = '&OK'

ModalResult = 1

TabOrder = 3

OnClick = OK

BtnClickGlyph.Data = {

BE060000424DBE06000000000000360400002800000024000000120000000100

0800000000008802000000000000000000000000000000000000000000000000

80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA

A600000000000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000F0FBFF00A4A0A000808080000000

FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00030303030303

0303030303030303030303030303030303030303030303030303030303030303

03030303030303030303030303030303030303030303FF030303030303030303

03030303030303040403030303030303030303030303030303F8F8FF03030303

03030303030303030303040202040303030303030303030303030303F80303F8

FF030303030303030303030303040202020204030303030303030303030303F8

03030303F8FF0303030303030303030304020202020202040303030303030303

0303F8030303030303F8FF030303030303030304020202FA0202020204030303

0303030303F8FF0303F8FF030303F8FF03030303030303020202FA03FA020202

040303030303030303F8FF03F803F8FF0303F8FF03030303030303FA02FA0303

03FA0202020403030303030303F8FFF8030303F8FF0303F8FF03030303030303

FA0303030303FA0202020403030303030303F80303030303F8FF0303F8FF0303

0303030303030303030303FA0202020403030303030303030303030303F8FF03

03F8FF03030303030303030303030303FA020202040303030303030303030303

0303F8FF0303F8FF03030303030303030303030303FA02020204030303030303

03030303030303F8FF0303F8FF03030303030303030303030303FA0202020403

030303030303030303030303F8FF0303F8FF03030303030303030303030303FA

0202040303030303030303030303030303F8FF03F8FF03030303030303030303

03030303FA0202030303030303030303030303030303F8FFF803030303030303

030303030303030303FA0303030303030303030303030303030303F803030303

0303030303030303030303030303030303030303030303030303030303030303

0303

}

Margin = 2

NumGlyphs = 2

Spacing = -1

IsControl = True

end

object CancelBtn: TBitBtn

Left = 108

Top = 216

Width = 69

Height = 39

Caption = '&Отмена'

TabOrder = 4

Kind = bkCancel

Margin = 2

Spacing = -1

IsControl = True

end

object Panel2: TPanel

Left = 16

Top = 88

Width = 153

Height = 49

BevelInner = bvLowered

BevelOuter = bvNone

TabOrder = 1

object Label1: TLabel

Left = 24

Top = 8

Width = 5

Height = 13

end

object Label2: TLabel

Left = 8

Top = 8

Width = 48

Height = 13

Caption = 'Значение 2:'

end

object Edit2: TEdit

Left = 8

Top = 24

Width = 121

Height = 20

MaxLength = 10

TabOrder = 0

Text = '0'

end

object Panel1: TPanel

Left = 16

Top = 16

Width = 153

Height = 49

BevelInner = bvLowered

BevelOuter = bvNone

TabOrder = 0

object Label4: TLabel

Left = 8

Top = 8

Width = 48

Height = 13

Caption = 'Значение 1:'

end

object Edit1: TEdit

Left = 8

Top = 24

Width = 121

Height = 20

MaxLength = 10

TabOrder = 0

Text = '0'

end

object Panel3: TPanel

Left = 16

Top = 144

Width = 153

Height = 49

BevelInner = bvLowered

BevelOuter = bvNone

TabOrder = 2

object Label6: TLabel

Left = 8

Top = 8

Width = 48

Height = 13

Caption = 'Значение 3:'

end

object Edit3: TEdit

Left = 8

Top = 24

Width = 121

Height = 20

MaxLength = 10

TabOrder = 0

Text = '0'

end

{ *** КОНЕЦ КОДА DDEDLG.DFM *** }

{ *** НАЧАЛО КОДА DDEDLG.PAS *** }

{***************************************************}

{ }

{ Delphi 1.0 DDEML Демонстрационная программа }

{ Copyright (c) 1996 by Borland International }

{ }

{***************************************************}

{ Данный модуль определяет интерфейс сервера DataEntry DDE

(DDEMLSRV.PAS). Здесь определены имена Service, Topic,и Item, поддерживаемые сервером, и также определенаструктура данных, которая может использоватьсяклиентом для локального хранения "показательных" данных.

Сервер Data Entry Server делает свои "показательные"данные доступными в текстовом виде (cf_Text)сформированными в виде трех различных топика (Topics).Клиент может их преобразовывать в целое дляиспользования со структурой данных, которая здесь определена.}

unit Ddedlg;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, StdCtrls, Mask, ExtCtrls;

type TDataEntry = class(TForm)

OKBtn: TBitBtn;

CancelBtn: TBitBtn;

Bevel1: TBevel;

Panel2: TPanel;

Label1: TLabel;

Label2: TLabel;

Panel1: TPanel;

Label4: TLabel;

Panel3: TPanel;

Label6: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

procedure OKBtnClick(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

S1, S2, S3: String;

{ Public declarations }

end;

var DataEntry: TDataEntry;

implementation

{$R *.DFM}

procedure TDataEntry.OKBtnClick(Sender: TObject);

begin

S1 := Edit1.Text;

S2 := Edit2.Text;

S3 := Edit3.Text;

end;

procedure TDataEntry.FormShow(Sender: TObject);

begin

Edit1.Text := '0';

Edit2.Text := '0';

Edit3.Text := '0';

Edit1.SetFocus;

end;

end.

{ *** КОНЕЦ КОДА DDEDLG.PAS *** }

Как добавить группу в Program Manager?

Delphi 1

interface

procedure CreateGroup;

implementation

procedure TSetupForm.CreateGroup;

{ Для установки группы в Program Manager используем компонент TProgMan }

var

ItemList: TStringList;

GroupName: String;

ItemName: String;

i: word;

begin

{ Получаем из INI-файла строку GroupName }

GroupName := IniFile.ReadString('General', 'PMGroup', '');

{ Если один есть, устанавливаем группу }

if GroupName <> '' then begin

ItemList := TStringList.Create;

try

{ читаем элементы для установки }

IniFile.ReadSectionValues('PMGroup', ItemList);

with TProgMan.Create(Self) do try

CreateGroup(GroupName);

for i := 0 to ItemList.Count – 1 do begin

{ получаем имя файла }

ItemName := Copy(ItemList.Strings[i], 1, Pos('=', ItemList.Strings[i]) – 1);

{ прибавляем путь к имени файла и добавляем элемент }

AddItem(GetTarget(ItemList.Values[ItemName][1]) + ItemName, ItemName);

end;

finally

Free;

end;

finally

ItemList.Free;

end;

OLE

OLE-автоматизация в Delphi 1

Delphi 1

Delphi 16 также может осуществлять автоматизацию OLE, как она может и многое другое. Другое дело, что у нее нет компонентов-инкапсуляторов, и нет традиционных объектов, делающих работу с OLE такой же легкой, как это происходит с другими вещами в Delphi. Delphi32 таки должен иметь какие-то характеристики для работы с OLE (я так надеюсь).

Так, если вы собираетесь делать какие-то действия с любым типом OLE-сервера, то для этого вам необходимо будет использовать все нудные и противные рутинки из набора Windows SDK. Но будет лучше, если всем этим будет заправлять специализированный компонент. Но этот вопрос уже не к Borland.

OLE сервер

Delphi 1

Следующий код компилируется без проблем. Он не так ясен и понятен, но он может вам помочь:

unit Unit1;

interface

function OLEfunction(x, y, z: integer): integer; cdecl; export;

implementation

function OLEfunction(x, y, z: integer): integer;

begin

end;

procedure buildOLEstructure;

var F: pointer;

begin

F := @OLEfunction; { Компилируется без проблем … }

end;

end.

Используйте метод, приведенный ниже. Вы должны объявить одну вызывающую функцию к каждой комбинации параметров, которые вы собираетесь передавать. Затем вы вызываете вызывающую функцию (сорри) и передаете ей как указатель функцию, которую вы хотите вызвать (еще раз сорри). Непонятно? Поясню на примере:

library pcdecl;

function olefunction(a1: pchar; a2: longint; x: integer): integer; cdecl; export;

begin

end;

function callolefunction(func: pointer; a1: pchar; a2: longint; x: integer): integer; assembler;

asm

push x { помещаем параметры в обратном порядке }

push word ptr a2 + 2 { если 32-битная величина передается в этих двух шагах, то начинаем с самой «высокой» (high) части }

push word ptr a2

push word ptr a1 + 2

push word ptr a1

call func

add sp, 10 { восстанавливаем стек добавлением вытолкнутых байтов. Обратите внимание на то, что func не была вытолкнута }

end;

procedure buildolefunction;

var

f: pointer;

reslt: integer;

begin

f := @olefunction;

{ --- }

reslt := callolefunction(f, 'Здравствуй, мир', 1000000, 25);

{ --- }

end;

begin

{ --- }

end.

На моем компьютере это компилируется без проблем. Должно работать и у вас. Предупреждение. Обращение к методам должно быть немного другим, нежели к функциям.

Как я могу избавиться от 'зарегистрированного' имени сервера, если я не хочу использовать его далее?

Nomadic советует:

Запустите исполняемый файл сервера с ключом /UNREGSERVER:

MYSERVER.EXE /UNREGSERVER

Это обычный путь разрегистрации саморегистрирующегося сервера автоматизации OLE.

Оглавление