Эксперт
Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва
Репутация: 80
Всего: 162
|
Как можно работать с DDE под Delphi, используя вызовы API Кстати, достаточно легко: следующий пример демонстрирует как можно научить общаться клиентскую программу с программой-сервером. Обе программы полностью созданы на Delphi. В итоге мы имеет 2 проекта, 3 формы и 3 модуля. Для работы с DDE-запросами данный пример использует методы DDE ML API. Сервер должен начать свою работу перед тем, как клиент будет загружен. Данный пример демонстрирует 3 способа взаимодействия между клиентом и сервером: Клиент может "пропихивать" (POKE) данные на сервер. Сервер может автоматически передавать данные клиенту, после чего клиент обновляет свой вид на основе результатов, полученных от сервера. Данные сервера изменяются, после чего клиент делает запрос серверу для получения новых данных и обновляет свой вид. Как работает программа. Ниже приведены 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
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
end
end
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;
end;
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;
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;
end;
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;
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');
TextOut(0, ClipRect.Bottom div 2, '0');
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 = clWindowText
Font.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: TMainMenu
Left = 352
Top = 24
object File1: TMenuItem
Caption = '&Файл'
object Exit1: TMenuItem
Caption = '&Выход'
OnClick = Exit1Click
end
end
object Data1: TMenuItem
Caption = '&Данные'
object EnterData1: TMenuItem
Caption = '&Ввод данных'
OnClick = EnterData1Click
end
object Clear1: TMenuItem
Caption = '&Очистить'
OnClick = Clear1Click
end
end
end
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;
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;
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 для регистрации сервисов, предусмо
--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце.
|
|
|
|
| Правила форума "Delphi: Общие вопросы" |
 
 
|
Запрещается!
1. Публиковать ссылки на вскрытые компоненты
2. Обсуждать взлом компонентов и делиться вскрытыми компонентами
- Литературу по Дельфи обсуждаем здесь
- Действия модераторов можно обсудить здесь
- С просьбами о написании курсовой, реферата и т.п. обращаться сюда
- Вопросы по реализации алгоритмов рассматриваются здесь
- 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
|
|
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
|
|
0 Пользователей:
|
|
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »
|
|
|
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности
Powered by Invision Power Board(R) 1.3 © 2003 IPS, Inc. |
|
|
Как можно работать с DDE? 
Загрузка ...
