source: trunk/Sibyl/SPCC/DDEMAN.PAS@ 145

Last change on this file since 145 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 66.9 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit DDEMan;
11
12Interface
13
14Uses Dos,SysUtils,Classes,Forms;
15
16{$IFDEF OS2}
17Uses Os2Def,BseDos,PmWin;
18{$ENDIF}
19{$IFDEF WIN32}
20Uses WinNT,WinBase,WinUser,DDeml;
21{$ENDIF}
22
23Type
24 TDdeServerConv=Class;
25 TDdeServerItem=Class;
26 TDdeClientConv=Class;
27 TDdeClientItem=Class;
28
29 {$M+}
30 TDataMode=(ddeAutomatic, ddeManual);
31
32 TExecuteMacro=Procedure(Sender:TObject;macro:TStrings;Var Success:Boolean) Of Object;
33 {$M-}
34
35 TDdeClientConv=Class(TComponent)
36 Private
37 FDdeService:PString;
38 FDdeTopic:PString;
39 FItems: TList;
40 FConnectMode:TDataMode;
41 FForm:TForm;
42 FConnected:Boolean;
43 FObjectWindow:TControl;
44 FOperationComplete:Boolean;
45 FData:Pointer;
46 FDataLen:LongInt;
47 FTimeOut:LongWord;
48 FOnClose:TNotifyEvent;
49 FOnOpen:TNotifyEvent;
50 FOnTimeOut:TNotifyEvent;
51 {$IFDEF WIN32}
52 FDdeData:LongWord;
53 FConv:LongWord;
54 {$ENDIF}
55 Function GetDdeService:String;Virtual;
56 Procedure SetDdeService(Const Value:String);Virtual;
57 Function GetDdeTopic:String;Virtual;
58 Procedure SetDdeTopic(Const Value:String);Virtual;
59 Procedure SetConnectMode(NewValue:TDataMode);Virtual;
60 Procedure RemoveItem(Item:TDdeClientItem);Virtual;
61 Procedure InsertItem(Item:TDdeClientItem);Virtual;
62 Function GetItem(Index:LongInt):TDdeClientItem;Virtual;
63 Function GetItemCount:LongInt;Virtual;
64 Procedure WaitForServer;Virtual;
65 Protected
66 Procedure SetupComponent;Override;
67 Function CreateDdeConv(Const AppName,TopicName:String):Boolean;Virtual;
68 Public
69 Destructor Destroy;Override;
70 Function PasteLink:Boolean;Virtual;
71 Function OpenLink:Boolean;Virtual;
72 Function SetLink(Const Service,topic:String):Boolean;Virtual;
73 Procedure CloseLink;Virtual;
74 Function StartAdvise(Item:String):Boolean;Virtual;
75 Function StopAdvise(Item:String):Boolean;Virtual;
76 Function PokeDataLines(Const Item:String;Data:TStrings):Boolean;Virtual;
77 Function PokeData(Const Item:String;Data:PChar):Boolean;Virtual;
78 Function ExecuteMacro(cmd: PChar;waitFlg:Boolean):Boolean;Virtual;
79 Function ExecuteMacroLines(cmd:TStrings;waitFlg:Boolean):Boolean;Virtual;
80 Function RequestData(Const Item:String):PChar;Virtual;
81 Public
82 Property ItemCount:LongInt Read GetItemCount;
83 Property Items[Index:LongInt]:TDdeClientItem Read GetItem;
84 Property Form:TForm Read FForm;
85 Property Connected:Boolean Read FConnected;
86 Published
87 Property DdeService:String Read GetDdeService Write SetDdeService;
88 Property DdeTopic:String Read GetDdeTopic Write SetDdeTopic;
89 Property ConnectMode:TDataMode Read FConnectMode Write SetConnectMode;
90 Property TimeOut:LongWord Read FTimeOut Write FTimeOut;
91 Property OnClose:TNotifyEvent Read FOnClose Write FOnClose;
92 Property OnOpen:TNotifyEvent Read FOnOpen Write FOnOpen;
93 Property OnTimeOut:TNotifyEvent Read FOnTimeOut Write FOnTimeOut;
94 End;
95
96 TDdeClientItem=Class(TComponent)
97 Private
98 FLines: TStrings;
99 FDdeClientItem:^String;
100 FForm:TForm;
101 FClientConv:TDdeClientConv;
102 FOnChange: TNotifyEvent;
103 {$IFDEF WIN32}
104 FDdeData:LongWord;
105 FConv:LongWord;
106 {$ENDIF}
107 Function GetText:String;Virtual;
108 Function GetDdeClientItem:String;Virtual;
109 Procedure SetDdeClientItem(Const NewValue:String);Virtual;
110 Procedure SetDdeClientConv(SConv:TDdeClientConv);Virtual;
111 Procedure SetText(Const Item:String);Virtual;
112 Procedure SetLines(Value:TStrings);Virtual;
113 Procedure ValueChanged;Virtual;
114 Procedure OnAdvise(Text:PChar);Virtual;
115 Protected
116 Procedure SetupComponent;Override;
117 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
118 Public
119 Destructor Destroy;Override;
120 Function Advise:Boolean;Virtual;
121 Function Unadvise:Boolean;Virtual;
122 Function Request:Boolean;Virtual;
123 Function Poke:Boolean;Virtual;
124 Property Form:TForm Read FForm;
125 Published
126 Property Text:String Read GetText Write SetText;
127 Property Lines: TStrings Read FLines Write SetLines;
128 Property DdeConv: TDdeClientConv Read FClientConv Write SetDdeClientConV;
129 Property DdeItem:String Read GetDdeClientItem Write SetDdeClientItem;
130 Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
131 End;
132
133 TDdeServerConv=Class(TComponent)
134 Private
135 FItems:TList;
136 FForm:TForm;
137 FOnExecuteMacro:TExecuteMacro;
138 FOnOpen:TNotifyEvent;
139 FOnClose:TNotifyEvent;
140 FDdeTopic:PString;
141 {$IFDEF WIN32}
142 FDdeData:LongWord;
143 FConv:LongWord;
144 {$ENDIF}
145 Procedure InsertItem(Item:TDdeServerItem);Virtual;
146 Procedure RemoveItem(Item:TDdeServerItem);Virtual;
147 Function GetItemCount:LongInt;Virtual;
148 Function GetItem(Index:LongInt):TDdeServerItem;Virtual;
149 Function GetDdeTopic:String;Virtual;
150 Procedure SetDdeTopic(NewValue:String);Virtual;
151 Protected
152 Procedure SetupComponent;Override;
153 Public
154 Destructor Destroy;Override;
155 Procedure ExecuteMacro(macro:TStrings;Var Success:Boolean);Virtual;
156 Procedure Connect;Virtual;
157 Procedure Disconnect;Virtual;
158 Property ItemCount:LongInt Read GetItemCount;
159 Property Items[Index:LongInt]:TDdeServerItem Read GetItem;
160 Property Form:TForm Read FForm;
161 Published
162 Property OnExecuteMacro:TExecuteMacro Read FOnExecuteMacro Write FOnExeCuTeMAcro;
163 Property OnOpen:TNotifyEvent Read FOnOpen Write FOnOpen;
164 Property OnClose:TNotifyEvent Read FOnClose Write FOnClose;
165 Property DdeTopic:String Read GetDdeTopic Write SetDdeTopic;
166 End;
167
168 TDdeServerItem=Class(TComponent)
169 Private
170 FLines:TStrings;
171 FItem:^String;
172 FForm:TForm;
173 FServerConv:TDdeServerConv;
174 FAdviseMode:LongInt;
175 FAdviseModeSend:Boolean;
176 FOnChange:TNotifyEvent;
177 FOnPokeData:TNotifyEvent;
178 {$IFDEF WIN32}
179 FDdeData:LongWord;
180 FConv:LongWord;
181 {$ENDIF}
182 Procedure ValueChanged;Virtual;
183 Function GetItem:String;Virtual;
184 Procedure SetItem(NewValue:String);Virtual;
185 Function GetText:String;Virtual;
186 Procedure SetText(Const Item:String);Virtual;
187 Procedure SetLines(Value:TStrings);Virtual;
188 Procedure SetServerConv(SConv:TDdeServerConv);Virtual;
189 Protected
190 Procedure SetupComponent;Override;
191 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
192 Public
193 Destructor Destroy;Override;
194 Procedure Change;Virtual;
195 Property Form:TForm Read FForm;
196 Published
197 Property ServerConv:TDdeServerConv Read FServerConv Write SetServerConv;
198 Property DdeItem:String Read GetItem Write SetItem;
199 Property Text:String Read GetText Write SetText;
200 Property Lines:TStrings Read FLines Write SetLines;
201 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
202 Property OnPokeData:TNotifyEvent Read FOnPokeData Write FOnPokeData;
203 End;
204
205 TDdeMgr=Class(TComponent)
206 Private
207 FAppName:PString;
208 FClientConvs:TList;
209 FServerConvs:TList;
210 FServerItems:TList;
211 OWindows:TList;
212 FClients:TList;
213 {$IFDEF WIN32}
214 FDdeInstId:LongInt;
215 FHszApp:LongWord;
216 {$ENDIF}
217 Procedure PostDataChange(Const topic,Item:String);Virtual;
218 Procedure SetAppName(Const Name:String);Virtual;
219 Function GetAppName:String;Virtual;
220 Procedure ResetAppName;Virtual;
221 Function GetForm(Const topic:String):TForm;Virtual;
222 Function GetServerItem(Const topic:String;Form:TForm;
223 Var Conv:TDdeServerConv):TDdeServerItem;Virtual;
224 Function HasDDEServers(Form:TForm):Boolean;Virtual;
225 Procedure InsertServerConv(SConv: TDdeServerConv);Virtual;
226 Procedure RemoveServerConv(SConv: TDdeServerConv);Virtual;
227 Procedure InsertServerItem(Item:TDdeServerItem);Virtual;
228 Procedure RemoveServerItem(Item:TDdeServerItem);Virtual;
229 Procedure GetTopics(Topics:TStrings;Form:TForm);Virtual;
230 Procedure AddObjectWindow(OWindow:TControl);Virtual;
231 Procedure RemoveObjectWindow(OWindow:TControl);Virtual;
232 Function GetActiveDdeConnections:LongInt;Virtual;
233 Procedure AddClient(client:TDdeClientConv);Virtual;
234 Procedure RemoveClient(client:TDdeClientConv);Virtual;
235 Procedure OpenClientLinks(Form:TForm);Virtual;
236 Procedure CloseClientLinks(Form:TForm);Virtual;
237 Procedure CloseAllLinks;Virtual;
238 Protected
239 Procedure SetupComponent;Override;
240 Public
241 Destructor Destroy;Override;
242 Function GetExeName:String;Virtual;
243 {$IFDEF WIN32}
244 Property DdeInstId:LongInt Read FDdeInstId Write FDdeInstId;
245 {$ENDIF}
246 Property AppName:String Read GetAppName Write SetAppName;
247 Property ActiveDdeConnections:LongInt Read GetActiveDdeConnections;
248 End;
249
250Var
251 DDEMgr: TDdeMgr;
252
253
254Implementation
255
256{$IFDEF WIN32}
257Function GetControl(ddeSrv:TDdeServerConv;Form:TControl;Const ItemName:string):TDdeServerItem;
258Var
259 t:LongInt;
260 Ctrl:TComponent;
261Begin
262 Result:=Nil;
263 If Form=Nil Then
264 Begin
265 If ddeSrv.Owner Then
266 If ddeSrv.Owner is TForm Then Form:=TControl(ddeSrv.Owner);
267 If Form=Nil Then exit;
268 End;
269
270 For t:=0 To Form.ComponentCount-1 Do
271 Begin
272 Ctrl:=Form.Components[t];
273 If Ctrl Is TDdeServerItem Then
274 Begin
275 If ((Ctrl.Name=ItemName)Or(TDdeServerItem(Ctrl).DdeItem=ItemName)) Then
276 If TDdeServerItem(Ctrl).FServerConv=ddeSrv Then
277 Begin
278 Result := TDdeServerItem(Ctrl);
279 Exit;
280 End;
281 End;
282 If Ctrl Is TControl Then
283 Begin
284 Result:=GetControl(ddeSrv,TControl(Ctrl),ItemName);
285 if Result<>Nil Then exit;
286 End;
287 End; //for
288End;
289
290
291Function PokeData(ddeSrv:TDdeServerConv;Conv:HConv;hszTopic:HSZ;hszItem:HSZ;
292 Data:HDdeData;Fmt:Integer):LongInt;
293Var
294 Srvr:TDdeServerItem;
295 Buffer:CString[4096];
296 Len:LongWord;
297 pData:Pointer;
298Begin
299 Result := dde_FNotProcessed;
300 If Fmt <> CF_TEXT Then Exit;
301 Len:=DdeQueryString(ddeMgr.FDdeInstId,hszItem,Buffer,SizeOf(Buffer),CP_WINANSI);
302 Buffer[Len]:=#0;
303 Srvr:=GetControl(ddeSrv,ddeSrv.FForm,Buffer);
304 If Srvr<>Nil Then
305 Begin
306 pData:=DdeAccessData(Data,Len);
307 If pData<>Nil Then
308 Begin
309 Srvr.Lines.SetText(PChar(pData));
310 DdeUnaccessData(Data);
311 Srvr.ValueChanged;
312 if Assigned(Srvr.FOnPokeData) then Srvr.FOnPokeData(Srvr);
313 Result := dde_FAck;
314 End;
315 End;
316End;
317
318Function RequestData(ddeSrv:TDdeServerConv;Conv:HConv;hszTopic:HSZ;hszItem :HSZ;
319 Fmt:Word):HDdeData;
320Var
321 Data: AnsiString;
322 Buffer:CString[4096];
323 Srvr:TDdeServerItem;
324 Len:LongInt;
325begin
326 Result:=0;
327 If Fmt <> CF_TEXT Then Exit;
328
329 Len:=DdeQueryString(ddeMgr.FDdeInstId,hszItem,Buffer,SizeOf(Buffer),CP_WINANSI);
330 Buffer[Len]:=#0;
331 Srvr:=GetControl(ddeSrv,ddeSrv.FForm,Buffer);
332 If Srvr<>Nil Then
333 Begin
334 Data := Srvr.Lines.Text;
335 Result := DdeCreateDataHandle(DdeMgr.FDdeInstId,PChar(Data),
336 Length(Data)+1,0,hszItem,Fmt,0);
337 End;
338End;
339
340Function ExecuteMacro(ddeSrv:TDdeServerConv;Conv:HConv;hszTopic:HSZ;Data:HDdeData):LongInt;
341var
342 Len:LongWord;
343 pData:Pointer;
344 MacroLines:TStringList;
345 Success:Boolean;
346begin
347 Result := dde_FNotProcessed;
348 pData:=DdeAccessData(Data,Len);
349 If pData<>Nil Then
350 Begin
351 If Assigned(ddeSrv.FOnExecuteMacro) Then
352 Begin
353 MacroLines := TStringList.Create;
354 MacroLines.SetText(PChar(pData));
355 ddeSrv.FOnExecuteMacro(ddeSrv,MacroLines,Success);
356 MacroLines.Destroy;
357 End;
358 Result := dde_FAck;
359 End;
360End;
361
362Function DdeMgrCallBack(CallType,Fmt:LongWord;Conv:HConv; hsz1, hsz2: HSZ;
363 Data:HDDEData;Data1,Data2:LongWord):HDDEData;ApiEntry;
364Var
365 ci: TConvInfo;
366 ddeCli: TComponent;
367 ddeSrv: TDdeServerConv;
368 ddeObj: TComponent;
369 xID: Integer;
370 Form:TForm;
371 Len:LongInt;
372 Topic:CString;
373 conns:Array[0..1] Of THSZPair;
374Begin
375 Result := 0;
376
377 Case CallType of
378 XTYP_CONNECT,XTYP_WILDCONNECT:
379 Begin
380 If ((hsz2=0)Or(DdeCmpStringHandles(hsz2,DdeMgr.FHszApp)=0)) Then
381 Begin
382 Len:=DdeQueryString(DdeMgr.FDdeInstId,hsz1,Topic,255,CP_WINANSI);
383 Topic[Len]:=#0;
384 DdeMgr.GetServerItem(Topic,Nil,ddeSrv);
385 If ddeSrv<>Nil Then Result:=1
386 Else
387 Begin
388 Form:=DdeMgr.GetForm(Topic);
389 If Form<>Nil Then Result:=1;
390 End;
391 End;
392
393 If CallType=XTYP_WILDCONNECT Then
394 If Result=1 Then
395 If hsz2<>0 Then
396 Begin
397 conns[0].hszSvc:=DdeMgr.FHszApp;
398 conns[0].hszTopic:=hsz2;
399 conns[1].hszSvc:=0;
400 conns[1].hszTopic:=0;
401 Result:=DdeCreateDataHandle(DdeMgr.FDdeInstId,conns,
402 2*sizeof(THSZPair),0,0,CF_TEXT,0);
403 End;
404 End;
405 XTYP_CONNECT_CONFIRM:
406 Begin
407 Len:=DdeQueryString(DdeMgr.FDdeInstId,hsz1,Topic,255,CP_WINANSI);
408 Topic[Len]:=#0;
409 DdeMgr.GetServerItem(Topic,Nil,ddeSrv);
410 If ddeSrv<>Nil Then
411 Begin
412 DdeSetUserHandle(Conv,QID_SYNC,LongWord(ddeSrv));
413 ddeSrv.Connect;
414 End
415 Else
416 Begin
417 //eventuell ein Zwischenobjekt generieren, für ddeSrv=Nil und Form<>Nil
418 Form:=DdeMgr.GetForm(Topic);
419 End;
420 End;
421 End;
422
423 If Conv <> 0 Then
424 Begin
425 ci.cb := sizeof(TConvInfo);
426 If CallType=XTYP_XACT_COMPLETE Then xID:=Data1
427 Else xID := QID_SYNC;
428
429 If DdeQueryConvInfo(Conv,xID,@ci)=0 Then Exit;
430 Case CallType Of
431 XTYP_ADVREQ,XTYP_REQUEST:
432 Begin
433 ddeSrv:=TDdeServerConv(ci.hUser);
434 Result:=RequestData(ddeSrv,Conv,hsz1,hsz2,Fmt);
435 End;
436 XTYP_ADVSTOP:
437 Begin
438 ddeSrv:=TDdeServerConv(ci.hUser);
439 //AdvStop(ddeSrv,Conv,hsz1,hsz2);
440 End;
441 XTYP_ADVSTART:
442 Begin
443 ddeSrv:=TDdeServerConv(ci.hUser);
444 //Result:=AdvStart(ddeSrv,Conv,hsz1,hsz2,Fmt);
445 End;
446 XTYP_POKE:
447 Begin
448 ddeSrv:=TDdeServerConv(ci.hUser);
449 Result:=PokeData(ddeSrv,Conv,hsz1,hsz2,Data,Fmt);
450 End;
451 XTYP_EXECUTE:
452 Begin
453 ddeSrv:=TDdeServerConv(ci.hUser);
454 Result:=ExecuteMacro(ddeSrv,Conv,hsz1,Data);
455 End;
456 XTYP_XACT_COMPLETE:
457 Begin
458 ddeCli:=TComponent(ci.hUser);
459 //If ddeCli<>Nil Then TDdeClientConv(ddeCli).XactComplete
460 End;
461 XTYP_ADVDATA:
462 Begin
463 ddeCli:=TComponent(ci.hUser);
464 //DataChange(TDdeClientConv(ddeCli),Data,hsz2);
465 End;
466 XTYP_DISCONNECT:
467 Begin
468 ddeObj:=TComponent(ci.hUser);
469 If ddeObj<>Nil Then
470 Begin
471 If ddeObj Is TDdeClientConv Then TDdeClientConv(ddeObj).CloseLink
472 Else If ddeObj Is TDdeServerConv Then TDdeServerConv(ddeObj).Disconnect;
473 DdeSetUserHandle(Conv,QID_SYNC,0);
474 End;
475 End;
476 End;
477 End;
478End;
479{$ENDIF}
480
481{$IFDEF OS2}
482Function AllocDdeStruc(Receiver:HWND;Const ItemName:String;
483 Status,format:LongWord;Data:Pointer;DataLen:LongWord):PDDESTRUCT;
484Var ddelen:LongWord;
485 apid:PID;
486 atid:TID;
487 C:Cstring;
488 P:Pointer;
489Begin
490 ddelen:=SizeOf(DDESTRUCT)+Length(ItemName)+1+DataLen;
491 DosAllocSharedMem(Result,Nil,ddelen,PAG_COMMIT Or PAG_READ Or PAG_WRITE Or OBJ_GIVEABLE);
492 WinQueryWindowProcess (Receiver,apid,atid);
493 DosGiveSharedMem (Result,apid,PAG_READ Or PAG_WRITE);
494 Result^.cbData:=ddelen;
495 Result^.fsStatus:=Status;
496 Result^.usFormat:=format;
497 Result^.offszItemName:=SizeOf(DDESTRUCT);
498 If DataLen>0 Then Result^.offabData:=SizeOf(DDESTRUCT)+Length(ItemName)+1
499 Else Result^.offabData:=0;
500 C:=ItemName;
501 P:=Pointer(Result);
502 Inc(P,SizeOf(DDESTRUCT));
503 Move(C,P^,Length(ItemName)+1);
504 Inc(P,Length(ItemName)+1);
505 If DataLen>0 Then Move(Data^,P^,DataLen);
506End;
507
508
509Type
510 TDdeObjectWindow=Class(TControl)
511 FDdeClient:HWND;
512 FDdeServer:HWND;
513 FDdeForm:HWND;
514 FDdeTopic:String;
515 FServerItem:TDdeServerItem;
516 FServerConv:TDdeServerConv;
517 FClientConv:TDdeClientConv;
518 FClientItem:TDdeClientItem;
519
520 Procedure CreateWnd;Override;
521 Procedure WMDDERequest(Var Msg:TMessage); Message WM_DDE_REQUEST;
522 Procedure WMDDETerminate(Var Msg:TMessage); Message WM_DDE_TERMINATE;
523 Procedure WMDDEExecute(Var Msg:TMessage); Message WM_DDE_EXECUTE;
524 Procedure WMDDEInitiateAck(Var Msg:TMessage); Message WM_DDE_INITIATEACK;
525 Procedure WMDDEData(Var Msg:TMessage); Message WM_DDE_DATA;
526 Procedure WMDDEAck(Var Msg:TMessage); Message WM_DDE_ACK;
527 Procedure WMDDEPoke(Var Msg:TMessage); Message WM_DDE_POKE;
528 Procedure WMDDEAdvise(Var Msg:TMessage); Message WM_DDE_ADVISE;
529 Procedure WMDDEUnadvise(Var Msg:TMessage); Message WM_DDE_UNADVISE;
530 Destructor Destroy;Override;
531 End;
532
533//Server receives Advise Of Items
534Procedure TDdeObjectWindow.WMDDEAdvise(Var Msg:TMessage);
535Var Data,RetData:PDDESTRUCT;
536 S:String;
537 ItemName:PChar;
538 Flags:LongWord;
539 ServerItem:TDdeServerItem;
540 T:LongInt;
541Label Fail,found;
542Begin
543 Flags:=DDE_FAPPSTATUS;
544
545 If Msg.Param2=0 Then //no Data
546 Begin
547 Msg.Handled:=True;
548 Msg.Result:=0;
549 Exit;
550 End;
551
552 Data:=Pointer(Msg.Param2);
553 ItemName:=Pointer(Data);
554 Inc(ItemName,Data^.offszItemName);
555
556 //look If we support the Item
557 S:=ItemName^;
558
559 //are we busy ??
560 If FDdeClient<>Msg.Param1 Then Goto Fail;
561
562 ServerItem:=FServerItem;
563
564 If ServerItem<>Nil Then
565 Begin
566found:
567 Inc(ServerItem.FAdviseMode);
568 ServerItem.FAdviseModeSend:=Data^.fsStatus And DDE_FACKREQ<>0;
569 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FACK,DDEFMT_TEXT,Nil,0);
570 End
571 Else If FServerConv<>Nil Then
572 Begin
573 //we directly Use A Server
574 //look If there Is A Server Item In the Server List which has the Item Set
575 For T:=0 To FServerConv.ItemCount-1 Do
576 Begin
577 ServerItem:=FServerConv.Items[T];
578 If ServerItem.DdeItem=S Then Goto found;
579 End;
580
581 Goto Fail; //Not found !
582 End
583 Else //failed !
584 Begin
585Fail:
586 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FAPPSTATUS,DDEFMT_TEXT,Nil,0);
587 End;
588
589 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_ACK,RetData^,DDEPM_RETRY);
590
591 If Data<>Nil Then DosFreeMem(Data);
592 Msg.Result:=0;
593 Msg.Handled:=True;
594End;
595
596//Server receives Unadvise Of Items
597Procedure TDdeObjectWindow.WMDDEUnadvise(Var Msg:TMessage);
598Var Data,RetData:PDDESTRUCT;
599 S:String;
600 ItemName:PChar;
601 Flags:LongWord;
602 ServerItem:TDdeServerItem;
603 T:LongInt;
604Label Fail,found;
605Begin
606 Flags:=DDE_FAPPSTATUS;
607
608 If Msg.Param2=0 Then //no Data
609 Begin
610 Msg.Handled:=True;
611 Msg.Result:=0;
612 Exit;
613 End;
614
615 Data:=Pointer(Msg.Param2);
616 ItemName:=Pointer(Data);
617 Inc(ItemName,Data^.offszItemName);
618
619 //look If we support the Item
620 S:=ItemName^;
621 //are we busy ??
622 If FDdeClient<>Msg.Param1 Then Goto Fail;
623
624 ServerItem:=FServerItem;
625
626 If ((ServerItem<>Nil)And(ServerItem.FAdviseMode>0)) Then
627 Begin
628found:
629 Dec(ServerItem.FAdviseMode);
630 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FACK,DDEFMT_TEXT,Nil,0);
631 End
632 Else If FServerConv<>Nil Then
633 Begin
634 //we directly Use A Server
635 //look If there Is A Server Item In the Server List which has the Item Set
636 For T:=0 To FServerConv.ItemCount-1 Do
637 Begin
638 ServerItem:=FServerConv.Items[T];
639 If ServerItem.DdeItem=S Then
640 If ServerItem.FAdviseMode>0 Then Goto found;
641 End;
642
643 Goto Fail; //Not found !
644 End
645 Else //failed !
646 Begin
647Fail:
648 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FAPPSTATUS,DDEFMT_TEXT,Nil,0);
649 End;
650
651 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_ACK,RetData^,DDEPM_RETRY);
652
653 If Data<>Nil Then DosFreeMem(Data);
654 Msg.Result:=0;
655 Msg.Handled:=True;
656End;
657
658//Server receives Data To be poked from client
659Procedure TDdeObjectWindow.WMDDEPoke(Var Msg:TMessage);
660Var Data,RetData:PDDESTRUCT;
661 S:String;
662 ItemName:PChar;
663 Flags:LongWord;
664 D:Pointer;
665 ServerItem:TDdeServerItem;
666 T:LongInt;
667Label Fail,found;
668Begin
669 Flags:=DDE_FAPPSTATUS;
670
671 If Msg.Param2=0 Then //no Data
672 Begin
673 Msg.Handled:=True;
674 Msg.Result:=0;
675 Exit;
676 End;
677
678 Data:=Pointer(Msg.Param2);
679 ItemName:=Pointer(Data);
680 Inc(ItemName,Data^.offszItemName);
681 D:=Pointer(Data);
682 Inc(D,Data^.offabData);
683
684 //look If we support the Item
685 S:=ItemName^;
686 //are we busy ??
687 If ((FDdeClient<>Msg.Param1)Or(Data^.usFormat<>DDEFMT_TEXT)) Then Goto Fail;
688
689 ServerItem:=FServerItem;
690
691 If ServerItem<>Nil Then
692 Begin
693found:
694 ServerItem.Lines.SetText(D);
695 If ServerItem.OnPokeData<>Nil Then ServerItem.OnPokeData(ServerItem);
696 ServerItem.Change;
697 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FACK,DDEFMT_TEXT,Nil,0);
698 End
699 Else If FServerConv<>Nil Then
700 Begin
701 //we directly Use A Server
702 //look If there Is A Server Item In the Server List which has the Item Set
703 For T:=0 To FServerConv.ItemCount-1 Do
704 Begin
705 ServerItem:=FServerConv.Items[T];
706 If ServerItem.DdeItem=S Then Goto found;
707 End;
708
709 Goto Fail; //Not found !
710 End
711 Else //failed !
712 Begin
713Fail:
714 RetData:=AllocDdeStruc(Msg.Param1,S,DDE_FAPPSTATUS,DDEFMT_TEXT,Nil,0);
715 End;
716
717 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_ACK,RetData^,DDEPM_RETRY);
718
719 If Data<>Nil Then DosFreeMem(Data);
720 Msg.Result:=0;
721 Msg.Handled:=True;
722End;
723
724//Server Or client acknowledges Data
725Procedure TDdeObjectWindow.WMDDEAck(Var Msg:TMessage);
726Var Data:PDDESTRUCT;
727Begin
728 Data:=Pointer(Msg.Param2);
729
730 If FClientConv<>Nil Then
731 Begin
732 FClientConv.FData:=Nil;
733 FClientConv.FDataLen:=0;
734 FClientConv.FOperationComplete:=True;
735 End;
736
737 If Data<>Nil Then DosFreeMem(Data);
738 Msg.Result:=0;
739 Msg.Handled:=True;
740End;
741
742//A Server sends Data ON clients Request
743Procedure TDdeObjectWindow.WMDDEData(Var Msg:TMessage);
744Var Data,RetData:PDDESTRUCT;
745 S:String;
746 ItemName:PChar;
747 Flags:LongWord;
748 D:Pointer;
749 ClientItem:TDdeClientItem;
750 T:LongInt;
751Begin
752 Flags:=DDE_FAPPSTATUS;
753
754 If Msg.Param2=0 Then //no Data
755 Begin
756 Msg.Handled:=True;
757 Msg.Result:=0;
758 If FClientConv<>Nil Then
759 Begin
760 FClientConv.FData:=Nil;
761 FClientConv.FDataLen:=0;
762 FClientConv.FOperationComplete:=True;
763 End;
764 Exit;
765 End;
766
767 Data:=Pointer(Msg.Param2);
768 ItemName:=Pointer(Data);
769 Inc(ItemName,Data^.offszItemName);
770 D:=Pointer(Data);
771 Inc(D,Data^.offabData);
772 If FClientConv<>Nil Then
773 Begin
774
775 FClientConv.FOperationComplete:=True;
776 FClientConv.FData:=Nil;
777 FClientConv.FDataLen:=0;
778 Flags:=DDE_FACK;
779
780 If Data^.fsStatus And DDE_FRESPONSE=0 Then //answer from Advise
781 Begin
782 If FClientConv.FItems<>Nil Then
783 For T:=0 To FClientConv.FItems.Count-1 Do
784 Begin
785 ClientItem:=FClientConv.FItems[T];
786 If ClientItem.DdeItem=ItemName^ Then ClientItem.OnAdvise(D);
787 End;
788 End
789 Else
790 Begin
791 If Data^.cbData=0 Then
792 Begin
793 FClientConv.FData:=Nil;
794 FClientConv.FDataLen:=0;
795 End
796 Else
797 Begin
798 GetMem(FClientConv.FData,Data^.cbData);
799 System.Move(D^,FClientConv.FData^,Data^.cbData);
800 FClientConv.FDataLen:=Data^.cbData;
801 End;
802 End;
803 End;
804
805 If Data^.fsStatus And DDE_FACKREQ<>0 Then
806 Begin
807 S:=ItemName^;
808 RetData:=AllocDdeStruc(Msg.Param1,S,Flags,DDEFMT_TEXT,Nil,0);
809 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_ACK,RetData^,DDEPM_RETRY);
810 End;
811
812 If Data<>Nil Then DosFreeMem(Data);
813 Msg.Result:=0;
814 Msg.Handled:=True;
815End;
816
817//A Server acknowledges the Connect Request Of A client
818Procedure TDdeObjectWindow.WMDDEInitiateAck(Var Msg:TMessage);
819Var Data:PDDEINIT;
820Label Fail;
821Begin
822 If Msg.Param2=0 Then //no Data
823 Begin
824 Msg.Handled:=True;
825 Msg.Result:=0;
826 If FClientConv<>Nil Then
827 Begin
828 FClientConv.FData:=Nil;
829 FClientConv.FDataLen:=0;
830 FClientConv.FOperationComplete:=True;
831 End;
832 Exit;
833 End;
834
835 Data:=Pointer(Msg.Param2);
836
837 If ((FClientConv<>Nil)And(Not FClientConv.connected)And(FClientConv.DdeService=Data^.pszAppNAme^)And
838 (FDdeTopic=Data^.pszTopic^)) Then
839 Begin
840 //acknowleded !!
841 FClientConv.FConnected:=True;
842 FDdeServer:=Msg.Param1;
843 FClientConv.FData:=Nil;
844 FClientConv.FDataLen:=0;
845 FClientConv.FOperationComplete:=True;
846 End
847 Else
848 Begin
849Fail:
850 WinDdePostMsg (Msg.Param1,Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY) ;
851 If FClientConv<>Nil Then
852 Begin
853 FClientConv.FData:=Nil;
854 FClientConv.FDataLen:=0;
855 FClientConv.FOperationComplete:=True;
856 End;
857 End;
858
859 If Data<>Nil Then DosFreeMem(Data);
860 Msg.Result:=0;
861 Msg.Handled:=True;
862End;
863
864//A Server Or A client terminates conversation
865Procedure TDdeObjectWindow.WMDDETerminate(Var Msg:TMessage);
866Begin
867 If Msg.Param1<>Handle Then //don't Terminate ourself !
868 Begin
869 WinDdePostMsg (Msg.Param1,Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY) ;
870 WinPostMsg(FDdeForm,WM_DDE_DESTROY,LongWord(Self),0);
871 End;
872
873 If FClientConv<>Nil Then
874 Begin
875 FClientConv.FData:=Nil;
876 FClientConv.FDataLen:=0;
877 FClientConv.FOperationComplete:=True;
878 End;
879
880 FDdeClient:=0;
881 FDdeServer:=0;
882 FDdeForm:=0;
883 FServerItem:=Nil;
884 FServerConv:=Nil;
885 FClientItem:=Nil;
886 Msg.Handled:=True;
887 Msg.Result:=0;
888End;
889
890Destructor TDdeObjectWindow.Destroy;
891Begin
892 If FClientConv<>Nil Then
893 Begin
894 FClientConv.FData:=Nil;
895 FClientConv.FDataLen:=0;
896 FClientConv.FObjectWindow:=Nil;
897 FClientConv.FOperationComplete:=True;
898 FClientConv.FConnected:=False;
899 If FClientConv.FOnClose<>Nil Then FClientConv.FOnClose(Self);
900 End
901 Else DDEMgr.RemoveObjectWindow(Self);
902
903 Inherited Destroy;
904End;
905
906//A client requests Info from A Server
907Procedure TDdeObjectWindow.WMDDERequest(Var Msg:TMessage);
908Var Data,ReturnData:PDDESTRUCT;
909 ItemName:PChar;
910 S:String;
911 P:PChar;
912 len:LongInt;
913 T:LongInt;
914 FLastSender:HWND;
915 FLastTopic:String;
916 ServerItem:TDdeServerItem;
917Label Fail,found;
918Begin
919 S:='';
920
921 FLastTopic:=FDdeTopic;
922 FLastSender:=FDdeClient;
923
924 Data:=Pointer(Msg.Param2);
925 If Data=Nil Then
926 Begin
927 Msg.Handled:=True;
928 Msg.Result:=0;
929 Exit;
930 End;
931
932 ItemName:=Pointer(Data);
933 Inc(ItemName,Data^.offszItemName);
934
935 //look If we support the Item
936 S:=ItemName^;
937 //are we busy ??
938 If FLastSender<>Msg.Param1 Then Goto Fail;
939
940 ServerItem:=FServerItem;
941
942 If ServerItem<>Nil Then
943 Begin
944found:
945 P:=ServerItem.Lines.GetText;
946 If P<>Nil Then len:=Length(P^)+1
947 Else len:=0;
948 ReturnData:=AllocDdeStruc(Msg.Param1,S,DDE_FRESPONSE,DDEFMT_TEXT,P,len);
949 StrDispose(P);
950 End
951 Else If FServerConv<>Nil Then
952 Begin
953 //we directly Use A Server
954 //look If there Is A Server Item In the Server List which has the Item Set
955 For T:=0 To FServerConv.ItemCount-1 Do
956 Begin
957 ServerItem:=FServerConv.Items[T];
958 If ServerItem.DdeItem=S Then Goto found;
959 End;
960
961 Goto Fail; //Not found !
962 End
963 Else //failed !
964 Begin
965Fail:
966 ReturnData:=AllocDdeStruc(Msg.Param1,S,DDE_NOTPROCESSED,DDEFMT_TEXT,Nil,0);
967 End;
968
969 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_DATA,ReturnData^,DDEPM_RETRY);
970
971 If Data<>Nil Then DosFreeMem(Data);
972 Msg.Result:=0;
973 Msg.Handled:=True;
974End;
975
976//A client wants To Execute A macro At the Server
977Procedure TDdeObjectWindow.WMDDEExecute(Var Msg:TMessage);
978Var Data,ReturnData:PDDESTRUCT;
979 ItemName:PChar;
980 S:String;
981 ServerConv:TDdeServerConv;
982 Success:Boolean;
983 Strings:TStringList;
984 cmd:PChar;
985 FLastSender:HWND;
986 FLastTopic:String;
987Label Fail;
988Begin
989 Data:=Pointer(Msg.Param2);
990 If Data=Nil Then
991 Begin
992 Msg.Handled:=True;
993 Msg.Result:=0;
994 Exit;
995 End;
996
997 FLastTopic:=FDdeTopic;
998 FLastSender:=FDdeClient;
999
1000 ItemName:=Pointer(Data);
1001 Inc(ItemName,Data^.offszItemName);
1002
1003 //look If we support the Item
1004 S:=ItemName^;
1005 //are we busy ??
1006 If ((FLastSender<>Msg.Param1)Or(Data^.usFormat<>DDEFMT_TEXT)) Then Goto FaiL;
1007
1008 ServerConv:=FServerConv;
1009
1010 If ServerConv<>Nil Then
1011 Begin
1012 Strings.Create;
1013 If Data^.cbData<>0 Then
1014 Begin
1015 cmd:=Pointer(Data);
1016 Inc(cmd,Data^.offabData);
1017 Strings.SetText(cmd);
1018 End;
1019 Success:=False;
1020 ServerConv.ExecuteMacro(Strings,Success);
1021 Strings.Destroy;
1022 If Not Success Then Goto Fail;
1023 ReturnData:=AllocDdeStruc(Msg.Param1,'',DDE_FACK,DDEFMT_TEXT,Nil,0);
1024 End
1025 Else
1026 Begin
1027Fail:
1028 ReturnData:=AllocDdeStruc(Msg.Param1,'',DDE_FAPPSTATUS,DDEFMT_TEXT,Nil,0);
1029 End;
1030 WinDdePostMsg(Msg.Param1,Handle,WM_DDE_ACK,ReturnData^,DDEPM_RETRY);
1031 If Data<>Nil Then DosFreeMem(Data);
1032 Msg.Result:=0;
1033 Msg.Handled:=True;
1034End;
1035
1036Procedure TDdeObjectWindow.CreateWnd;
1037Var ClassData:TClassData;
1038 FHandle:HWND;
1039Begin
1040 GetClassData(ClassData);
1041 FHandle:=WinCreateWindow(HWND_OBJECT, //Parent
1042 ClassData.ClassName,
1043 '', //Caption
1044 WS_DISABLED, //flStyle
1045 0,0,
1046 0,0, //Position And Size
1047 HWND_OBJECT, //Owner
1048 HWND_BOTTOM, //Insert behind
1049 WindowId,
1050 Nil, //CtlData
1051 Nil); //Presparams
1052
1053 SetControlHandle(Self,FHandle);
1054 If FHandle=0 Then CreateError;
1055
1056 WinSetWindowULong(FHandle,QWL_USER,LongWord(Self)); {VMT Pointer}
1057 SetDefWndProc(Self,Pointer(WinSubClassWindow(FHandle,@SubclassedWndProc)));
1058End;
1059{$ENDIF}
1060
1061{
1062ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1063º º
1064º Speed-Pascal/2 Version 2.0 º
1065º º
1066º Speed-Pascal Component Classes (SPCC) º
1067º º
1068º This section: TDdeMgr Class Implementation º
1069º º
1070º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1071º º
1072ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1073}
1074
1075Procedure TDdeMgr.PostDataChange(Const topic,Item:String);
1076
1077Var T:LongInt;
1078 {$IFDEF OS2}
1079 OWindow:TDdeObjectWindow;
1080 P:PChar;
1081 len:LongWord;
1082 ServerItem:TDdeServerItem;
1083 ReturnData:PDDESTRUCT;
1084 {$ENDIF}
1085Begin
1086 {$IFDEF OS2}
1087 If OWindows<>Nil Then For T:=0 To OWindows.Count-1 Do
1088 Begin
1089 OWindow:=OWindows[T];
1090 If OWindow.FDdeTopic=topic Then If OWindow.FDdeClient<>0 Then
1091 If ((OWindow.FServerConv<>Nil)Or(OWindow.FServerItem<>Nil)) Then
1092 Begin
1093 ServerItem:=Nil;
1094 If OWindow.FServerItem<>Nil Then ServerItem:=OWindow.FServerItem
1095 Else
1096 Begin
1097 For T:=0 To OWindow.FServerConv.ItemCount-1 Do
1098 Begin
1099 ServerItem:=OWindow.FServerConv.Items[T];
1100 If ServerItem.DdeItem=Item Then break;
1101 End;
1102 End;
1103
1104 If ((ServerItem<>Nil)And(ServerItem.FAdviseMode>0)And(ServerItem.DdeITem=Item)) Then
1105 Begin
1106 {$IFDEF OS2}
1107 If ServerItem.FAdviseModeSend Then
1108 Begin
1109 P:=ServerItem.Lines.GetText;
1110
1111 If P<>Nil Then len:=Length(P^)+1
1112 Else len:=0;
1113 ReturnData:=AllocDdeStruc(OWindow.FDdeClient,Item,DDE_FAcKREq,
1114 DDEFMT_TEXT,P,len);
1115 StrDispose(P);
1116 End
1117 Else
1118 Begin
1119 ReturnData:=AllocDdeStruc(OWindow.FDdeClient,Item,DDE_NOtPROcESSED,DDEFmt_TEXT,
1120 Nil,0)
1121 End;
1122 WinDdePostMsg(OWindow.FDdeClient,OWindow.Handle,WM_DDE_DATA,RetuRnData^,DDEPm_RETRY);
1123 {$ENDIF}
1124 End;
1125 End;
1126 End;
1127 {$ENDIF}
1128End;
1129
1130Procedure TDdeMgr.SetAppName(Const Name:String);
1131Var D,N,E:String;
1132Begin
1133 ResetAppName;
1134 FSplit(Name,D,N,E);
1135 If N<>'' Then
1136 Begin
1137 GetMem(FAppName,Length(N)+1);
1138 FAppName^:=N;
1139 {$IFDEF WIN32}
1140 FHszApp:=DdeCreateStringHandle(FDdeInstId,FAppName^,CP_WINANSI);
1141 DdeNameService(FDdeInstId,FHszApp,0,DNS_REGISTER);
1142 {$ENDIF}
1143 End;
1144End;
1145
1146Function TDdeMgr.GetAppName:String;
1147Begin
1148 If FAppName<>Nil Then Result:=FAppName^
1149 Else Result:='';
1150End;
1151
1152Procedure TDdeMgr.ResetAppName;
1153Begin
1154 If FAppName<>Nil Then FreeMem(FAppName,Length(FAppName^)+1);
1155 FAppName:=Nil;
1156 {$IFDEF WIN32}
1157 If FHszApp<>0 Then
1158 Begin
1159 DdeNameService(FDdeInstId,FHszApp,0,DNS_UNREGISTER);
1160 DdeFreeStringHandle(FDdeInstId,FHszApp);
1161 End;
1162 {$ENDIF}
1163End;
1164
1165Function TDdeMgr.GetForm(Const topic:String):TForm;
1166Var T:LongInt;
1167 Server:TDdeServerConv;
1168Begin
1169 If FServerConvs<>Nil Then For T:=0 To FServerConvs.Count-1 Do
1170 Begin
1171 Server:=FServerConvs[T];
1172 If ((Server.Name=topic)Or(Server.DdeTopic=topic)) Then
1173 Begin
1174 Result:=Server.Form; // we cannot determine the Item here
1175 Exit;
1176 End;
1177 End;
1178End;
1179
1180Function TDdeMgr.GetServerItem(Const topic:String;Form:TForm;Var Conv:TDdeServerConv):TDdeServeRitem;
1181Var T:LongInt;
1182 Server:TDdeServerConv;
1183Begin
1184 //Items that have A Server
1185 If FServerConvs<>Nil Then For T:=0 To FServerConvs.Count-1 Do
1186 Begin
1187 Server:=FServerConvs[T];
1188 If Server.Form=Form Then
1189 If ((Server.Name=topic)Or(Server.DdeTopic=topic)) Then
1190 Begin
1191 Conv:=Server;
1192 Result:=Nil; // we cannot determine the Item here
1193 Exit;
1194 End;
1195 End;
1196
1197 //Items without A Server
1198 If FServerItems<>Nil Then For T:=0 To FServerItems.Count-1 Do
1199 Begin
1200 Result:=FServerItems[T];
1201 If Result.Form=Form Then
1202 Begin
1203 If Result.Form.Caption=topic Then
1204 Begin
1205 Conv:=Result.ServerConv; //should be Nil
1206 Exit;
1207 End;
1208 End;
1209 End;
1210
1211 Conv:=Nil;
1212 Result:=Nil;
1213End;
1214
1215Procedure TDdeMgr.InsertServerConv(SConv: TDdeServerConv);
1216Begin
1217 If FServerConvs=Nil Then FServerConvs.Create;
1218 FServerConvs.Add(SConv);
1219End;
1220
1221Procedure TDdeMgr.RemoveServerConv(SConv: TDdeServerConv);
1222Begin
1223 Try
1224 FServerConvs.Remove(SConv);
1225 Except
1226 End;
1227End;
1228
1229Procedure TDdeMgr.InsertServerItem(Item:TDdeServerItem);
1230Begin
1231 If FServerItems=Nil Then FServerItems.Create;
1232 FServerItems.Add(Item);
1233End;
1234
1235Procedure TDdeMgr.RemoveServerItem(Item:TDdeServerItem);
1236Begin
1237 Try
1238 FServerItems.Remove(Item);
1239 Except
1240 End;
1241End;
1242
1243Procedure TDdeMgr.SetupComponent;
1244Begin
1245 Inherited SetupComponent;
1246 {$IFDEF WIN32}
1247 FDdeInstId:=0;
1248 DdeInitialize(FDdeInstId,@DdeMgrCallBack,APPCLASS_STANDARD,0);
1249 {$ENDIF}
1250
1251 Name:='DDEMgr';
1252 AppName:=GetExeName;
1253End;
1254
1255Destructor TDdeMgr.Destroy;
1256Begin
1257 If FServerConvs<>Nil Then FServerConvs.Destroy;
1258 FServerConvs:=Nil;
1259 If FClientConvs<>Nil Then FClientConvs.Destroy;
1260 FClientConvs:=Nil;
1261 If FServerItems<>Nil Then FServerItems.Destroy;
1262 FServerItems:=Nil;
1263 If OWindows<>Nil Then OWindows.Destroy;
1264 OWindows:=Nil;
1265 If FClients<>Nil Then FClients.Destroy;
1266 FClients:=Nil;
1267 ResetAppName;
1268 {$IFDEF WIN32}
1269 DdeUnInitialize(FDdeInstId);
1270 {$ENDIF}
1271
1272 Inherited Destroy;
1273End;
1274
1275Function TDdeMgr.GetExeName:String;
1276Begin
1277 Result:=ParamStr(0);
1278 UpcaseStr(Result);
1279End;
1280
1281Procedure TDdeMgr.GetTopics(Topics:TStrings;Form:TForm);
1282Var T:LongInt;
1283 Server:TDdeServerConv;
1284 Item:TDdeServerItem;
1285Begin
1286 Topics.Clear;
1287
1288 //Items that have A Server
1289 If FServerConvs<>Nil Then For T:=0 To FServerConvs.Count-1 Do
1290 Begin
1291 //process Items Topics
1292 Server:=FServerConvs[T];
1293 If Server.Form=Form Then Topics.Add(Server.DdeTopic);
1294 End;
1295
1296 //Items that have no Server
1297 If FServerItems<>Nil Then For T:=0 To FServerItems.Count-1 Do
1298 Begin
1299 Item:=FServerItems[T];
1300 If Item.Form=Form Then Topics.Add(Item.Form.Caption);
1301 End;
1302End;
1303
1304Function TDdeMgr.HasDDEServers(Form:TForm):Boolean;
1305Var T,t1:LongInt;
1306 Server:TDdeServerConv;
1307 Item:TDdeServerItem;
1308Begin
1309 Result:=False;
1310
1311 //Items that have A Server
1312 If FServerConvs<>Nil Then For T:=0 To FServerConvs.Count-1 Do
1313 Begin
1314 //process Items Topics
1315 Server:=FServerConvs[T];
1316 If Server.Form=Form Then
1317 Begin
1318 Result:=True;
1319 Exit;
1320 End;
1321
1322 For t1:=0 To Server.ItemCount-1 Do
1323 Begin
1324 Item:=Server.Items[t1];
1325 If Item.Form=Form Then
1326 Begin
1327 Result:=True;
1328 Exit;
1329 End;
1330 End;
1331 End;
1332
1333 //Items that have no Server
1334 If FServerItems<>Nil Then For T:=0 To FServerItems.Count-1 Do
1335 Begin
1336 Item:=FServerItems[T];
1337 If Item.Form=Form Then
1338 Begin
1339 Result:=True;
1340 Exit;
1341 End;
1342 End;
1343End;
1344
1345Procedure TDdeMgr.AddObjectWindow(OWindow:TControl);
1346Begin
1347 If OWindows=Nil Then OWindows.Create;
1348 OWindows.Add(OWindow);
1349End;
1350
1351Procedure TDdeMgr.RemoveObjectWindow(OWindow:TControl);
1352Begin
1353 Try
1354 OWindows.Remove(OWindow);
1355 Except
1356 End;
1357End;
1358
1359Function TDdeMgr.GetActiveDdeConnections:LongInt;
1360Begin
1361 If OWindows=Nil Then Result:=0
1362 Else Result:=OWindows.Count;
1363End;
1364
1365Procedure TDdeMgr.AddClient(client:TDdeClientConv);
1366Begin
1367 If FClients=Nil Then FClients.Create;
1368 FClients.Add(client);
1369End;
1370
1371Procedure TDdeMgr.RemoveClient(client:TDdeClientConv);
1372Begin
1373 Try
1374 FClients.Remove(client);
1375 Except
1376 End;
1377End;
1378
1379Procedure TDdeMgr.OpenClientLinks(Form:TForm);
1380Var T:LongInt;
1381 client:TDdeClientConv;
1382Begin
1383 If FClients=Nil Then Exit;
1384 For T:=0 To FClients.Count-1 Do
1385 Begin
1386 client:=FClients[T];
1387 If client.Form=Form Then
1388 If client.ConnectMode=ddeAutomatic Then client.OpenLink;
1389 End;
1390End;
1391
1392Procedure TDdeMgr.CloseClientLinks(Form:TForm);
1393Var T:LongInt;
1394 client:TDdeClientConv;
1395Begin
1396 If FClients=Nil Then Exit;
1397 For T:=0 To FClients.Count-1 Do
1398 Begin
1399 client:=FClients[T];
1400 If client.Form=Form Then client.CloseLink;
1401 End;
1402End;
1403
1404Procedure TDdeMgr.CloseAllLinks;
1405Var T:LongInt;
1406 client:TDdeClientConv;
1407{$IFDEF OS2}
1408 OWindow:TDdeObjectWindow;
1409{$ENDIF}
1410Begin
1411 If FClients=Nil Then Exit;
1412 For T:=0 To FClients.Count-1 Do
1413 Begin
1414 client:=FClients[T];
1415 //don't allow To call event handlers because the Form might be destroyed already...
1416 client.OnClose:=Nil;
1417 client.OnTimeOut:=Nil;
1418 client.CloseLink;
1419 End;
1420
1421 {$IFDEF OS2}
1422 If OWindows<>Nil Then For T:=0 To OWindows.Count-1 Do
1423 Begin
1424 OWindow:=OWindows[T];
1425 If OWindow.FDdeClient<>0 Then
1426 Begin
1427 //don't allow To call event handlers because the Form might be destroyed already...
1428 If OWindow.FServerConv<>Nil Then OWindow.FServerConv.OnClose:=Nil;
1429
1430 {$IFDEF OS2}
1431 WinDdePostMsg(OWindow.FDdeClient,OWindow.Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY);
1432 {$ENDIF}
1433 OWindow.FDdeClient:=0;
1434 End;
1435 End;
1436 {$ENDIF}
1437End;
1438
1439
1440{
1441ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1442º º
1443º Speed-Pascal/2 Version 2.0 º
1444º º
1445º Speed-Pascal Component Classes (SPCC) º
1446º º
1447º This section: TDdeServerConv Class Implementation º
1448º º
1449º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1450º º
1451ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1452}
1453
1454Procedure TDdeServerConv.SetupComponent;
1455Var TheOwner:TComponent;
1456Begin
1457 Inherited SetupComponent;
1458
1459 TheOwner:=Owner;
1460 While TheOwner<>Nil Do
1461 Begin
1462 If TheOwner Is TForm Then
1463 Begin
1464 FForm:=TForm(TheOwner);
1465 break;
1466 End;
1467
1468 TheOwner:=TheOwner.Owner;
1469 End;
1470
1471 Name:='DdeServerConv';
1472 DDEMgr.InsertServerConv(Self);
1473 Include(ComponentState, csHandleLinks);
1474End;
1475
1476Destructor TDdeServerConv.Destroy;
1477{$IFDEF OS2}
1478Var T:LongInt;
1479 OWindow:TDdeObjectWindow;
1480{$ENDIF}
1481Begin
1482 {$IFDEF OS2}
1483 Try
1484 If DDEMgr.OWindows<>Nil Then For T:=0 To DDEMgr.OWindows.Count-1 Do
1485 Begin
1486 OWindow:=DDEMgr.OWindows[T];
1487 If OWindow.FServerConv=Self Then If OWindow.FDdeClient<>0 Then
1488 Begin
1489 {$IFDEF OS2}
1490 WinDdePostMsg(OWindow.FDdeClient,OWindow.Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY);
1491 {$ENDIF}
1492 OWindow.FDdeClient:=0;
1493 End;
1494 End;
1495 Except
1496 End;
1497
1498 Inherited Destroy;
1499
1500 DDEMgr.RemoveServerConv(Self);
1501 If FItems<>Nil Then FItems.Destroy;
1502 FItems:=Nil;
1503 If FDdeTopic<>Nil Then FreeMem(FDdeTopic,Length(FDdeTopic^)+1);
1504 FDdeTopic:=Nil;
1505 {$ENDIF}
1506End;
1507
1508Function TDdeServerConv.GetItemCount:LongInt;
1509Begin
1510 If FItems<>Nil Then Result:=FItems.Count
1511 Else Result:=0;
1512End;
1513
1514Function TDdeServerConv.GetItem(Index:LongInt):TDdeServerItem;
1515Begin
1516 If ((Index>=0)And(FItems<>Nil)And(Index<FItems.Count)) Then Result:=FItems[Index]
1517 Else Result:=Nil;
1518End;
1519
1520Procedure TDdeServerConv.InsertItem(Item:TDdeServerItem);
1521Begin
1522 If FItems=Nil Then FItems.Create;
1523 FItems.Add(Item);
1524End;
1525
1526Procedure TDdeServerConv.RemoveItem(Item:TDdeServerItem);
1527Begin
1528 Try
1529 FItems.Remove(Item);
1530 Except
1531 End;
1532End;
1533
1534Procedure TDdeServerConv.ExecuteMacro(macro:TStrings;Var Success:Boolean);
1535Begin
1536 If FOnExecuteMacro<>Nil Then FOnExecuteMacro(Self,macro,Success);
1537End;
1538
1539Procedure TDdeServerConv.Connect;
1540Begin
1541 If FOnOpen<>Nil Then FOnOpen(Self);
1542End;
1543
1544Procedure TDdeServerConv.Disconnect;
1545Begin
1546 If FOnClose<>Nil Then FOnClose(Self);
1547End;
1548
1549Function TDdeServerConv.GetDdeTopic:String;
1550Begin
1551 If FDdeTopic=Nil Then Result:=Name
1552 Else Result:=FDdeTopic^;
1553End;
1554
1555Procedure TDdeServerConv.SetDdeTopic(NewValue:String);
1556Begin
1557 If FDdeTopic<>Nil Then FreeMem(FDdeTopic,Length(FDdeTopic^)+1);
1558 FDdeTopic:=Nil;
1559 If NewValue<>'' Then
1560 Begin
1561 GetMem(FDdeTopic,Length(NewValue)+1);
1562 FDdeTopic^:=NewValue;
1563 End;
1564End;
1565
1566{
1567ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1568º º
1569º Speed-Pascal/2 Version 2.0 º
1570º º
1571º Speed-Pascal Component Classes (SPCC) º
1572º º
1573º This section: TDdeServerItem Class Implementation º
1574º º
1575º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1576º º
1577ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1578}
1579
1580Procedure TDdeServerItem.ValueChanged;
1581Var topic:String;
1582Begin
1583 If FOnChange<>Nil Then FOnChange(Self);
1584
1585 If ServerConv<>Nil Then
1586 Begin
1587 topic:=ServerConv.DdeTopic;
1588 If topic='' Then topic:=ServerConv.Name
1589 End
1590 Else topic:=Form.Caption;
1591 If FAdviseMode>0 Then DDEMgr.PostDataChange(topic,DdeItem)
1592End;
1593
1594Function TDdeServerItem.GetText:String;
1595Begin
1596 If FLines.Count>0 Then Result:=FLines.Strings[0]
1597 Else Result:='';
1598End;
1599
1600Procedure TDdeServerItem.SetText(Const Item:String);
1601Begin
1602 FLines.Clear;
1603 FLines.Add(Item);
1604 ValueChanged;
1605End;
1606
1607Procedure TDdeServerItem.SetLines(Value:TStrings);
1608Begin
1609 If FLines.Equals(Value) Then Exit; //Nothing To Do
1610 FLines.Assign(Value);
1611 ValueChanged;
1612End;
1613
1614//If no topic Is Set, the Name Of the Server (If present) Or the Name
1615//Of the Form containing the TDdeServerItem Is used As topic
1616Function TDdeServerItem.GetItem:String;
1617Begin
1618 If FItem=Nil Then Result:=''
1619 Else Result:=FItem^;
1620End;
1621
1622Procedure TDdeServerItem.SetItem(NewValue:String);
1623Begin
1624 If FItem<>Nil Then FreeMem(FItem,Length(FItem^)+1);
1625 GetMem(FItem,Length(NewValue)+1);
1626 FItem^:=NewValue;
1627End;
1628
1629//If no Server Is specified, the DDEServerItem Is entered into the
1630//Items List Of the DDE Manager
1631Procedure TDdeServerItem.SetServerConv(SConv:TDdeServerConv);
1632Begin
1633 If FServerConv<>Nil Then
1634 Begin
1635 FServerConv.RemoveItem(Self);
1636 FServerConv.Notification(Self,opRemove);
1637 End;
1638 FServerConv := SConv;
1639 If FServerConv <> Nil Then
1640 Begin
1641 FServerConv.FreeNotification(Self);
1642 FServerConv.InsertItem(Self);
1643 End;
1644End;
1645
1646Procedure TDdeServerItem.Notification(AComponent:TComponent;Operation:TOperation);
1647Begin
1648 Inherited Notification(AComponent,Operation);
1649
1650 If Operation = opRemove Then
1651 If AComponent = FServerConv Then FServerConv := Nil;
1652End;
1653
1654
1655Procedure TDdeServerItem.SetupComponent;
1656Var TheOwner:TComponent;
1657Begin
1658 Inherited SetupComponent;
1659
1660 Name:='DdeServerItem';
1661 TheOwner:=Owner;
1662 While TheOwner<>Nil Do
1663 Begin
1664 If TheOwner Is TForm Then
1665 Begin
1666 FForm:=TForm(TheOwner);
1667 break;
1668 End;
1669
1670 TheOwner:=TheOwner.Owner;
1671 End;
1672 If FForm=Nil Then FForm:=Application.MainForm;
1673
1674 FLines:=TStringList.Create;
1675
1676 If Owner Is TDdeServerConv Then ServerConv:=TDdeServerConv(Owner) //we have A Server !
1677 Else DDEMgr.InsertServerItem(Self); //we have no Server yet !
1678End;
1679
1680Destructor TDdeServerItem.Destroy;
1681{$IFDEF OS2}
1682Var T:LongInt;
1683 OWindow:TDdeObjectWindow;
1684{$ENDIF}
1685Begin
1686 {$IFDEF OS2}
1687 Try
1688 If DDEMgr.OWindows<>Nil Then For T:=0 To DDEMgr.OWindows.Count-1 Do
1689 Begin
1690 OWindow:=DDEMgr.OWindows[T];
1691 If OWindow.FClientItem=Self Then If OWindow.FDdeClient<>0 Then
1692 Begin
1693 {$IFDEF OS2}
1694 WinDdePostMsg(OWindow.FDdeClient,OWindow.Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY);
1695 {$ENDIF}
1696 OWindow.FDdeClient:=0;
1697 End;
1698 End;
1699 ServerConv:=Nil; //Free Link
1700 Except
1701 End;
1702 FLines.Destroy;
1703 FLines:=Nil;
1704 If FItem<>Nil Then FreeMem(FItem,Length(FItem^)+1);
1705 FItem:=Nil;
1706
1707 Inherited Destroy;
1708 {$ENDIF}
1709End;
1710
1711Procedure TDdeServerItem.Change;
1712Begin
1713 If FOnChange<>Nil Then FOnChange(Self);
1714End;
1715
1716
1717{
1718ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1719º º
1720º Speed-Pascal/2 Version 2.0 º
1721º º
1722º Speed-Pascal Component Classes (SPCC) º
1723º º
1724º This section: TDdeClientConv Class Implementation º
1725º º
1726º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1727º º
1728ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1729}
1730
1731Function TDdeClientConv.GetDdeService:String;
1732Begin
1733 If FDdeService=Nil Then Result:=''
1734 Else Result:=FDdeService^;
1735End;
1736
1737Procedure TDdeClientConv.SetDdeService(Const Value:String);
1738Begin
1739 If FDdeService<>Nil Then FreeMem(FDdeService,Length(FDdeService^)+1);
1740 GetMem(FDdeService,Length(Value)+1);
1741 FDdeService^:=Value;
1742End;
1743
1744Function TDdeClientConv.GetDdeTopic:String;
1745Begin
1746 If FDdeTopic=Nil Then Result:=''
1747 Else Result:=FDdeTopic^;
1748End;
1749
1750Procedure TDdeClientConv.SetDdeTopic(Const Value:String);
1751Begin
1752 If FDdeTopic<>Nil Then FreeMem(FDdeTopic,Length(FDdeTopic^)+1);
1753 GetMem(FDdeTopic,Length(Value)+1);
1754 FDdeTopic^:=Value;
1755End;
1756
1757Procedure TDdeClientConv.SetConnectMode(NewValue:TDataMode);
1758Begin
1759 If NewValue=FConnectMode Then Exit;
1760
1761 FConnectMode:=NewValue;
1762 If ComponentState*[csReading]=[] Then
1763 Begin
1764 If FConnectMode=ddeManual Then CloseLink
1765 Else OpenLink;
1766 End;
1767End;
1768
1769
1770{$HINTS OFF}
1771Function TDdeClientConv.CreateDdeConv(Const AppName,TopicName:String):Boolean;
1772Begin
1773 Result:=False; {DDE noch rein}
1774End;
1775{$HINTS ON}
1776
1777Procedure TDdeClientConv.SetupComponent;
1778Var TheOwner:TComponent;
1779Begin
1780 Inherited SetupComponent;
1781
1782 Name:='DdeClientConv';
1783 FConnectMode:=ddeAutomatic;
1784 TheOwner:=Owner;
1785 While TheOwner<>Nil Do
1786 Begin
1787 If TheOwner Is TForm Then
1788 Begin
1789 FForm:=TForm(TheOwner);
1790 break;
1791 End;
1792
1793 TheOwner:=TheOwner.Owner;
1794 End;
1795 If FForm=Nil Then FForm:=Application.MainForm;
1796
1797 If FForm=Nil Then FForm:=Application.MainForm;
1798 Include(ComponentState, csHandleLinks);
1799 FTimeOut:=200;
1800 DDEMgr.AddClient(Self);
1801End;
1802
1803Destructor TDdeClientConv.Destroy;
1804Begin
1805 CloseLink;
1806 DDEMgr.RemoveClient(Self);
1807
1808 Inherited Destroy;
1809
1810 If FDdeService<>Nil Then FreeMem(FDdeService,Length(FDdeService^)+1);
1811 FDdeService:=Nil;
1812 If FDdeTopic<>Nil Then FreeMem(FDdeTopic,Length(FDdeTopic^)+1);
1813 FDdeTopic:=Nil;
1814 If FItems<>Nil Then FItems.Destroy;
1815 FItems:=Nil;
1816 If FObjectWindow<>Nil Then FObjectWindow.Destroy;
1817 FObjectWindow:=Nil;
1818End;
1819
1820Function TDdeClientConv.PasteLink:Boolean;
1821Begin
1822 Result:=False;
1823End;
1824
1825Function TDdeClientConv.OpenLink:Boolean;
1826Begin
1827 If FConnected Then Exit;
1828 FConnected:=SetLink(DdeService,DdeTopic);
1829 If FConnected Then If FOnOpen<>Nil Then FOnOpen(Self);
1830 Result:=FConnected;
1831End;
1832
1833Procedure TDdeClientConv.WaitForServer;
1834{$IFDEF OS2}
1835Var Queue:QMSG;
1836 TOut:LongWord;
1837{$ENDIF}
1838Begin
1839 {$IFDEF OS2}
1840 TOut:=0;
1841 While True Do
1842 Begin
1843 If WinPeekMsg(AppHandle,Queue,0,0,0,PM_REMOVE) Then
1844 WinDispatchMsg(AppHandle,Queue);
1845
1846 If FOperationComplete Then break;
1847 Inc(TOut);
1848 If TOut>TimeOut Then //Time out !
1849 Begin
1850 If OnTimeOut<>Nil Then OnTimeOut(Self);
1851 FData:=Nil;
1852 FDataLen:=0;
1853 break;
1854 //FOperationComplete:=True;
1855 End;
1856 End;
1857 {$ENDIF}
1858End;
1859
1860Function TDdeClientConv.SetLink(Const Service,topic:String):Boolean;
1861{$IFDEF OS2}
1862Var cctxt:CONVCONTEXT;
1863 App,Top:Cstring;
1864{$ENDIF}
1865Begin
1866 {$IFDEF OS2}
1867 If FConnected Then
1868 Begin
1869 Result:=True;
1870 Exit;
1871 End;
1872 If ((Service='')Or(topic='')) Then
1873 Begin
1874 Result:=False;
1875 Exit;
1876 End;
1877 If FObjectWindow<>Nil Then FObjectWindow.Destroy;
1878 FObjectWindow:=TDdeObjectWindow.Create(Nil);
1879 TDdeObjectWindow(FObjectWindow).CreateWnd;
1880 TDdeObjectWindow(FObjectWindow).FDdeTopic:=topic;
1881 TDdeObjectWindow(FObjectWindow).FClientConv:=Self;
1882 TDdeObjectWindow(FObjectWindow).FDdeForm:=Form.Handle;
1883
1884 FillChar(cctxt,SizeOf(CONVCONTEXT),0);
1885 cctxt.cb:=SizeOf(CONVCONTEXT) ;
1886 cctxt.fsContext:=DDECTXT_CASESENSITIVE;
1887 App:=Service;
1888 Top:=topic;
1889 FOperationComplete:=False;
1890 FData:=Nil;
1891 WinDdeInitiate (FObjectWindow.Handle,App,Top,cctxt);
1892 WaitForServer;
1893 {$ENDIF}
1894
1895 Result:=FConnected;
1896End;
1897
1898Procedure TDdeClientConv.CloseLink;
1899Begin
1900 If Not FConnected Then Exit;
1901 If FObjectWindow=Nil Then
1902 Begin
1903 FConnected:=False;
1904 If FOnClose<>Nil Then FOnClose(Self);
1905 exit;
1906 End;
1907 {$IFDEF OS2}
1908 FOperationComplete:=False;
1909 FData:=Nil;
1910 WinDdePostMsg(TDdeObjectWindow(FObjectWindow).FDdeServer,
1911 FObjectWindow.Handle,WM_DDE_TERMINATE,Nil,DDEPM_RETRY);
1912 WaitForServer;
1913 {$ENDIF}
1914 FConnected:=False;
1915 If FOnClose<>Nil Then FOnClose(Self);
1916End;
1917
1918Function TDdeClientConv.StartAdvise(Item:String):Boolean;
1919{$IFDEF OS2}
1920Var SData:PDDESTRUCT;
1921{$ENDIF}
1922Begin
1923 If Not FConnected Then Exit;
1924 {$IFDEF OS2}
1925 FOperationComplete:=False;
1926 SData:=AllocDdeStruc(TDdeObjectWindow(FObjectWindow).FDdeServer,Item,
1927 DDE_FACKREQ,DDEFMT_TEXT,Nil,0);
1928 WinDdePostMsg(TDdeObjectWindow(FObjectWindow).FDdeServer,FObjectWindow.Handle,
1929 WM_DDE_ADVISE,SData^,DDEPM_RETRY);
1930 WaitForServer;
1931 {$ENDIF}
1932 Result:=FOperationComplete;
1933End;
1934
1935Function TDdeClientConv.StopAdvise(Item:String):Boolean;
1936{$IFDEF OS2}
1937Var SData:PDDESTRUCT;
1938{$ENDIF}
1939Begin
1940 If Not FConnected Then Exit;
1941 {$IFDEF OS2}
1942 FOperationComplete:=False;
1943 SData:=AllocDdeStruc(TDdeObjectWindow(FObjectWindow).FDdeServer,Item,
1944 0,DDEFMT_TEXT,Nil,0);
1945 WinDdePostMsg(TDdeObjectWindow(FObjectWindow).FDdeServer,FObjectWindow.Handle,
1946 WM_DDE_UNADVISE,SData^,DDEPM_RETRY);
1947 WaitForServer;
1948 {$ENDIF}
1949 Result:=FOperationComplete;
1950End;
1951
1952Function TDdeClientConv.PokeDataLines(Const Item: String; Data: TStrings):Boolean;
1953Var P:PChar;
1954Begin
1955 P:=Data.GetText;
1956 Result:=PokeData(Item,P);
1957 StrDispose(P);
1958End;
1959
1960Function TDdeClientConv.PokeData(Const Item:String;Data:PChar):Boolean;
1961{$IFDEF OS2}
1962Var SData:PDDESTRUCT;
1963{$ENDIF}
1964Begin
1965 If ((Data=Nil)Or(Not FConnected)) Then Exit; //Nothing To Poke
1966 {$IFDEF OS2}
1967 FOperationComplete:=False;
1968 SData:=AllocDdeStruc(TDdeObjectWindow(FObjectWindow).FDdeServer,Item,
1969 0,DDEFMT_TEXT,Data,Length(Data^)+1);
1970 WinDdePostMsg(TDdeObjectWindow(FObjectWindow).FDdeServer,FObjectWindow.Handle,
1971 WM_DDE_POKE,SData^,DDEPM_RETRY);
1972 WaitForServer;
1973 {$ENDIF}
1974 Result:=FOperationComplete;
1975End;
1976
1977Function TDdeClientConv.ExecuteMacro(cmd:PChar;waitFlg:Boolean):Boolean;
1978{$IFDEF OS2}
1979Var SData:PDDESTRUCT;
1980{$ENDIF}
1981Begin
1982 Result:=False;
1983 If Not FConnected Then Exit;
1984 {$IFDEF OS2}
1985 FOperationComplete:=False;
1986 SData:=AllocDdeStruc(TDdeObjectWindow(FObjectWindow).FDdeServer,'',
1987 0,DDEFMT_TEXT,cmd,Length(cmd^)+1);
1988 WinDdePostMsg(TDdeObjectWindow(FObjectWindow).FDdeServer,FObjectWindow.Handle,
1989 WM_DDE_EXECUTE,SData^,DDEPM_RETRY);
1990 If waitFlg Then WaitForServer;
1991 {$ENDIF}
1992 Result:=True;
1993End;
1994
1995Function TDdeClientConv.ExecuteMacroLines(cmd:TStrings;waitFlg:Boolean):Boolean;
1996Var P:PChar;
1997Begin
1998 P:=cmd.GetText;
1999 Result:=ExecuteMacro(P,waitFlg);
2000 StrDispose(P);
2001End;
2002
2003Function TDdeClientConv.RequestData(Const Item:String):PChar;
2004{$IFDEF OS2}
2005Var pdde:PDDESTRUCT;
2006{$ENDIF}
2007Begin
2008 Result:=Nil;
2009 If Not FConnected Then Exit;
2010 {$IFDEF OS2}
2011 FData:=Nil;
2012 FOperationComplete:=False;
2013 pdde:=AllocDdeStruc(TDdeObjectWindow(FObjectWindow).FDdeServer,Item,
2014 0,DDEFMT_TEXT,Nil,0);
2015 WinDdePostMsg (TDdeObjectWindow(FObjectWindow).FDdeServer,FObjectWindow.Handle,
2016 WM_DDE_REQUEST,pdde^,DDEPM_RETRY) ;
2017 WaitForServer;
2018 Result:=FData;
2019 {$ENDIF}
2020End;
2021
2022Procedure TDdeClientConv.RemoveItem(Item:TDdeClientItem);
2023Begin
2024 Try
2025 FItems.Remove(Item);
2026 Except
2027 End;
2028End;
2029
2030Procedure TDdeClientConv.InsertItem(Item:TDdeClientItem);
2031Begin
2032 If FItems=Nil Then FItems.Create;
2033 FItems.Add(Item);
2034End;
2035
2036Function TDdeClientConv.GetItem(Index:LongInt):TDdeClientItem;
2037Begin
2038 If ((FItems=Nil)Or(Index<0)Or(Index>=FItems.Count)) Then Result:=Nil
2039 Else Result:=FItems[Index];
2040End;
2041
2042Function TDdeClientConv.GetItemCount:LongInt;
2043Begin
2044 If FItems=Nil Then Result:=0
2045 Else Result:=FItems.Count;
2046End;
2047
2048
2049{
2050ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2051º º
2052º Speed-Pascal/2 Version 2.0 º
2053º º
2054º Speed-Pascal Component Classes (SPCC) º
2055º º
2056º This section: TDdeClientItem Class Implementation º
2057º º
2058º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2059º º
2060ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2061}
2062
2063Function TDdeClientItem.Advise:Boolean;
2064Begin
2065 Result:=False;
2066 If DdeConv<>Nil Then
2067 If DdeConv.FConnected Then Result:=DdeConv.StartAdvise(DdeItem);
2068End;
2069
2070Function TDdeClientItem.Unadvise:Boolean;
2071Begin
2072 Result:=False;
2073 If DdeConv<>Nil Then
2074 If DdeConv.FConnected Then Result:=DdeConv.StopAdvise(DdeItem);
2075End;
2076
2077Function TDdeClientItem.Request:Boolean;
2078Begin
2079 Result:=False;
2080 If DdeConv<>Nil Then
2081 If DdeConv.FConnected Then
2082 Begin
2083 FLines.SetText(DdeConv.RequestData(DdeItem));
2084 ValueChanged;
2085 Result:=True;
2086 End;
2087End;
2088
2089Function TDdeClientItem.Poke:Boolean;
2090Var P:PChar;
2091Begin
2092 Result:=False;
2093 If DdeConv<>Nil Then
2094 If DdeConv.FConnected Then
2095 Begin
2096 P:=FLines.GetText;
2097 Result:=DdeConv.PokeData(DdeItem,P);
2098 StrDispose(P);
2099 End;
2100End;
2101
2102Function TDdeClientItem.GetText:String;
2103Begin
2104 If FLines.Count>0 Then Result:=FLines.Strings[0]
2105 Else Result:='';
2106End;
2107
2108Procedure TDdeClientItem.SetText(Const Item:String);
2109Begin
2110 FLines.Clear;
2111 FLines.Add(Item);
2112End;
2113
2114Function TDdeClientItem.GetDdeClientItem:String;
2115Begin
2116 If FDdeClientItem=Nil Then Result:=''
2117 Else Result:=FDdeClientItem^;
2118End;
2119
2120Procedure TDdeClientItem.SetDdeClientItem(Const NewValue:String);
2121Begin
2122 If FDdeClientItem<>Nil Then FreeMem(FDdeClientItem,Length(FDdeClientItem^)+1);
2123 GetMem(FDdeClientItem,Length(NewValue)+1);
2124 FDdeClientItem^:=NewValue;
2125End;
2126
2127Procedure TDdeClientItem.SetDdeClientConv(SConv:TDdeClientConv);
2128Begin
2129 If FClientConv<>Nil Then
2130 Begin
2131 FClientConv.RemoveItem(Self);
2132 FClientConv.Notification(Self,opRemove);
2133 End;
2134 FClientConv := SConv;
2135 If FClientConv <> Nil Then
2136 Begin
2137 FClientConv.FreeNotification(Self);
2138 FClientConv.InsertItem(Self);
2139 End;
2140End;
2141
2142Procedure TDdeClientItem.Notification(AComponent:TComponent;Operation:TOperation);
2143Begin
2144 Inherited Notification(AComponent,Operation);
2145
2146 If Operation = opRemove Then
2147 If AComponent = FClientConv Then FClientConv := Nil;
2148End;
2149
2150
2151Procedure TDdeClientItem.SetLines(Value:TStrings);
2152Begin
2153 If FLines.Equals(Value) Then Exit; //Nothing To Do
2154 FLines.Assign(Value);
2155End;
2156
2157Procedure TDdeClientItem.OnAdvise(Text:PChar);
2158Var List:TStringList;
2159Begin
2160 List.Create;
2161 List.SetText(Text);
2162 SetLines(List);
2163 ValueChanged;
2164 List.Destroy;
2165End;
2166
2167Procedure TDdeClientItem.SetupComponent;
2168Var TheOwner:TComponent;
2169Begin
2170 Inherited SetupComponent;
2171
2172 Name:='DdeClientItem';
2173 FLines:=TStringList.Create;
2174 TheOwner:=Owner;
2175 While TheOwner<>Nil Do
2176 Begin
2177 If TheOwner Is TForm Then
2178 Begin
2179 FForm:=TForm(TheOwner);
2180 break;
2181 End;
2182
2183 TheOwner:=TheOwner.Owner;
2184 End;
2185 If FForm=Nil Then FForm:=Application.MainForm;
2186End;
2187
2188Destructor TDdeClientItem.Destroy;
2189Begin
2190 Try
2191 DdeConv:=Nil;
2192 Except
2193 End;
2194 FLines.Destroy;
2195 FLines:=Nil;
2196
2197 Inherited Destroy;
2198End;
2199
2200Procedure TDdeClientItem.ValueChanged;
2201Begin
2202 If FOnChange<>Nil Then FOnChange(Self);
2203End;
2204
2205Procedure DdeMan_WMDdeDestroy(Var Msg:TMessage);
2206{$IFDEF OS2}
2207Var OWindow:TDdeObjectWindow;
2208{$ENDIF}
2209Begin
2210 {$IFDEF OS2}
2211 OWindow:=Pointer(Msg.Param1);
2212 Try
2213 OWindow.Destroy;
2214 Except
2215 End;
2216 {$ENDIF}
2217 Msg.Handled:=True;
2218 Msg.Result:=0;
2219End;
2220
2221Procedure DdeMan_WMDdeInitiate(Self:TForm;Var Msg:TMessage);
2222{$IFDEF OS2}
2223Var Data:PDDEINIT;
2224 Sender:HWND;
2225 Server,topic:Cstring;
2226 Top:String;
2227 cContext:CONVCONTEXT;
2228 Topics:TStringList;
2229 T:LongInt;
2230 ServerItem:TDdeServerItem;
2231 ServerConv:TDdeServerConv;
2232 ObjectWindow:TDdeObjectWindow;
2233{$ENDIF}
2234Begin
2235 If DDEMgr=Nil Then exit;
2236
2237 {$IFDEF OS2}
2238 Sender:=Msg.Param1;
2239 Data:=Pointer(Msg.Param2);
2240 If ((Data^.pszAppName^='')Or //any Application can resond - So we Do !
2241 (Data^.pszAppName^=DDEMgr.AppName)) Then //This Is our Id !
2242 Begin
2243 FillChar(cContext,SizeOf(CONVCONTEXT),0);
2244 cContext.cb:=SizeOf(CONVCONTEXT);
2245 cContext.fsContext:=DDECTXT_CASESENSITIVE; //All conversations are Case sensitive
2246
2247 Top:=Data^.pszTopic^;
2248
2249 If Top='' Then //All supported Topics For This Form
2250 Begin
2251 Topics.Create;
2252
2253 DDEMgr.GetTopics(Topics,Self);
2254
2255 For T:=0 To Topics.Count-1 Do
2256 Begin
2257 Top:=Topics[T];
2258
2259 ObjectWindow.Create(Nil);
2260 ObjectWindow.CreateWnd;
2261 ObjectWindow.FDdeClient:=Sender;
2262 ObjectWindow.FDdeForm:=Self.Handle;
2263 ObjectWindow.FDdeTopic:=Top;
2264 ObjectWindow.FServerItem:=DDEMgr.GetServerItem(Top,Self,ObjectWindow.FServerCOnv);
2265
2266 DDEMgr.AddObjectWindow(ObjectWindow);
2267
2268 Server:=DDEMgr.AppName;
2269 topic:=Topics[T];
2270 WinDdeRespond(Sender,ObjectWindow.Handle,Server,topic,cContext);
2271 End;
2272
2273 Topics.Destroy;
2274 End
2275 Else If Data^.pszAppName^=DDEMgr.AppName Then //specific topic
2276 Begin
2277 ServerItem:=DDEMgr.GetServerItem(Top,Self,ServerConv);
2278 If ((ServerItem<>Nil)Or(ServerConv<>Nil)) Then
2279 Begin
2280 If DDEMgr.HasDDEServers(Self) Then
2281 Begin
2282 ObjectWindow.Create(Nil);
2283 ObjectWindow.CreateWnd;
2284 ObjectWindow.FDdeClient:=Sender;
2285 ObjectWindow.FDdeForm:=Self.Handle;
2286 ObjectWindow.FDdeTopic:=Top;
2287 ObjectWindow.FServerItem:=ServerItem;
2288 ObjectWindow.FServerConv:=ServerConv;
2289
2290 DDEMgr.AddObjectWindow(ObjectWindow);
2291
2292 Server:=DDEMgr.AppName;
2293 topic:=Top;
2294 WinDdeRespond(Sender,ObjectWindow.Handle,Server,topic,cContext);
2295 End;
2296 End;
2297 End;
2298 End;
2299 {$ENDIF}
2300
2301 Msg.Handled:=True;
2302 Msg.Result:=1;
2303End;
2304
2305Procedure DdeMan_OpenClientLinks(Form:TForm);
2306Begin
2307 DdeMgr.OpenClientLinks(Form);
2308End;
2309
2310Procedure DdeMan_CloseClientLinks(Form:TForm);
2311Begin
2312 DdeMgr.CloseClientLinks(Form);
2313End;
2314
2315Procedure DdeMan_CloseAllLinks;
2316Begin
2317 DdeMgr.CloseAllLinks;
2318End;
2319
2320Begin
2321 DDEMgr.Create(Nil);
2322 Asm
2323 MOV EAX,@DDEMan_WMDdeDestroy
2324 MOV FORMS.DDEMan_WMDdeDestroy,EAX
2325 MOV EAX,@DdeMan_WMDdeInitiate
2326 MOV FORMS.DdeMan_WMDdeInitiate,EAX
2327 MOV EAX,@DdeMan_OpenClientLinks
2328 MOV FORMS.DdeMan_OpenClientLinks,EAX
2329 MOV EAX,@DdeMan_CloseClientLinks
2330 MOV FORMS.DdeMan_CloseClientLinks,EAX
2331 MOV EAX,@DdeMan_CloseAllLinks
2332 MOV FORMS.DdeMan_CloseAllLinks,EAX
2333 End;
2334End.
Note: See TracBrowser for help on using the repository browser.