Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами:
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;
end;
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;
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;
