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

end; { Case CallType }

end;

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

functionTForm1.MatchTopicAndService(Topic, Service: HSz): Boolean;

begin

Result := False;

ifDdeCmpStringHandles(TopicHSz, Topic) = 0 then

ifDdeCmpStringHandles(ServiceHSz, Service) = 0 thenResult := True;

end;

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

functionTForm1.MatchTopicAndItem(Topic, Item: HSz): Integer;

varI : Integer;

begin

Result := 0;

ifDdeCmpStringHandles(TopicHSz, Topic) = 0 then

forI := 1 toNumValues do

ifDdeCmpStringHandles(ItemHSz[I], Item) = 0 then

Result := I;

end;

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

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

var

TempPairs: array[0..1] ofTHSZPair;

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) thenMatched := True { Шаблон обработан, элементов не найдено }

else

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

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

ifMatched then

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

elseWildConnect := 0;

end;

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

functionTForm1.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);

ifIntToStr(TempSample) <> Label6.Caption then begin

Label6.Caption:= IntToStr(TempSample);

DataSample[1] := TempSample;

ifAdvising[1] thenDdePostAdvise(Inst, TopicHSz, ItemHSz[1]);

end;

AcceptPoke := True;

end elseAcceptPoke := False;

end;

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

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

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

begin

ifClipFmt = cf_Text then begin

Str(DataSample[ItemNum], ItemStr);

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

end elseDataRequested := 0;

end;

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

procedureTForm1.FormCreate(Sender: TObject);

varI : Integer;

begin

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

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

forI := 1 toNumValues do begin

DataSample[I] := 0;

Advising[I] := False;

end; { for }

end;

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

procedureTForm1.FormDestroy(Sender: TObject);