home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / DDEMAN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  46KB  |  1,793 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DdeMan;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Classes, Graphics, Forms, Controls, DDEML, StdCtrls;
  18.  
  19. type
  20.   TDataMode = (ddeAutomatic, ddeManual);
  21.   TDdeServerConv = class;
  22.  
  23.   TMacroEvent = procedure(Sender: TObject; Msg: TStrings) of object;
  24.  
  25.   TDdeClientItem = class;
  26.  
  27. { TDdeClientConv }
  28.  
  29.   TDdeClientConv = class(TComponent)
  30.   private
  31.     FDdeService: string;
  32.     FDdeTopic: string;
  33.     FConv: HConv;
  34.     FCnvInfo: TConvInfo;
  35.     FItems: TList;
  36.     FHszApp: HSZ;
  37.     FHszTopic: HSZ;
  38.     FDdeFmt: Integer;
  39.     FOnClose: TNotifyEvent;
  40.     FOnOpen: TNotifyEvent;
  41.     FAppName: string;
  42.     FDataMode: TDataMode;
  43.     FConnectMode: TDataMode;
  44.     FWaitStat: Boolean;
  45.     FFormatChars: Boolean;
  46.     procedure SetDdeService(const Value: string);
  47.     procedure SetDdeTopic(const Value: string);
  48.     procedure SetService(const Value: string);
  49.     procedure SetTopic(const Value: string);
  50.     procedure SetConnectMode(NewMode: TDataMode);
  51.     procedure SetFormatChars(NewFmt: Boolean);
  52.     procedure XactComplete;
  53.     procedure SrvrDisconnect;
  54.     procedure DataChange(DdeDat: HDDEData; hszIt: HSZ);
  55.   protected
  56.     function CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
  57.     function GetCliItemByName(const ItemName: string): TPersistent;
  58.     function GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
  59.     procedure Loaded; override;
  60.     procedure DefineProperties(Filer: TFiler); override;
  61.     procedure ReadLinkInfo(Reader: TReader);
  62.     procedure WriteLinkInfo(Writer: TWriter);
  63.     function OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
  64.     procedure OnAttach(aCtrl: TDdeClientItem);
  65.     procedure OnDetach(aCtrl: TDdeClientItem);
  66.     procedure Close; dynamic;
  67.     procedure Open; dynamic;
  68.     function ChangeLink(const App, Topic, Item: string): Boolean;
  69.     procedure ClearItems;
  70.     procedure Notification(AComponent: TComponent;
  71.       Operation: TOperation); override;
  72.   public
  73.     constructor Create(AOwner: TComponent); override;
  74.     destructor Destroy; override;
  75.     function PasteLink: Boolean;
  76.     function OpenLink: Boolean;
  77.     function SetLink(const Service, Topic: string): Boolean;
  78.     procedure CloseLink;
  79.     function StartAdvise: Boolean;
  80.     function PokeDataLines(const Item: string; Data: TStrings): Boolean;
  81.     function PokeData(const Item: string; Data: PChar): Boolean;
  82.     function ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
  83.     function ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
  84.     function RequestData(const Item: string): PChar;
  85.     property DdeFmt: Integer read FDdeFmt;
  86.     property WaitStat: Boolean read FWaitStat;
  87.     property Conv: HConv read FConv;
  88.     property DataMode: TDataMode read FDataMode write FDataMode;
  89.   published
  90.     property ServiceApplication: string read FAppName write FAppName;
  91.     property DdeService: string read FDdeService write SetDdeService;
  92.     property DdeTopic: string read FDdeTopic write SetDdeTopic;
  93.     property ConnectMode: TDataMode read FConnectMode write SetConnectMode default ddeAutomatic;
  94.     property FormatChars: Boolean read FFormatChars write SetFormatChars default False;
  95.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  96.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  97.   end;
  98.  
  99. { TDdeClientItem }
  100.  
  101.   TDdeClientItem = class(TComponent)
  102.   private
  103.     FLines: TStrings;
  104.     FDdeClientConv: TDdeClientConv;
  105.     FDdeClientItem: string;
  106.     FOnChange: TNotifyEvent;
  107.     function GetText: string;
  108.     procedure SetDdeClientItem(const Val: string);
  109.     procedure SetDdeClientConv(Val: TDdeClientConv);
  110.     procedure SetText(const S: string);
  111.     procedure SetLines(L: TStrings);
  112.     procedure OnAdvise;
  113.   protected
  114.     procedure Notification(AComponent: TComponent;
  115.       Operation: TOperation); override;
  116.   public
  117.     constructor Create(AOwner: TComponent); override;
  118.     destructor Destroy; override;
  119.   published
  120.     property Text: string read GetText write SetText;
  121.     property Lines: TStrings read FLines write SetLines;
  122.     property DdeConv: TDdeClientConv read FDdeClientConv write SetDdeClientConv;
  123.     property DdeItem: string read FDdeClientItem write SetDdeClientItem;
  124.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  125.   end;
  126.  
  127. { TDdeServerConv }
  128.  
  129.   TDdeServerConv = class(TComponent)
  130.   private
  131.     FOnOpen: TNotifyEvent;
  132.     FOnClose: TNotifyEvent;
  133.     FOnExecuteMacro: TMacroEvent;
  134.   protected
  135.     procedure Connect; dynamic;
  136.     procedure Disconnect; dynamic;
  137.   public
  138.     constructor Create(AOwner: TComponent); override;
  139.     destructor Destroy; override;
  140.     function ExecuteMacro(Data: HDdeData): LongInt;
  141.   published
  142.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  143.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  144.     property OnExecuteMacro: TMacroEvent read FOnExecuteMacro write FOnExecuteMacro;
  145.   end;
  146.  
  147. { TDdeServerItem }
  148.  
  149.   TDdeServerItem = class(TComponent)
  150.   private
  151.     FLines: TStrings;
  152.     FServerConv: TDdeServerConv;
  153.     FOnChange: TNotifyEvent;
  154.     FOnPokeData: TNotifyEvent;
  155.     FFmt: Integer;
  156.     procedure ValueChanged;
  157.   protected
  158.     function GetText: string;
  159.     procedure SetText(const Item: string);
  160.     procedure SetLines(Value: TStrings);
  161.     procedure SetServerConv(SConv: TDdeServerConv);
  162.     procedure Notification(AComponent: TComponent;
  163.       Operation: TOperation); override;
  164.   public
  165.     constructor Create(AOwner: TComponent); override;
  166.     destructor Destroy; override;
  167.     function PokeData(Data: HDdeData): LongInt;
  168.     procedure CopyToClipboard;
  169.     procedure Change; dynamic;
  170.     property Fmt: Integer read FFmt;
  171.   published
  172.     property ServerConv: TDdeServerConv read FServerConv write SetServerConv;
  173.     property Text: string read GetText write SetText;
  174.     property Lines: TStrings read FLines write SetLines;
  175.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  176.     property OnPokeData: TNotifyEvent read FOnPokeData write FOnPokeData;
  177.   end;
  178.  
  179. { TDdeMgr }
  180.  
  181.   TDdeMgr = class(TComponent)
  182.   private
  183.     FAppName: string;
  184.     FHszApp: HSZ;
  185.     FConvs: TList;
  186.     FCliConvs: TList;
  187.     FConvCtrls: TList;
  188.     FDdeInstId: Longint;
  189.     FLinkClipFmt: Word;
  190.     procedure Disconnect(DdeSrvrConv: TComponent);
  191.     function GetSrvrConv(const Topic: string ): TComponent;
  192.     function AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
  193.     function AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
  194.     function Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
  195.     procedure PostDataChange(const Topic: string; Item: string);
  196.     procedure SetAppName(const Name: string);
  197.     procedure ResetAppName;
  198.     function  GetServerConv(const Topic: string): TDdeServerConv;
  199.     procedure InsertServerConv(SConv: TDdeServerConv);
  200.     procedure RemoveServerConv(SConv: TDdeServerConv);
  201.     procedure DoError;
  202.     function  GetForm(const Topic: string): TForm;
  203.   public
  204.     constructor Create(AOwner: TComponent); override;
  205.     destructor Destroy; override;
  206.     function GetExeName: string;     // obsolete
  207.     property DdeInstId: LongInt read FDdeInstId write FDdeInstId;
  208.     property AppName: string read FAppName write SetAppName;
  209.     property LinkClipFmt: Word read FLinkClipFmt;
  210.   end;
  211.  
  212.   function GetPasteLinkInfo(var Service: string; var Topic: string;
  213.     var Item: string): Boolean;
  214. var
  215.   ddeMgr: TDdeMgr;
  216.  
  217. implementation
  218.  
  219. uses SysUtils, Dialogs, Consts, Clipbrd;
  220.  
  221. type
  222.   EDdeError = class(Exception);
  223.   TDdeSrvrConv = class;
  224.  
  225. { TDdeSrvrItem }
  226.  
  227.   TDdeSrvrItem = class(TComponent)
  228.   private
  229.     FConv: TDdeSrvrConv;
  230.     FItem: string;
  231.     FHszItem: HSZ;
  232.     FSrvr: TDdeServerItem;
  233.   protected
  234.     procedure SetItem(const Value: string);
  235.   public
  236.     constructor Create(AOwner: TComponent); override;
  237.     destructor Destroy; override;
  238.     function RequestData(Fmt: Word): HDdeData;
  239.     procedure PostDataChange;
  240.     property Conv: TDdeSrvrConv read FConv write FConv;
  241.     property Item: string read FItem write SetItem;
  242.     property Srvr: TDdeServerItem read FSrvr write FSrvr;
  243.     property HszItem: HSZ read FHszItem;
  244.   end;
  245.  
  246. { TDdeSrvrConv }
  247.  
  248.   TDdeSrvrConv = class(TComponent)
  249.   private
  250.     FTopic: string;
  251.     FHszTopic: HSZ;
  252.     FForm: TForm;
  253.     FSConv: TDdeServerConv;
  254.     FConv: HConv;
  255.     FCnvInfo: TConvInfo;
  256.     FDdeFmt: Integer;
  257.     FItems: TList;
  258.   protected
  259.     function GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
  260.     function GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
  261.   public
  262.     constructor Create(AOwner: TComponent); override;
  263.     destructor Destroy; override;
  264.     function RequestData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  265.       Fmt: Word): HDdeData;
  266.     function AdvStart(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  267.       Fmt: Word): Boolean;
  268.     procedure AdvStop(Conv: HConv; hszTopic: HSZ; hszItem: HSZ);
  269.     function PokeData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ; Data: HDdeData;
  270.       Fmt: Integer): LongInt;
  271.     function ExecuteMacro(Conv: HConv; hszTopic: HSZ; Data: HDdeData): Integer;
  272.     function GetItem(const ItemName: string): TDdeSrvrItem;
  273.     property Conv: HConv read FConv;
  274.     property Form: TForm read FForm;
  275.     property SConv: TDdeServerConv read FSConv;
  276.     property Topic: string read FTopic write FTopic;
  277.     property HszTopic: HSZ read FHszTopic;
  278.   end;
  279.  
  280. { TDdeCliItem }
  281.  
  282.   TDdeCliItem = class(TPersistent)
  283.   protected
  284.     FItem: string;
  285.     FHszItem: HSZ;
  286.     FCliConv: TDdeClientConv;
  287.     FCtrl: TDdeClientItem;
  288.     function StartAdvise: Boolean;
  289.     function StopAdvise: Boolean;
  290.     procedure StoreData(DdeDat: HDDEData);
  291.     procedure DataChange;
  292.     function AccessData(DdeDat: HDDEData; pDataLen: PDWORD): Pointer;
  293.     procedure ReleaseData(DdeDat: HDDEData);
  294.   public
  295.     constructor Create(ADS: TDdeClientConv);
  296.     destructor Destroy; override;
  297.     function RefreshData: Boolean;
  298.     function SetItem(const S: string): Boolean;
  299.     procedure SrvrDisconnect;
  300.     property HszItem: HSZ read FHszItem;
  301.     property Control: TDdeClientItem read FCtrl write FCtrl;
  302.   published
  303.     property Item: string read FItem;
  304.   end;
  305.  
  306. procedure DDECheck(Success: Boolean);
  307. var
  308.   err: Integer;
  309.   ErrStr: string;
  310. begin
  311.   if Success then Exit;
  312.   err := DdeGetLastError(DDEMgr.DdeInstId);
  313.   case err of
  314.     DMLERR_LOW_MEMORY, DMLERR_MEMORY_ERROR:
  315.       ErrStr := FmtLoadStr(SDdeMemErr, [err]);
  316.     DMLERR_NO_CONV_ESTABLISHED:
  317.       ErrStr := FmtLoadStr(SDdeConvErr, [err]);
  318.   else
  319.     ErrStr := FmtLoadStr(SDdeErr, [err]);
  320.   end;
  321.   raise EDdeError.Create(ErrStr);
  322. end;
  323.  
  324. function DdeMgrCallBack(CallType, Fmt : UINT; Conv: HConv; hsz1, hsz2: HSZ;
  325.   Data: HDDEData; Data1, Data2: DWORD): HDDEData; stdcall;
  326. var
  327.   ci: TConvInfo;
  328.   ddeCli: TComponent;
  329.   ddeSrv: TDdeSrvrConv;
  330.   ddeObj: TComponent;
  331.   xID: Integer;
  332. begin
  333.   Result := 0;
  334.   case CallType of
  335.     XTYP_CONNECT:
  336.       Result := HDdeData(ddeMgr.AllowConnect(hsz2, hsz1));
  337.     XTYP_WILDCONNECT:
  338.       Result := ddeMgr.AllowWildConnect(hsz2, hsz1);
  339.     XTYP_CONNECT_CONFIRM:
  340.       ddeMgr.Connect(Conv, hsz1, Boolean(Data2));
  341.   end;
  342.   if Conv <> 0 then
  343.   begin
  344.     ci.cb := sizeof(TConvInfo);
  345.     if CallType = XTYP_XACT_COMPLETE then
  346.       xID := Data1
  347.     else
  348.       xID := QID_SYNC;
  349.     if DdeQueryConvInfo(Conv, xID, @ci) = 0 then Exit;
  350.     case CallType of
  351.       XTYP_ADVREQ:
  352.         begin
  353.           ddeSrv := TDdeSrvrConv(ci.hUser);
  354.           Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
  355.         end;
  356.       XTYP_REQUEST:
  357.         begin
  358.           ddeSrv := TDdeSrvrConv(ci.hUser);
  359.           Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
  360.         end;
  361.       XTYP_ADVSTOP:
  362.         begin
  363.           ddeSrv := TDdeSrvrConv(ci.hUser);
  364.           ddeSrv.AdvStop(Conv, hsz1, hsz2);
  365.         end;
  366.       XTYP_ADVSTART:
  367.         begin
  368.           ddeSrv := TDdeSrvrConv(ci.hUser);
  369.           Result := HDdeData(ddeSrv.AdvStart(Conv, hsz1, hsz2, Fmt));
  370.         end;
  371.       XTYP_POKE:
  372.         begin
  373.           ddeSrv := TDdeSrvrConv(ci.hUser);
  374.           Result := HDdeData(ddeSrv.PokeData(Conv, hsz1, hsz2, Data, Fmt));
  375.         end;
  376.       XTYP_EXECUTE:
  377.         begin
  378.           ddeSrv := TDdeSrvrConv(ci.hUser);
  379.           Result := HDdeData(ddeSrv.ExecuteMacro(Conv, hsz1, Data));
  380.         end;
  381.       XTYP_XACT_COMPLETE:
  382.         begin
  383.           ddeCli := TComponent(ci.hUser);
  384.           if ddeCli <> nil then TDdeClientConv(ddeCli).XactComplete
  385.         end;
  386.       XTYP_ADVDATA:
  387.         begin
  388.           ddeCli := TComponent(ci.hUser);
  389.           TDdeClientConv(ddeCli).DataChange(Data, hsz2);
  390.         end;
  391.       XTYP_DISCONNECT:
  392.         begin
  393.           ddeObj := TComponent(ci.hUser);
  394.           if ddeObj <> nil then
  395.           begin
  396.             if ddeObj is TDdeClientConv then
  397.               TDdeClientConv(ddeObj).SrvrDisconnect
  398.             else
  399.               ddeMgr.Disconnect(ddeObj);
  400.           end;
  401.         end;
  402.     end;
  403.   end;
  404. end;
  405.  
  406. function GetPasteLinkInfo(var Service, Topic, Item: string): Boolean;
  407. var
  408.   hData: THandle;
  409.   pData: Pointer;
  410.   P: PChar;
  411. begin
  412.   Result := False;
  413.   Clipboard.Open;
  414.   hData := Clipboard.GetAsHandle(ddeMgr.LinkClipFmt);
  415.   if hData <> 0 then
  416.   begin
  417.     pData := GlobalLock(hData);
  418.     try
  419.       P := PChar(pData);
  420.       Service := PChar(pData);
  421.       P := P + Length(Service) + 1;
  422.       Topic := P;
  423.       P := P + Length(Topic) + 1;
  424.       Item := P;
  425.     finally
  426.       GlobalUnlock(hData);
  427.     end;
  428.     Result := True;
  429.   end;
  430.   Clipboard.Close;
  431. end;
  432.  
  433. { TDdeMgr }
  434.  
  435. constructor TDdeMgr.Create(AOwner: TComponent);
  436. begin
  437.   inherited Create(AOwner);
  438.   FLinkClipFmt := RegisterClipboardFormat('Link');
  439.   FDdeInstId := 0;
  440.   DDECheck(DdeInitialize(FDdeInstId, DdeMgrCallBack, APPCLASS_STANDARD, 0) = 0);
  441.   FConvs := TList.Create;
  442.   FCliConvs := TList.Create;
  443.   FConvCtrls := TList.Create;
  444.   AppName := ParamStr(0);
  445. end;
  446.  
  447. destructor TDdeMgr.Destroy;
  448. var
  449.   I: Integer;
  450. begin
  451.   if FConvs <> nil then
  452.   begin
  453.     for I := 0 to FConvs.Count - 1 do
  454.       TDdeSrvrConv(FConvs[I]).Free;
  455.     FConvs.Free;
  456.     FConvs := nil;
  457.   end;
  458.   if FCliConvs <> nil then
  459.   begin
  460.     for I := 0 to FCliConvs.Count - 1 do
  461.       TDdeSrvrConv(FCliConvs[I]).Free;
  462.     FCliConvs.Free;
  463.     FCliConvs := nil;
  464.   end;
  465.   if FConvCtrls <> nil then
  466.   begin
  467.     FConvCtrls.Free;
  468.     FConvCtrls := nil;
  469.   end;
  470.   ResetAppName;
  471.   DdeUnInitialize(FDdeInstId);
  472.   inherited Destroy;
  473. end;
  474.  
  475. function TDdeMgr.AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
  476. var
  477.   Topic: string;
  478.   Buffer: array[0..4095] of Char;
  479.   Form: TForm;
  480.   SConv: TDdeServerConv;
  481. begin
  482.   Result := False;
  483.   if (hszApp = 0) or (DdeCmpStringHandles(hszApp, FHszApp) = 0)  then
  484.   begin
  485.     SetString(Topic, Buffer, DdeQueryString(FDdeInstId, hszTopic, Buffer,
  486.       SizeOf(Buffer), CP_WINANSI));
  487.     SConv := GetServerConv(Topic);
  488.     if SConv <> nil then
  489.       Result := True
  490.     else begin
  491.       Form := GetForm(Topic);
  492.       if Form <> nil then Result := True;
  493.     end;
  494.   end;
  495. end;
  496.  
  497. function TDdeMgr.AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
  498. var
  499.   conns: packed array[0..1] of THSZPair;
  500. begin
  501.   Result := 0;
  502.   if hszTopic = 0 then Exit;
  503.   if AllowConnect(hszApp, hszTopic) = True then
  504.   begin
  505.     conns[0].hszSvc := FHszApp;
  506.     conns[0].hszTopic := hszTopic;
  507.     conns[1].hszSvc := 0;
  508.     conns[1].hszTopic := 0;
  509.     Result := DdeCreateDataHandle(ddeMgr.DdeInstId, @conns,
  510.       2 * sizeof(THSZPair), 0, 0, CF_TEXT, 0);
  511.   end;
  512. end;
  513.  
  514. function TDdeMgr.Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
  515. var
  516.   Topic: string;
  517.   Buffer: array[0..4095] of Char;
  518.   DdeConv: TDdeSrvrConv;
  519. begin
  520.   DdeConv := TDdeSrvrConv.Create(Self);
  521.   SetString(Topic, Buffer, DdeQueryString(FDdeInstId, hszTopic, Buffer,
  522.     SizeOf(Buffer), CP_WINANSI));
  523.   DdeConv.Topic := Topic;
  524.   DdeConv.FSConv := GetServerConv(Topic);
  525.   if DdeConv.FSConv = nil then
  526.     DdeConv.FForm := GetForm(Topic);
  527.   DdeConv.FConv := Conv;
  528.   DdeSetUserHandle(Conv, QID_SYNC, LongInt(DdeConv));
  529.   FConvs.Add(DdeConv);
  530.   if DdeConv.FSConv <> nil then DdeConv.FSConv.Connect;
  531.   Result := True;
  532. end;
  533.  
  534. procedure TDdeMgr.Disconnect(DdeSrvrConv: TComponent);
  535. var
  536.   DdeConv: TDdeSrvrConv;
  537. begin
  538.   DdeConv := TDdeSrvrConv(DdeSrvrConv);
  539.   if DdeConv.FSConv <> nil then DdeConv.FSConv.Disconnect;
  540.   if DdeConv.FConv <> 0 then DdeSetUserHandle(DdeConv.FConv, QID_SYNC, 0);
  541.   DdeConv.FConv := 0;
  542.   if FConvs <> nil then
  543.   begin
  544.     FConvs.Remove(DdeConv);
  545.     DdeConv.Free;
  546.   end;
  547. end;
  548.  
  549. function TDdeMgr.GetExeName: string;
  550. begin
  551.   Result := ParamStr(0);
  552. end;
  553.  
  554. procedure TDdeMgr.SetAppName(const Name: string);
  555. var
  556.   Dot: Integer;
  557. begin
  558.   ResetAppName;
  559.   FAppName := ExtractFileName(Name);
  560.   Dot := Pos('.', FAppName);
  561.   if Dot <> 0 then
  562.     Delete(FAppName, Dot, Length(FAppName));
  563.   FHszApp := DdeCreateStringHandle(FDdeInstId, PChar(FAppName), CP_WINANSI);
  564.   DdeNameService(FDdeInstId, FHszApp, 0, DNS_REGISTER);
  565. end;
  566.  
  567. procedure TDdeMgr.ResetAppName;
  568. begin
  569.   if FHszApp <> 0 then
  570.   begin
  571.     DdeNameService(FDdeInstId, FHszApp, 0, DNS_UNREGISTER);
  572.     DdeFreeStringHandle(FDdeInstId, FHszApp);
  573.   end;
  574.   FHszApp := 0;
  575. end;
  576.  
  577. function TDdeMgr.GetServerConv(const Topic: string): TDdeServerConv;
  578. var
  579.   I: Integer;
  580.   SConv: TDdeServerConv;
  581. begin
  582.   Result := nil;
  583.   for I := 0 to FConvCtrls.Count - 1 do
  584.   begin
  585.     SConv := TDdeServerConv(FConvCtrls[I]);
  586.     if AnsiCompareText(SConv.Name, Topic) = 0 then
  587.     begin
  588.       Result := SConv;
  589.       Exit;
  590.     end;
  591.   end;
  592. end;
  593.  
  594. function TDdeMgr.GetForm(const Topic: string): TForm;
  595. var
  596.   I: Integer;
  597.   Form: TForm;
  598. begin
  599.   Result := nil;
  600.   for I := 0 to Screen.FormCount - 1 do
  601.   begin
  602.     Form := TForm(Screen.Forms[I]);
  603.     if AnsiCompareText(Form.Caption, Topic) = 0 then
  604.     begin
  605.       Result := Form;
  606.       Exit;
  607.     end;
  608.   end;
  609. end;
  610.  
  611. function TDdeMgr.GetSrvrConv(const Topic: string ): TComponent;
  612. var
  613.   I: Integer;
  614.   Conv: TDdeSrvrConv;
  615. begin
  616.   Result := nil;
  617.   for I := 0 to FConvs.Count - 1 do
  618.   begin
  619.     Conv := FConvs[I];
  620.     if AnsiCompareText(Conv.Topic, Topic) = 0 then
  621.     begin
  622.       Result := Conv;
  623.       Exit;
  624.     end;
  625.   end;
  626. end;
  627.  
  628. procedure TDdeMgr.PostDataChange(const Topic: string; Item: string);
  629. var
  630.   Conv: TDdeSrvrConv;
  631.   Itm: TDdeSrvrItem;
  632. begin
  633.   Conv := TDdeSrvrConv(GetSrvrConv (Topic));
  634.   If Conv <> nil then
  635.   begin
  636.     Itm := Conv.GetItem(Item);
  637.     if Itm <> nil then Itm.PostDataChange;
  638.   end;
  639. end;
  640.  
  641. procedure TDdeMgr.InsertServerConv(SConv: TDdeServerConv);
  642. begin
  643.   FConvCtrls.Insert(FConvCtrls.Count, SConv);
  644. end;
  645.  
  646. procedure TDdeMgr.RemoveServerConv(SConv: TDdeServerConv);
  647. begin
  648.   FConvCtrls.Remove(SConv);
  649. end;
  650.  
  651. procedure TDdeMgr.DoError;
  652. begin
  653.   DDECheck(False);
  654. end;
  655.  
  656. constructor TDdeClientConv.Create(AOwner: TComponent);
  657. begin
  658.   inherited Create(AOwner);
  659.   FItems := TList.Create;
  660. end;
  661.  
  662. destructor TDdeClientConv.Destroy;
  663. begin
  664.   CloseLink;
  665.   FItems.Free;
  666.   FItems := nil;
  667.   inherited Destroy;
  668. end;
  669.  
  670. procedure TDdeClientConv.DefineProperties(Filer: TFiler);
  671. begin
  672.   inherited DefineProperties(Filer);
  673.   Filer.DefineProperty('LinkInfo', ReadLinkInfo, WriteLinkInfo,
  674.     not ((DdeService = '') and (DdeTopic = '')));
  675. end;
  676.  
  677. procedure TDdeClientConv.Loaded;
  678. var
  679.   Service, Topic: string;
  680. begin
  681.   inherited Loaded;
  682.   Service := DdeService;
  683.   Topic := DdeTopic;
  684.   if (Length(Service) <> 0) and (ConnectMode <> ddeManual) then
  685.     ChangeLink(Service, Topic, '');
  686. end;
  687.  
  688. procedure TDdeClientConv.ReadLinkInfo (Reader: TReader);
  689. var
  690.   Value: string;
  691.   Text: string;
  692.   Temp: Integer;
  693. begin
  694.   Reader.ReadListBegin;
  695.   while not Reader.EndOfList do
  696.   begin
  697.     Value := Reader.ReadString;
  698.     Temp := Pos(' ', Value);
  699.     Text := Copy(Value, Temp + 1, Length (Value) - Temp);
  700.     case Value[1] of
  701.       'S': SetService(Text);
  702.       'T': SetTopic(Text);
  703.     end;
  704.   end;
  705.   Reader.ReadListEnd;
  706. end;
  707.  
  708. procedure TDdeClientConv.WriteLinkInfo (Writer: TWriter);
  709. var
  710.   Value: string;
  711. begin
  712.   Writer.WriteListBegin;
  713.   Value := DdeService;
  714.   Writer.WriteString(Format('Service %s', [Value]));
  715.   Value := DdeTopic;
  716.   Writer.WriteString(Format('Topic %s', [Value]));
  717.   Writer.WriteListEnd;
  718. end;
  719.  
  720. procedure TDdeClientConv.OnAttach(aCtrl: TDdeClientItem);
  721. var
  722.   ItemLnk: TDdeCliItem;
  723. begin
  724.   ItemLnk := TDdeCliItem.Create(Self);
  725.   FItems.Insert(FItems.Count, ItemLnk);
  726.   ItemLnk.Control := aCtrl;
  727.   ItemLnk.SetItem('');
  728. end;
  729.  
  730. procedure TDdeClientConv.OnDetach(aCtrl: TDdeClientItem);
  731. var
  732.   ItemLnk: TDdeCliItem;
  733. begin
  734.   ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  735.   if ItemLnk <> nil then
  736.   begin
  737.     ItemLnk.SetItem('');
  738.     FItems.Remove(ItemLnk);
  739.     ItemLnk.Free;
  740.   end;
  741. end;
  742.  
  743. function TDdeClientConv.OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
  744. var
  745.   ItemLnk: TDdeCliItem;
  746. begin
  747.   Result := True;
  748.   ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  749.  
  750.   if (ItemLnk = nil) and (Length(S) > 0) then
  751.   begin
  752.     OnAttach (aCtrl);
  753.     ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  754.   end;
  755.  
  756.   if (ItemLnk <> nil) and (Length(S) = 0) then
  757.   begin
  758.     OnDetach (aCtrl);
  759.   end
  760.   else if ItemLnk <> nil then
  761.   begin
  762.     Result := ItemLnk.SetItem(S);
  763.     if Not (Result) and Not (csLoading in ComponentState) then
  764.       OnDetach (aCtrl);  {error occurred, do cleanup}
  765.   end;
  766. end;
  767.  
  768. function TDdeClientConv.GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
  769. var
  770.   ItemLnk: TDdeCliItem;
  771.   I: word;
  772. begin
  773.   Result := nil;
  774.   I := 0;
  775.   while I < FItems.Count do
  776.   begin
  777.     ItemLnk := FItems[I];
  778.     if ItemLnk.Control = aCtrl then
  779.     begin
  780.       Result := ItemLnk;
  781.       Exit;
  782.     end;
  783.     Inc(I);
  784.   end;
  785. end;
  786.  
  787. function TDdeClientConv.PasteLink: Boolean;
  788. var
  789.   Service, Topic, Item: string;
  790. begin
  791.   if GetPasteLinkInfo(Service, Topic, Item) = True then
  792.     Result := ChangeLink(Service, Topic, Item) else
  793.     Result := False;
  794. end;
  795.  
  796. function TDdeClientConv.ChangeLink(const App, Topic, Item: string): Boolean;
  797. begin
  798.   CloseLink;
  799.   SetService(App);
  800.   SetTopic(Topic);
  801.   Result := OpenLink;
  802.   if Not Result then
  803.   begin
  804.     SetService('');
  805.     SetTopic('');
  806.   end;
  807. end;
  808.  
  809. function TDdeClientConv.OpenLink: Boolean;
  810. var
  811.   CharVal: array[0..255] of Char;
  812.   Res: Boolean;
  813. begin
  814.   Result := False;
  815.   if FConv <> 0 then Exit;
  816.  
  817.   if (Length(DdeService) = 0) and (Length(DdeTopic) = 0) then
  818.   begin
  819.     ClearItems;
  820.     Exit;
  821.   end;
  822.  
  823.   if FHszApp = 0 then
  824.   begin
  825.     StrPCopy(CharVal, DdeService);
  826.     FHszApp := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  827.   end;
  828.   if FHszTopic = 0 then
  829.   begin
  830.     StrPCopy(CharVal, DdeTopic);
  831.     FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  832.   end;
  833.   Res := CreateDdeConv(FHszApp, FHszTopic);
  834.   if Not Res then
  835.   begin
  836.     if Not((Length(DdeService) = 0) and
  837.       (Length(ServiceApplication) = 0)) then
  838.     begin
  839.       if Length(ServiceApplication) <> 0 then
  840.         StrPCopy(CharVal, ServiceApplication)
  841.       else
  842.         StrPCopy(CharVal, DdeService + ' ' + DdeTopic);
  843.       if WinExec(CharVal, SW_SHOWMINNOACTIVE) >= 32 then
  844.         Res := CreateDdeConv(FHszApp, FHszTopic);
  845.     end;
  846.   end;
  847.   if Not Res then
  848.   begin
  849.     ClearItems;
  850.     Exit;
  851.   end;
  852.   if FCnvInfo.wFmt <> 0 then FDdeFmt := FCnvInfo.wFmt
  853.   else FDdeFmt := CF_TEXT;
  854.   if StartAdvise = False then Exit;
  855.   Open;
  856.   DataChange(0, 0);
  857.   Result := True;
  858. end;
  859.  
  860. procedure TDdeClientConv.CloseLink;
  861. var
  862.   OldConv: HConv;
  863. begin
  864.   if FConv <> 0 then
  865.   begin
  866.     OldConv := FConv;
  867.     SrvrDisconnect;
  868.     FConv := 0;
  869.     DdeSetUserHandle(OldConv, QID_SYNC, 0);
  870.     DdeDisconnect(OldConv);
  871.   end;
  872.  
  873.   if FHszApp <> 0 then
  874.   begin
  875.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszApp);
  876.     FHszApp := 0;
  877.   end;
  878.  
  879.   if FHszTopic <> 0 then
  880.   begin
  881.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
  882.     FHszTopic := 0;
  883.   end;
  884.   SetService('');
  885.   SetTopic('');
  886. end;
  887.  
  888. procedure TDdeClientConv.ClearItems;
  889. var
  890.   ItemLnk: TDdeCliItem;
  891.   i: word;
  892. begin
  893.   if FItems.Count = 0 then Exit;
  894.  
  895.   for I := 0 to FItems.Count - 1 do
  896.   begin
  897.     ItemLnk := TDdeCliItem(FItems [0]);
  898.     ItemLnk.Control.DdeItem := EmptyStr;
  899.   end;
  900. end;
  901.  
  902. function TDdeClientConv.CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
  903. var
  904.   Context: TConvContext;
  905. begin
  906.   FillChar(Context, SizeOf(Context), 0);
  907.   with Context do
  908.   begin
  909.     cb := SizeOf(TConvConText);
  910.     iCodePage := CP_WINANSI;
  911.   end;
  912.   FConv := DdeConnect(ddeMgr.DdeInstId, FHszApp, FHszTopic, @Context);
  913.   Result := FConv <> 0;
  914.   if Result then
  915.   begin
  916.     FCnvInfo.cb := sizeof(TConvInfo);
  917.     DdeQueryConvInfo(FConv, QID_SYNC, @FCnvInfo);
  918.     DdeSetUserHandle(FConv, QID_SYNC, LongInt(Self));
  919.   end;
  920. end;
  921.  
  922. function TDdeClientConv.StartAdvise: Boolean;
  923. var
  924.   ItemLnk: TDdeCliItem;
  925.   i: word;
  926. begin
  927.   Result := False;
  928.   if FConv = 0 then Exit;
  929.  
  930.   i := 0;
  931.   while i < FItems.Count do
  932.   begin
  933.     ItemLnk := TDdeCliItem(FItems [i]);
  934.     if Not ItemLnk.StartAdvise then
  935.     begin
  936.       ItemLnk.Control.DdeItem := EmptyStr;
  937.     end else
  938.       Inc(i);
  939.     if i >= FItems.Count then
  940.       break;
  941.   end;
  942.   Result := True;
  943. end;
  944.  
  945. function TDdeClientConv.ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
  946. begin
  947.   Result := False;
  948.   if (FConv = 0) or FWaitStat then Exit;
  949.   Result := ExecuteMacro(PChar(Cmd.Text), waitFlg);
  950. end;
  951.  
  952. function TDdeClientConv.ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
  953. var
  954.   hszCmd: HDDEData;
  955.   hdata: HDDEData;
  956.   ddeRslt: LongInt;
  957. begin
  958.   Result := False;
  959.   if (FConv = 0) or FWaitStat then Exit;
  960.   hszCmd := DdeCreateDataHandle(ddeMgr.DdeInstId, Cmd, StrLen(Cmd) + 1,
  961.     0, 0, FDdeFmt, 0);
  962.   if hszCmd = 0 then Exit;
  963.   if waitFlg = True then FWaitStat := True;
  964.   hdata := DdeClientTransaction(Pointer(hszCmd), -1, FConv, 0, FDdeFmt,
  965.      XTYP_EXECUTE, TIMEOUT_ASYNC, @ddeRslt);
  966.   if hdata = 0 then FWaitStat := False
  967.   else Result := True;
  968. end;
  969.  
  970. function TDdeClientConv.PokeDataLines(const Item: string; Data: TStrings): Boolean;
  971. begin
  972.   Result := False;
  973.   if (FConv = 0) or FWaitStat then Exit;
  974.   Result := PokeData(Item, PChar(Data.Text));
  975. end;
  976.  
  977. function TDdeClientConv.PokeData(const Item: string; Data: PChar): Boolean;
  978. var
  979.   hszDat: HDDEData;
  980.   hdata: HDDEData;
  981.   hszItem: HSZ;
  982. begin
  983.   Result := False;
  984.   if (FConv = 0) or FWaitStat then Exit;
  985.   hszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  986.   if hszItem = 0 then Exit;
  987.   hszDat := DdeCreateDataHandle (ddeMgr.DdeInstId, Data, StrLen(Data) + 1,
  988.     0, hszItem, FDdeFmt, 0);
  989.   if hszDat <> 0 then
  990.   begin
  991.     hdata := DdeClientTransaction(Pointer(hszDat), -1, FConv, hszItem,
  992.       FDdeFmt, XTYP_POKE, TIMEOUT_ASYNC, nil);
  993.     Result := hdata <> 0;
  994.   end;
  995.   DdeFreeStringHandle (ddeMgr.DdeInstId, hszItem);
  996. end;
  997.  
  998. function TDdeClientConv.RequestData(const Item: string): PChar;
  999. var
  1000.   hData: HDDEData;
  1001.   ddeRslt: LongInt;
  1002.   hItem: HSZ;
  1003.   pData: Pointer;
  1004.   Len: Integer;
  1005. begin
  1006.   Result := nil;
  1007.   if (FConv = 0) or FWaitStat then Exit;
  1008.   hItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  1009.   if hItem <> 0 then
  1010.   begin
  1011.     hData := DdeClientTransaction(nil, 0, FConv, hItem, FDdeFmt,
  1012.       XTYP_REQUEST, 10000, @ddeRslt);
  1013.     DdeFreeStringHandle(ddeMgr.DdeInstId, hItem);
  1014.     if hData <> 0 then
  1015.     try
  1016.       pData := DdeAccessData(hData, @Len);
  1017.       if pData <> nil then
  1018.       try
  1019.         Result := StrAlloc(Len + 1);
  1020.         StrCopy(Result, pData);
  1021.       finally
  1022.         DdeUnaccessData(hData);
  1023.       end;
  1024.     finally
  1025.       DdeFreeDataHandle(hData);
  1026.     end;
  1027.   end;
  1028. end;
  1029.  
  1030. function TDdeClientConv.GetCliItemByName(const ItemName: string): TPersistent;
  1031. var
  1032.   ItemLnk: TDdeCliItem;
  1033.   i: word;
  1034. begin
  1035.   Result := nil;
  1036.   i := 0;
  1037.   while i < FItems.Count do
  1038.   begin
  1039.     ItemLnk := TDdeCliItem(FItems[i]);
  1040.     if ItemLnk.Item = ItemName then
  1041.     begin
  1042.       Result := ItemLnk;
  1043.       Exit;
  1044.     end;
  1045.     Inc(i);
  1046.   end;
  1047. end;
  1048.  
  1049. procedure TDdeClientConv.XactComplete;
  1050. begin
  1051.    FWaitStat := False;
  1052. end;
  1053.  
  1054. procedure TDdeClientConv.SrvrDisconnect;
  1055. var
  1056.   ItemLnk: TDdeCliItem;
  1057.   i: word;
  1058. begin
  1059.   if FConv <> 0 then Close;
  1060.   FConv := 0;
  1061.   i := 0;
  1062.   while i < FItems.Count do
  1063.   begin
  1064.     ItemLnk := TDdeCliItem(FItems [i]);
  1065.     ItemLnk.SrvrDisconnect;
  1066.     inc(i);
  1067.   end;
  1068. end;
  1069.  
  1070. procedure TDdeClientConv.DataChange(DdeDat: HDDEData; hszIt: HSZ);
  1071. var
  1072.   ItemLnk: TDdeCliItem;
  1073.   i: word;
  1074. begin
  1075.   i := 0;
  1076.   while i < FItems.Count do
  1077.   begin
  1078.     ItemLnk := TDdeCliItem(FItems [i]);
  1079.     if (hszIt = 0) or (ItemLnk.HszItem = hszIt) then
  1080.     begin
  1081.         { data has changed and we found a link that might be interested }
  1082.       ItemLnk.StoreData(DdeDat);
  1083.     end;
  1084.     Inc(i);
  1085.   end;
  1086. end;
  1087.  
  1088. function TDdeClientConv.SetLink(const Service, Topic: string): Boolean;
  1089. begin
  1090.   CloseLink;
  1091.   if FConnectMode = ddeAutomatic then
  1092.     Result := ChangeLink(Service, Topic, '')
  1093.   else begin
  1094.     SetService(Service);
  1095.     SetTopic(Topic);
  1096.     DataChange(0,0);
  1097.     Result := True;
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TDdeClientConv.SetConnectMode(NewMode: TDataMode);
  1102. begin
  1103.   if FConnectMode <> NewMode then
  1104.   begin
  1105.     if (NewMode = ddeAutomatic) and (Length(DdeService) <> 0) and
  1106.       (Length(DdeTopic) <> 0) and not OpenLink then
  1107.       raise Exception.CreateRes(SDdeNoConnect);
  1108.     FConnectMode := NewMode;
  1109.   end;
  1110. end;
  1111.  
  1112. procedure TDdeClientConv.SetFormatChars(NewFmt: Boolean);
  1113. begin
  1114.   if FFormatChars <> NewFmt then
  1115.   begin
  1116.     FFormatChars := NewFmt;
  1117.     if FConv <> 0 then DataChange(0, 0);
  1118.   end;
  1119. end;
  1120.  
  1121. procedure TDdeClientConv.SetDdeService(const Value: string);
  1122. begin
  1123. end;
  1124.  
  1125. procedure TDdeClientConv.SetDdeTopic(const Value: string);
  1126. begin
  1127. end;
  1128.  
  1129. procedure TDdeClientConv.SetService(const Value: string);
  1130. begin
  1131.   FDdeService := Value;
  1132. end;
  1133.  
  1134. procedure TDdeClientConv.SetTopic(const Value: string);
  1135. begin
  1136.   FDdeTopic := Value;
  1137. end;
  1138.  
  1139. procedure TDdeClientConv.Close;
  1140. begin
  1141.   if Assigned(FOnClose) then FOnClose(Self);
  1142. end;
  1143.  
  1144. procedure TDdeClientConv.Open;
  1145. begin
  1146.   if Assigned(FOnOpen) then FOnOpen(Self);
  1147. end;
  1148.  
  1149. procedure TDdeClientConv.Notification(AComponent: TComponent;
  1150.   Operation: TOperation);
  1151. var
  1152.   ItemLnk: TDdeCliItem;
  1153.   i: word;
  1154. begin
  1155.   inherited Notification(AComponent, Operation);
  1156.   if (Operation = opRemove) and (FItems <> nil) then
  1157.   begin
  1158.     i := 0;
  1159.     while i < FItems.Count do
  1160.     begin
  1161.       ItemLnk := TDdeCliItem(FItems [i]);
  1162.       if (AComponent = ItemLnk.Control) then
  1163.         ItemLnk.Control.DdeItem := EmptyStr;
  1164.       if i >= FItems.Count then break;
  1165.       Inc(I);
  1166.     end;
  1167.   end;
  1168. end;
  1169.  
  1170. constructor TDdeClientItem.Create(AOwner: TComponent);
  1171. begin
  1172.   inherited Create(AOwner);
  1173.   FLines := TStringList.Create;
  1174. end;
  1175.  
  1176. destructor TDdeClientItem.Destroy;
  1177. begin
  1178.   FLines.Free;
  1179.   inherited Destroy;
  1180. end;
  1181.  
  1182. procedure TDdeClientItem.SetDdeClientConv(Val: TDdeClientConv);
  1183. var
  1184.   OldItem: string;
  1185. begin
  1186.   if Val <> FDdeClientConv then
  1187.   begin
  1188.     OldItem := DdeItem;
  1189.     FDdeClientItem := '';
  1190.     if FDdeClientConv <> nil then
  1191.       FDdeClientConv.OnDetach (Self);
  1192.  
  1193.     FDdeClientConv := Val;
  1194.     if FDdeClientConv <> nil then
  1195.     begin
  1196.       FDdeClientConv.FreeNotification(Self);
  1197.       if Length(OldItem) <> 0 then SetDdeClientItem (OldItem);
  1198.     end;
  1199.   end;
  1200. end;
  1201.  
  1202. procedure TDdeClientItem.SetDdeClientItem(const Val: string);
  1203. begin
  1204.   if FDdeClientConv <> nil then
  1205.   begin
  1206.     FDdeClientItem := Val;
  1207.     if Not FDdeClientConv.OnSetItem (Self, Val) then
  1208.     begin
  1209.       if Not (csLoading in ComponentState) or
  1210.         not ((FDdeClientConv.FConv = 0) and
  1211.         (FDdeClientConv.ConnectMode = ddeManual)) then
  1212.         FDdeClientItem := '';
  1213.     end;
  1214.   end
  1215.   else if (csLoading in ComponentState) then
  1216.     FDdeClientItem := Val;
  1217. end;
  1218.  
  1219. procedure TDdeClientItem.Notification(AComponent: TComponent;
  1220.   Operation: TOperation);
  1221. begin
  1222.   inherited Notification(AComponent, Operation);
  1223.   if (Operation = opRemove) and (AComponent = FDdeClientConv) then
  1224.   begin
  1225.     FDdeClientConv.OnDetach (Self);
  1226.     FDdeClientConv := nil;
  1227.     FDdeClientItem := '';
  1228.   end;
  1229. end;
  1230.  
  1231. procedure TDdeClientItem.OnAdvise;
  1232. begin
  1233.   if csDesigning in ComponentState then
  1234.   begin
  1235.     if Owner.InheritsFrom (TForm) and (TForm(Owner).Designer <> nil) then
  1236.       TForm(Owner).Designer.Modified;
  1237.   end;
  1238.   if Assigned(FOnChange) then FOnChange(Self);
  1239. end;
  1240.  
  1241. function TDdeClientItem.GetText: string;
  1242. begin
  1243.   if FLines.Count > 0 then
  1244.     Result := FLines.Strings[0]
  1245.   else Result := '';
  1246. end;
  1247.  
  1248. procedure TDdeClientItem.SetText(const S: string);
  1249. begin
  1250. end;
  1251.  
  1252. procedure TDdeClientItem.SetLines(L: TStrings);
  1253. begin
  1254. end;
  1255.  
  1256. constructor TDdeCliItem.Create(ADS: TDdeClientConv);
  1257. begin
  1258.   inherited Create;
  1259.   FHszItem := 0;
  1260.   FCliConv := ADS;
  1261. end;
  1262.  
  1263. destructor TDdeCliItem.Destroy;
  1264. begin
  1265.   StopAdvise;
  1266.   inherited Destroy;
  1267. end;
  1268.  
  1269. function TDdeCliItem.SetItem(const S: string): Boolean;
  1270. var
  1271.   OldItem: string;
  1272. begin
  1273.   Result := False;
  1274.   OldItem := Item;
  1275.   if FHszItem <> 0 then StopAdvise;
  1276.  
  1277.   FItem := S;
  1278.   FCtrl.Lines.Clear;
  1279.  
  1280.   if (Length(Item) <> 0) then
  1281.   begin
  1282.     if (FCliConv.Conv <> 0) then
  1283.     begin
  1284.       Result := StartAdvise;
  1285.       if Not Result then
  1286.         FItem := '';
  1287.     end
  1288.     else if FCliConv.ConnectMode = ddeManual then Result := True;
  1289.   end;
  1290.   RefreshData;
  1291. end;
  1292.  
  1293. procedure TDdeCliItem.StoreData(DdeDat: HDDEData);
  1294. var
  1295.   Len: Longint;
  1296.   Data: string;
  1297.   I: Integer;
  1298. begin
  1299.   if DdeDat = 0 then
  1300.   begin
  1301.     RefreshData;
  1302.     Exit;
  1303.   end;
  1304.  
  1305.   Data := PChar(AccessData(DdeDat, @Len));
  1306.   if Data <> '' then
  1307.   begin
  1308.     FCtrl.Lines.Text := Data;
  1309.     ReleaseData(DdeDat);
  1310.     if FCliConv.FormatChars = False then
  1311.     begin
  1312.       for I := 1 to Length(Data) do
  1313.         if (Data[I] > #0) and (Data[I] < ' ') then Data[I] := ' ';
  1314.       FCtrl.Lines.Text := Data;
  1315.     end;
  1316.   end;
  1317.   DataChange;
  1318. end;
  1319.  
  1320. function TDdeCliItem.RefreshData: Boolean;
  1321. var
  1322.   ddeRslt: LongInt;
  1323.   DdeDat: HDDEData;
  1324. begin
  1325.   Result := False;
  1326.   if (FCliConv.Conv <> 0) and (FHszItem <> 0) then
  1327.   begin
  1328.     if FCliConv.WaitStat = True then Exit;
  1329.     DdeDat := DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1330.       FCliConv.DdeFmt, XTYP_REQUEST, 1000, @ddeRslt);
  1331.     if DdeDat = 0 then Exit
  1332.     else begin
  1333.       StoreData(DdeDat);
  1334.       DdeFreeDataHandle(DdeDat);
  1335.       Result := True;
  1336.       Exit;
  1337.     end;
  1338.   end;
  1339.   DataChange;
  1340. end;
  1341.  
  1342. function TDdeCliItem.AccessData(DdeDat: HDDEData; pDataLen: PDWORD): Pointer;
  1343. begin
  1344.   Result := DdeAccessData(DdeDat, pDataLen);
  1345. end;
  1346.  
  1347. procedure TDdeCliItem.ReleaseData(DdeDat: HDDEData);
  1348. begin
  1349.   DdeUnaccessData(DdeDat);
  1350. end;
  1351.  
  1352. function TDdeCliItem.StartAdvise: Boolean;
  1353. var
  1354.   ddeRslt: LongInt;
  1355.   hdata: HDDEData;
  1356. begin
  1357.   Result := False;
  1358.   if FCliConv.Conv = 0 then Exit;
  1359.   if Length(Item) = 0 then Exit;
  1360.   if FHszItem = 0 then
  1361.     FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  1362.   hdata := DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1363.     FCliConv.DdeFmt, XTYP_ADVSTART or XTYPF_NODATA, 1000, @ddeRslt);
  1364.   if hdata = 0 then
  1365.   begin
  1366.     DdeGetLastError(ddeMgr.DdeInstId);
  1367.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1368.     FHszItem := 0;
  1369.     FCtrl.Lines.Clear;
  1370.   end else
  1371.     Result := True;
  1372. end;
  1373.  
  1374. function TDdeCliItem.StopAdvise: Boolean;
  1375. var
  1376.   ddeRslt: LongInt;
  1377. begin
  1378.   if FCliConv.Conv <> 0 then
  1379.     if FHszItem <> 0 then
  1380.       DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1381.         FCliConv.DdeFmt, XTYP_ADVSTOP, 1000, @ddeRslt);
  1382.   SrvrDisconnect;
  1383.   Result := True;
  1384. end;
  1385.  
  1386. procedure TDdeCliItem.SrvrDisconnect;
  1387. begin
  1388.   if FHszItem <> 0 then
  1389.   begin
  1390.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1391.     FHszItem := 0;
  1392.   end;
  1393. end;
  1394.  
  1395. procedure TDdeCliItem.DataChange;
  1396. begin
  1397.   FCtrl.OnAdvise;
  1398. end;
  1399.  
  1400. constructor TDdeServerItem.Create(AOwner: TComponent);
  1401. begin
  1402.   inherited Create(AOwner);
  1403.   FFmt := CF_TEXT;
  1404.   FLines := TStringList.Create;
  1405. end;
  1406.  
  1407. destructor TDdeServerItem.Destroy;
  1408. begin
  1409.   FLines.Free;
  1410.   inherited Destroy;
  1411. end;
  1412.  
  1413. procedure TDdeServerItem.SetServerConv(SConv: TDdeServerConv);
  1414. begin
  1415.   FServerConv := SConv;
  1416.   if SConv <> nil then SConv.FreeNotification(Self);
  1417. end;
  1418.  
  1419. function TDdeServerItem.GetText: string;
  1420. begin
  1421.   if FLines.Count > 0 then
  1422.     Result := FLines.Strings[0]
  1423.   else Result := '';
  1424. end;
  1425.  
  1426. procedure TDdeServerItem.SetText(const Item: string);
  1427. begin
  1428.   FFmt := CF_TEXT;
  1429.   FLines.Clear;
  1430.   FLines.Add(Item);
  1431.   ValueChanged;
  1432. end;
  1433.  
  1434. procedure TDdeServerItem.SetLines(Value: TStrings);
  1435. begin
  1436.   if CompareStr(Value.Text, FLines.Text) <> 0 then
  1437.   begin
  1438.     FFmt := CF_TEXT;
  1439.     FLines.Assign(Value);
  1440.     ValueChanged;
  1441.   end;
  1442. end;
  1443.  
  1444. procedure TDdeServerItem.ValueChanged;
  1445. begin
  1446.   if Assigned(FOnChange) then FOnChange(Self);
  1447.   if FServerConv <> nil then
  1448.     ddeMgr.PostDataChange(FServerConv.Name, Name)
  1449.   else if (Owner <> nil) and (Owner is TForm) then
  1450.     ddeMgr.PostDataChange(TForm(Owner).Caption, Name);
  1451. end;
  1452.  
  1453. function TDdeServerItem.PokeData(Data: HDdeData): LongInt;
  1454. var
  1455.   Len: Integer;
  1456.   pData: Pointer;
  1457. begin
  1458.   Result := dde_FNotProcessed;
  1459.   pData := DdeAccessData(Data, @Len);
  1460.   if pData <> nil then
  1461.   begin
  1462.     Lines.Text := PChar(pData);
  1463.     DdeUnaccessData(Data);
  1464.     ValueChanged;
  1465.     if Assigned(FOnPokeData) then FOnPokeData(Self);
  1466.     Result := dde_FAck;
  1467.   end;
  1468. end;
  1469.  
  1470. procedure TDdeServerItem.CopyToClipboard;
  1471. var
  1472.   Data: THandle;
  1473.   LinkData: string;
  1474.   DataPtr: Pointer;
  1475. begin
  1476.   if FServerConv <> nil then
  1477.     LinkData := ddeMgr.AppName + #0 + FServerConv.Name + #0 + Name
  1478.   else if (Owner =nil) then Exit
  1479.   else if Owner is TForm then
  1480.     LinkData := ddeMgr.AppName + #0 + TForm(Owner).Caption + #0 + Name;
  1481.   try
  1482.     Clipboard.AsText := Text;
  1483.     Data := GlobalAlloc(GMEM_MOVEABLE, Length(LinkData) + 1);
  1484.     try
  1485.       DataPtr := GlobalLock(Data);
  1486.       try
  1487.         Move(PChar(LinkData)^, DataPtr^, Length(LinkData) + 1);
  1488.         Clipboard.SetAsHandle(DdeMgr.LinkClipFmt, Data);
  1489.       finally
  1490.         GlobalUnlock(Data);
  1491.       end;
  1492.     except
  1493.       GlobalFree(Data);
  1494.       raise;
  1495.     end;
  1496.   finally
  1497.     Clipboard.Close;
  1498.   end;
  1499. end;
  1500.  
  1501. procedure TDdeServerItem.Change;
  1502. begin
  1503.   if Assigned(FOnChange) then FOnChange(Self);
  1504. end;
  1505.  
  1506. procedure TDdeServerItem.Notification(AComponent: TComponent;
  1507.   Operation: TOperation);
  1508. begin
  1509.   inherited Notification(AComponent, Operation);
  1510.   if (AComponent = FServerConv) and (Operation = opRemove) then
  1511.     FServerConv := nil;
  1512. end;
  1513.  
  1514. constructor TDdeServerConv.Create(AOwner: TComponent);
  1515. begin
  1516.   inherited Create(AOwner);
  1517.   ddeMgr.InsertServerConv (Self);
  1518. end;
  1519.  
  1520. destructor TDdeServerConv.Destroy;
  1521. begin
  1522.   ddeMgr.RemoveServerConv(Self);
  1523.   inherited Destroy;
  1524. end;
  1525.  
  1526. function TDdeServerConv.ExecuteMacro(Data: HDdeData): LongInt;
  1527. var
  1528.   Len: Integer;
  1529.   pData: Pointer;
  1530.   MacroLines: TStringList;
  1531. begin
  1532.   Result := dde_FNotProcessed;
  1533.   pData := DdeAccessData(Data, @Len);
  1534.   if pData <> nil then
  1535.   begin
  1536.     if Assigned(FOnExecuteMacro) then
  1537.     begin
  1538.       MacroLines := TStringList.Create;
  1539.       MacroLines.Text := PChar(pData);
  1540.       FOnExecuteMacro(Self, MacroLines);
  1541.       MacroLines.Destroy;
  1542.     end;
  1543.     Result := dde_FAck;
  1544.   end;
  1545. end;
  1546.  
  1547. procedure TDdeServerConv.Connect;
  1548. begin
  1549.   if Assigned(FOnOpen) then FOnOpen(Self);
  1550. end;
  1551.  
  1552. procedure TDdeServerConv.Disconnect;
  1553. begin
  1554.   if Assigned(FOnClose) then FOnClose(Self);
  1555. end;
  1556.  
  1557. constructor TDdeSrvrConv.Create(AOwner: TComponent);
  1558. begin
  1559.   inherited Create(AOwner);
  1560.   FItems := TList.Create;
  1561. end;
  1562.  
  1563. destructor TDdeSrvrConv.Destroy;
  1564. var
  1565.   I: Integer;
  1566. begin
  1567.   if FItems <> nil then
  1568.   begin
  1569.     for I := 0 to FItems.Count - 1 do
  1570.       TDdeSrvrItem(FItems[I]).Free;
  1571.     FItems.Free;
  1572.     FItems := nil;
  1573.   end;
  1574.   if FConv <> 0 then DdeDisconnect(FConv);
  1575.   if FHszTopic <> 0 then
  1576.   begin
  1577.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
  1578.     FHszTopic := 0;
  1579.   end;
  1580.   inherited Destroy;
  1581. end;
  1582.  
  1583. function TDdeSrvrConv.AdvStart(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  1584.   Fmt: Word): Boolean;
  1585. var
  1586.   Srvr: TDdeServerItem;
  1587.   Buffer: array[0..4095] of Char;
  1588.   SrvrItem: TDdeSrvrItem;
  1589. begin
  1590.   Result := False;
  1591.   if Fmt <> CF_TEXT then Exit;
  1592.   DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1593.   Srvr := GetControl(FForm, FSConv, Buffer);
  1594.   if Srvr = nil then Exit;
  1595.   SrvrItem := TDdeSrvrItem.Create(Self);
  1596.   SrvrItem.Srvr := Srvr;
  1597.   SrvrItem.Item := Buffer;
  1598.   FItems.Add(SrvrItem);
  1599.   SrvrItem.FreeNotification(Self);
  1600.   if FHszTopic = 0 then
  1601.     FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Topic), CP_WINANSI);
  1602.   Result := True;
  1603. end;
  1604.  
  1605. procedure TDdeSrvrConv.AdvStop(Conv: HConv; hszTopic: HSZ; hszItem :HSZ);
  1606. var
  1607.   SrvrItem: TDdeSrvrItem;
  1608. begin
  1609.   SrvrItem := GetSrvrItem(hszItem);
  1610.   if SrvrItem <> nil then
  1611.   begin
  1612.     FItems.Remove(SrvrItem);
  1613.     SrvrItem.Free;
  1614.   end;
  1615. end;
  1616.  
  1617. function TDdeSrvrConv.PokeData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  1618.   Data: HDdeData; Fmt: Integer): LongInt;
  1619. var
  1620.   Srvr: TDdeServerItem;
  1621.   Buffer: array[0..4095] of Char;
  1622. begin
  1623.   Result := dde_FNotProcessed;
  1624.   if Fmt <> CF_TEXT then Exit;
  1625.   DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1626.   Srvr := GetControl(FForm, FSConv, Buffer);
  1627.   if Srvr <> nil then Result := Srvr.PokeData(Data);
  1628. end;
  1629.  
  1630. function TDdeSrvrConv.ExecuteMacro(Conv: HConv; hszTopic: HSZ;
  1631.   Data: HDdeData): Integer;
  1632. begin
  1633.   Result := dde_FNotProcessed;
  1634.   if (FSConv <> nil)  then
  1635.     Result := FSConv.ExecuteMacro(Data);
  1636. end;
  1637.  
  1638. function TDdeSrvrConv.RequestData(Conv: HConv; hszTopic: HSZ; hszItem :HSZ;
  1639.   Fmt: Word): HDdeData;
  1640. var
  1641.   Data: string;
  1642.   Buffer: array[0..4095] of Char;
  1643.   SrvrIt: TDdeSrvrItem;
  1644.   Srvr: TDdeServerItem;
  1645. begin
  1646.   Result := 0;
  1647.   SrvrIt := GetSrvrItem(hszItem);
  1648.   if SrvrIt <> nil then
  1649.     Result := SrvrIt.RequestData(Fmt)
  1650.   else
  1651.   begin
  1652.     DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1653.     Srvr := GetControl(FForm, FSConv, Buffer);
  1654.     if Srvr <> nil then
  1655.     begin
  1656.       if Fmt = CF_TEXT then
  1657.       begin
  1658.         Data := Srvr.Lines.Text;
  1659.         Result := DdeCreateDataHandle(ddeMgr.DdeInstId, PChar(Data),
  1660.           Length(Data) + 1, 0, hszItem, Fmt, 0 );
  1661.       end;
  1662.     end;
  1663.   end;
  1664. end;
  1665.  
  1666. function TDdeSrvrConv.GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
  1667. var
  1668.   I: Integer;
  1669.   Ctrl: TComponent;
  1670.   MainCtrl: TWinControl;
  1671.   Srvr: TDdeServerItem;
  1672. begin
  1673.   Result := nil;
  1674.   MainCtrl := WinCtrl;
  1675.   if MainCtrl = nil then
  1676.   begin
  1677.     if (DdeConv <> nil) and (DdeConv.Owner <> nil) and
  1678.       (DdeConv.Owner is TForm) then
  1679.       MainCtrl := TWinControl(DdeConv.Owner);
  1680.   end;
  1681.   if MainCtrl = nil then Exit;
  1682.   for I := 0 to MainCtrl.ComponentCount - 1 do
  1683.   begin
  1684.     Ctrl := MainCtrl.Components[I];
  1685.     if Ctrl is TDdeServerItem then
  1686.     begin
  1687.       if (Ctrl.Name = ItemName) and
  1688.         (TDdeServerItem(Ctrl).ServerConv = DdeConv) then
  1689.       begin
  1690.         Result := TDdeServerItem(Ctrl);
  1691.         Exit;
  1692.       end;
  1693.     end;
  1694.     if Ctrl is TWinControl then
  1695.     begin
  1696.       Srvr := GetControl(TWinControl(Ctrl), DdeConv, ItemName);
  1697.       if Srvr <> nil then
  1698.       begin
  1699.         Result := Srvr;
  1700.         Exit;
  1701.       end;
  1702.     end;
  1703.   end;
  1704. end;
  1705.  
  1706. function TDdeSrvrConv.GetItem(const ItemName: string): TDdeSrvrItem;
  1707. var
  1708.   I: Integer;
  1709.   Item: TDdeSrvrItem;
  1710. begin
  1711.   Result := nil;
  1712.   for I := 0 to FItems.Count - 1 do
  1713.   begin
  1714.     Item := FItems[I];
  1715.     If Item.Item = ItemName then
  1716.     begin
  1717.       Result := Item;
  1718.       Exit;
  1719.     end;
  1720.   end;
  1721. end;
  1722.  
  1723. function TDdeSrvrConv.GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
  1724. var
  1725.   I: Integer;
  1726.   Item: TDdeSrvrItem;
  1727. begin
  1728.   Result := nil;
  1729.   for I := 0 to FItems.Count - 1 do
  1730.   begin
  1731.     Item := FItems[I];
  1732.     If DdeCmpStringHandles(Item.HszItem, hszItem) = 0 then
  1733.     begin
  1734.       Result := Item;
  1735.       Exit;
  1736.     end;
  1737.   end;
  1738. end;
  1739.  
  1740. constructor TDdeSrvrItem.Create(AOwner: TComponent);
  1741. begin
  1742.   FConv := TDdeSrvrConv(AOwner);
  1743.   inherited Create(AOwner);
  1744. end;
  1745.  
  1746. destructor TDdeSrvrItem.Destroy;
  1747. begin
  1748.   if FHszItem <> 0 then
  1749.   begin
  1750.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1751.     FHszItem := 0;
  1752.   end;
  1753.   inherited Destroy;
  1754. end;
  1755.  
  1756. function TDdeSrvrItem.RequestData(Fmt: Word): HDdeData;
  1757. var
  1758.   Data: string;
  1759.   Buffer: array[0..4095] of Char;
  1760. begin
  1761.   Result := 0;
  1762.   SetString(FItem, Buffer, DdeQueryString(ddeMgr.DdeInstId, FHszItem, Buffer,
  1763.     SizeOf(Buffer), CP_WINANSI));
  1764.   if Fmt = CF_TEXT then
  1765.   begin
  1766.     Data := FSrvr.Lines.Text;
  1767.     Result := DdeCreateDataHandle(ddeMgr.DdeInstId, PChar(Data), Length(Data) + 1,
  1768.       0, FHszItem, Fmt, 0 );
  1769.   end;
  1770. end;
  1771.  
  1772. procedure TDdeSrvrItem.PostDataChange;
  1773. begin
  1774.   DdePostAdvise(ddeMgr.DdeInstId, FConv.HszTopic, FHszItem);
  1775. end;
  1776.  
  1777. procedure TDdeSrvrItem.SetItem(const Value: string);
  1778. begin
  1779.   FItem := Value;
  1780.   if FHszItem <> 0 then
  1781.   begin
  1782.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1783.     FHszItem := 0;
  1784.   end;
  1785.   if Length(FItem) > 0 then
  1786.     FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(FItem), CP_WINANSI);
  1787. end;
  1788.  
  1789. begin
  1790.   ddeMgr := TDdeMgr.Create(Application);
  1791. end.
  1792.  
  1793.